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

3
import Data.Char (fromCharCode)
4
import Data.Either (Either(..))
5
import Data.Foldable (class Foldable, foldr)
6
import Data.Lens (Lens', lens)
7
import Data.Maybe (fromJust)
8
import Data.Newtype (class Newtype, unwrap, wrap)
9
import Data.Sequence.Ordered as OSeq
10
import Data.Set (Set)
11
import Data.Set as Set
12
import Data.String as S
13
import Data.String.CodeUnits (singleton)
14
import Data.Unfoldable (class Unfoldable)
15 16
import Effect (Effect)
import Prelude
17
import Partial.Unsafe (unsafePartial)
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 76

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


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
82

83
data On a b = On a b
84

85
instance Eq a => Eq (On a b) where
86
  eq (On x _) (On y _) = eq x y
87

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


href :: Effect String
href = do
103
  w <- WHTML.window
104 105
  loc <- location w
  WHL.href loc
106 107 108 109 110 111 112 113 114


nbsp :: Int -> String
nbsp = nbsp' ""
  where
    char = singleton $ unsafePartial $ fromJust $ fromCharCode 160
    nbsp' acc n
      | n <= 0 = acc
      | otherwise = nbsp' (acc <> char) (n - 1)
115 116 117 118 119

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

infixl 1 ifElse as ?