Types.purs 6.31 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
  ) where

9 10
import Gargantext.Prelude

James Laver's avatar
James Laver committed
11 12
import Data.Array as A
import Data.Either (Either(..))
13
import Data.Eq.Generic (genericEq)
14
import Data.Generic.Rep (class Generic)
15
import Data.Int as Int
James Laver's avatar
James Laver committed
16
import Data.Map (Map)
17 18 19
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
James Laver's avatar
James Laver committed
20 21 22
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
23
import Data.Set as Set
24
import Data.Show.Generic (genericShow)
25
import Data.String as DST
26
import Data.Tuple (Tuple)
27
import Foreign.Object as Object
28
import Gargantext.Components.Login.Types (TreeId, UserId)
James Laver's avatar
James Laver committed
29 30 31 32
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)
33 34
import Gargantext.Utils.JSON as GJSON
import Gargantext.Utils.Tuple as GUT
35 36 37
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
James Laver's avatar
James Laver committed
38 39 40 41 42 43 44 45 46

-- | 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
47
  , userId   :: UserId
James Laver's avatar
James Laver committed
48 49 50 51 52
  }

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

53 54 55 56 57 58 59 60 61
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
62 63
  writeImpl (Session { backend, caches, token, treeId, username, userId}) =
      JSON.writeImpl { backend, caches: caches', token, treeId, username, userId }
64 65
    where
      caches' = JSON.writeImpl $ Object.fromFoldable (GUT.mapFst show <$> Map.toUnfoldable caches :: Array (Tuple String NT.CacheState))
66

67
instance Eq Session where eq = genericEq
68 69

instance Show Session where
70 71 72 73 74 75
  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
76

77
instance ToUrl Session SessionRoute where toUrl (Session {backend}) r = backendUrl backend (sessionPath r)
78

79 80
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
81 82 83 84 85 86 87 88

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

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

89
newtype Sessions = Sessions { sessions :: Seq Session }
James Laver's avatar
James Laver committed
90

91 92 93 94 95 96 97 98
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
99 100
instance Eq Sessions where eq = genericEq
instance Show Sessions where show = genericShow
James Laver's avatar
James Laver committed
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 134 135 136 137 138 139 140 141 142 143 144

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
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 171 172 173 174
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
175 176 177 178 179 180 181 182 183

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 }