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

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

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

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

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

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

-- 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
53 54 55 56 57 58 59 60 61 62

-- 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)
63

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

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

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

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


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
86

87
data On a b = On a b
88

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

92
instance Ord a => Ord (On a b) where
93 94 95 96 97 98 99 100 101
  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
102 103
--sortWith f = map (\(On _ y) -> y) <<< OSeq.toUnfoldable <<< foldr (\x -> OSeq.insert (On (f x) x)) OSeq.empty
sortWith f xs = A.toUnfoldable $ A.sortWith f (A.fromFoldable xs)
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


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