Types.purs 6.29 KB
Newer Older
James Laver's avatar
James Laver committed
1
module Gargantext.Sessions.Types
2
  ( Session(..), Sessions(..), OpenNodes(..), NodeId, mkNodeId
James Laver's avatar
James Laver committed
3 4
  , sessionUrl, sessionId
  , empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove
5
  , useOpenNodesMemberBox, openNodesInsert, openNodesDelete
6
  , cleanBackendUrl
James Laver's avatar
James Laver committed
7 8 9 10
  ) where

import Data.Array as A
import Data.Either (Either(..))
11
import Data.Eq.Generic (genericEq)
12
import Data.Generic.Rep (class Generic)
13
import Data.Int as Int
James Laver's avatar
James Laver committed
14
import Data.Map (Map)
15 16 17
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
James Laver's avatar
James Laver committed
18 19 20
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
21
import Data.Set as Set
22
import Data.Show.Generic (genericShow)
23
import Data.String as DST
24
import Data.Tuple (Tuple)
25
import Foreign.Object as Object
26
import Gargantext.Components.Login.Types (TreeId, UserId)
James Laver's avatar
James Laver committed
27 28
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath)
29
import Gargantext.Prelude
James Laver's avatar
James Laver committed
30 31
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
32 33
import Gargantext.Utils.JSON as GJSON
import Gargantext.Utils.Tuple as GUT
34 35 36
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
James Laver's avatar
James Laver committed
37 38 39 40 41 42 43 44 45

-- | A Session represents an authenticated session for a user at a
-- | backend. It contains a token and root tree id.
newtype Session = Session
  { backend  :: Backend
  , caches   :: Map Int NT.CacheState  -- whether cache is turned on for node id
  , token    :: String
  , treeId   :: TreeId
  , username :: String
46
  , userId   :: UserId
James Laver's avatar
James Laver committed
47 48 49 50 51
  }

------------------------------------------------------------------------
-- | Main instances

52 53 54 55 56 57
derive instance Generic Session _
derive instance Newtype Session _
instance JSON.ReadForeign Session where
  readImpl f = do
    r <- JSON.readImpl f
    let objTuple = Object.toUnfoldable r.caches :: Array (Tuple String NT.CacheState)
58
    let rUp = r { caches = Map.fromFoldable (GUT.first (fromMaybe 0 <<< Int.fromString) <$> objTuple) }
59 60
    pure $ Session rUp
instance JSON.WriteForeign Session where
61 62
  writeImpl (Session { backend, caches, token, treeId, username, userId}) =
      JSON.writeImpl { backend, caches: caches', token, treeId, username, userId }
63
    where
64
      caches' = JSON.writeImpl $ Object.fromFoldable (GUT.first show <$> Map.toUnfoldable caches :: Array (Tuple String NT.CacheState))
65
instance Eq Session where eq = genericEq
66
instance Show Session where
67 68 69 70 71 72
  show (Session {backend, username}) = username <> "@" <> (cleanBackendUrl backend)

cleanBackendUrl :: Backend -> String
cleanBackendUrl (Backend {baseUrl}) = 
     DST.replace (DST.Pattern "http://")  (DST.Replacement "")
   $ DST.replace (DST.Pattern "https://") (DST.Replacement "") baseUrl
73

74 75 76
instance ToUrl Session SessionRoute where toUrl (Session {backend}) r = backendUrl backend (sessionPath r)
instance ToUrl Session NodePath where toUrl (Session {backend}) np = backendUrl backend (nodePath np)
instance ToUrl Session String where toUrl = sessionUrl
James Laver's avatar
James Laver committed
77 78 79 80 81 82 83 84

sessionUrl :: Session -> String -> String
sessionUrl (Session {backend}) = backendUrl backend

sessionId :: Session -> SessionId
sessionId = SessionId <<< show
------------------------------------------------------------------------

85
newtype Sessions = Sessions { sessions :: Seq Session }
James Laver's avatar
James Laver committed
86

87 88 89 90 91 92 93 94
derive instance Generic Sessions _
derive instance Newtype Sessions _
instance JSON.ReadForeign Sessions where
  readImpl f = do
    sessions <- GJSON.readSequence f
    pure $ Sessions { sessions }
instance JSON.WriteForeign Sessions where
  writeImpl (Sessions { sessions }) = GJSON.writeSequence sessions
95 96
instance Eq Sessions where eq = genericEq
instance Show Sessions where show = genericShow
James Laver's avatar
James Laver committed
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133

empty :: Sessions
empty = Sessions { sessions: Seq.empty }

-- True if there are no sessions stored
null :: Sessions -> Boolean
null (Sessions { sessions: seq }) = Seq.null seq

unSessions :: Sessions -> Array Session
unSessions (Sessions {sessions:s}) = A.fromFoldable s

lookup :: SessionId -> Sessions -> Maybe Session
lookup sid (Sessions {sessions:ss}) = Seq.head (Seq.filter f ss) where
  f s = sid == sessionId s

cons :: Session -> Sessions -> Sessions
cons s (Sessions {sessions:ss}) = Sessions {sessions:(Seq.cons s ss)}

tryCons :: Session -> Sessions -> Either Unit Sessions
tryCons s ss = try $ lookup sid ss
  where
    sid = sessionId s
    try Nothing = Right (cons s ss)
    try _ = Left unit

update :: Session -> Sessions -> Sessions
update s ss = up $ lookup sid ss
  where
    sid = sessionId s
    up Nothing = cons s ss
    up _ = cons s $ remove sid ss

remove :: SessionId -> Sessions -> Sessions
remove sid (Sessions {sessions:ss}) = Sessions {sessions: Seq.filter f ss} where
  f s = sid /= sessionId s

tryRemove :: SessionId -> Sessions -> Either Unit Sessions
134
tryRemove sid old = ret where
James Laver's avatar
James Laver committed
135 136 137 138 139 140
  new = remove sid old
  ret
    | new == old = Left unit
    | otherwise =  Right new

-- open tree nodes data
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
newtype OpenNodes = OpenNodes (Set NodeId)

derive instance Generic OpenNodes _
derive instance Newtype OpenNodes _
instance JSON.ReadForeign OpenNodes where
  readImpl f = do
    inst :: Array NodeId <- JSON.readImpl f
    pure $ OpenNodes $ Set.fromFoldable inst
instance JSON.WriteForeign OpenNodes where
  writeImpl (OpenNodes ns) = JSON.writeImpl $ (Set.toUnfoldable ns :: Array NodeId)

openNodesInsert :: NodeId -> OpenNodes -> OpenNodes
openNodesInsert nodeId (OpenNodes set) = OpenNodes $ Set.insert nodeId set

openNodesDelete :: NodeId -> OpenNodes -> OpenNodes
openNodesDelete nodeId (OpenNodes set) = OpenNodes $ Set.delete nodeId set

-- | Creates a cursor which presents a Boolean over whether the member
-- | is in the set. Adjusting the value will toggle whether the value
-- | is in the underlying set.
useOpenNodesMemberBox
  :: forall box. T.ReadWrite box OpenNodes
  => NodeId -> box -> R.Hooks (T.Box Boolean)
useOpenNodesMemberBox val box = T.useFocused (\(OpenNodes ns) -> Set.member val ns) (toggleSet val) box

-- utility for useOpenNodesMemberBox
toggleSet :: NodeId -> Boolean -> OpenNodes -> OpenNodes
toggleSet val true  (OpenNodes ns) = OpenNodes $ Set.insert val ns
toggleSet val false (OpenNodes ns) = OpenNodes $ Set.delete val ns

James Laver's avatar
James Laver committed
171 172 173 174 175 176 177 178 179

type NodeId =
  { treeId :: TreeId  -- Id of the node
  , baseUrl :: String -- the baseUrl of the backend
  }

mkNodeId :: Session -> TreeId -> NodeId
mkNodeId (Session {backend: Backend {baseUrl}}) treeId = { treeId, baseUrl }