Types.purs 6 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
James Laver's avatar
James Laver committed
6 7 8 9 10
  ) where

import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
11
import Data.Eq.Generic (genericEq)
12
import Data.Int as Int
James Laver's avatar
James Laver committed
13
import Data.Map (Map)
14 15 16
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
James Laver's avatar
James Laver committed
17 18 19
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
20
import Data.Set as Set
21
import Data.Show.Generic (genericShow)
22
import Data.Tuple (Tuple)
23
import Foreign.Object as Object
24
import Reactix as R
25
import Simple.JSON as JSON
26
import Toestand as T
27 28

import Gargantext.Prelude
James Laver's avatar
James Laver committed
29 30 31 32 33 34

import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath)
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
35 36
import Gargantext.Utils.JSON as GJSON
import Gargantext.Utils.Tuple as GUT
James Laver's avatar
James Laver committed
37 38 39 40 41 42 43 44 45 46 47 48 49 50

-- | 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
  }

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

51 52 53 54 55 56 57 58 59 60 61 62 63
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)
    let rUp = r { caches = Map.fromFoldable (GUT.mapFst (fromMaybe 0 <<< Int.fromString) <$> objTuple) }
    pure $ Session rUp
instance JSON.WriteForeign Session where
  writeImpl (Session { backend, caches, token, treeId, username }) =
      JSON.writeImpl { backend, caches: caches', token, treeId, username }
    where
      caches' = JSON.writeImpl $ Object.fromFoldable (GUT.mapFst show <$> Map.toUnfoldable caches :: Array (Tuple String NT.CacheState))
64 65 66 67 68
instance Eq Session where eq = genericEq
instance Show Session where show (Session {backend, username}) = username <> "@" <> show backend
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
69 70 71 72 73 74 75 76

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

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

77
newtype Sessions = Sessions { sessions :: Seq Session }
James Laver's avatar
James Laver committed
78

79 80 81 82 83 84 85 86
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
87 88
instance Eq Sessions where eq = genericEq
instance Show Sessions where show = genericShow
James Laver's avatar
James Laver committed
89 90 91 92 93 94 95 96 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

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
tryRemove sid old@(Sessions ss) = ret where
  new = remove sid old
  ret
    | new == old = Left unit
    | otherwise =  Right new

-- open tree nodes data
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
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
163 164 165 166 167 168 169 170 171

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 }