Utils.purs 3.59 KB
Newer Older
1
module Gargantext.Utils where
2

arturo's avatar
arturo committed
3 4
import Prelude

5
import Data.Char (fromCharCode)
6
import Data.Either (Either(..))
7
import Data.Foldable (class Foldable, foldr)
8
import Data.Lens (Lens', lens)
arturo's avatar
arturo committed
9
import Data.Maybe (Maybe(..), fromJust)
10
import Data.Newtype (class Newtype, unwrap, wrap)
11
import Data.Sequence.Ordered as OSeq
12
import Data.Set (Set)
13
import Data.Set as Set
14
import Data.String as S
arturo's avatar
arturo committed
15
import Data.String.CodeUnits (singleton, slice)
16
import Data.Unfoldable (class Unfoldable)
17
import Effect (Effect)
18
import Partial.Unsafe (unsafePartial)
19
import Web.HTML as WHTML
20
import Web.HTML.Location as WHL
21
import Web.HTML.Window (location)
22

23 24 25
-- | TODO (hard coded)
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
James Laver's avatar
James Laver committed
26

27 28 29 30 31 32
setterv :: forall nt record field.
           Newtype nt record
           => (record -> field -> record)
           -> field
           -> nt
           -> nt
33 34
setterv fn v t = (setter (flip fn v) t)

35 36 37 38 39
setter :: forall nt record.
          Newtype nt record
          => (record -> record)
          -> nt
          -> nt
40 41
setter fn = wrap <<< fn <<< unwrap

42 43 44 45 46
getter :: forall record field nt.
          Newtype nt record
          => (record -> field)
          -> nt
          -> field
47
getter fn = fn <<< unwrap
48 49 50 51 52 53

-- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a
toggleSet a s
  | Set.member a s = Set.delete a s
  | otherwise      = Set.insert a s
54 55 56 57 58 59 60 61 62 63

-- Default sort order is ascending, we may want descending
invertOrdering :: Ordering -> Ordering
invertOrdering LT = GT
invertOrdering GT = LT
invertOrdering EQ = EQ

-- A lens that always returns unit
_unit :: forall s. Lens' s Unit
_unit = lens (\_ -> unit) (\s _ -> s)
64

65 66 67 68
-- | Format a number with specified amount of zero-padding
zeroPad :: Int -> Int -> String
zeroPad pad num = zeros <> (show num)
  where
69
    numDigits = S.length $ show num
70 71 72
    zeros = if numDigits < pad then zeros' (pad - numDigits) else ""
    zeros' 0 = ""
    zeros' n = "0" <> (zeros' (n - 1))
73

74 75 76
queryNormalize :: String -> String
queryNormalize = S.toLower

77
queryMatchesLabel :: String -> String -> Boolean
78 79 80 81
queryMatchesLabel q l = S.contains (S.Pattern $ queryNormalize q) (queryNormalize l)

queryExactMatchesLabel :: String -> String -> Boolean
queryExactMatchesLabel q l = queryNormalize q == queryNormalize l
82 83 84 85 86


mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left  l) = Left (f l)
mapLeft _ (Right r) = Right r
87

88
data On a b = On a b
89

90
instance Eq a => Eq (On a b) where
91
  eq (On x _) (On y _) = eq x y
92

93
instance Ord a => Ord (On a b) where
94 95 96 97 98 99 100 101 102
  compare (On x _) (On y _) = compare x y

-- same as
-- https://github.com/purescript/purescript-arrays/blob/v5.3.1/src/Data/Array.purs#L715-L715
sortWith :: forall a b f. Functor f =>
                          Foldable f =>
                          Unfoldable f =>
                          Ord b =>
                          (a -> b) -> f a -> f a
103
sortWith f = map (\(On _ y) -> y) <<< OSeq.toUnfoldable <<< foldr (\x -> OSeq.insert (On (f x) x)) OSeq.empty
104 105 106 107


href :: Effect String
href = do
108
  w <- WHTML.window
109 110
  loc <- location w
  WHL.href loc
111 112 113 114 115 116 117 118 119


nbsp :: Int -> String
nbsp = nbsp' ""
  where
    char = singleton $ unsafePartial $ fromJust $ fromCharCode 160
    nbsp' acc n
      | n <= 0 = acc
      | otherwise = nbsp' (acc <> char) (n - 1)
120 121 122 123 124

ifElse :: forall a. Boolean -> a -> a -> a
ifElse predicate a b = if predicate then a else b

infixl 1 ifElse as ?
arturo's avatar
arturo committed
125 126 127 128 129 130 131 132


textEllipsisBreak :: Int -> String -> String
textEllipsisBreak len n =
  if S.length n < len then n
  else case (slice 0 len n) of
    Nothing -> "???"
    Just s  -> s <> "…"