attempt 1 at tree memory, not quite finished

src/Gargantext/Components/App.purs

@@ -9,6 +9,8 @@ import Reactix as R
 import Reactix.DOM.HTML as H
 
 import Gargantext.Components.Data.Lang (Lang(..))
+import Gargantext.Components.Forest.Memories as Memories
+import Gargantext.Components.Forest.Memories (Memories, useMemories)
 import Gargantext.Components.Forest (forest)
 import Gargantext.Components.GraphExplorer (explorerLayout)
 import Gargantext.Components.Login (login)
@@ -43,15 +45,17 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
   frontends = defaultFrontends
   cpt _ _ = do
     sessions   <- useSessions
+    memories   <- useMemories
     route      <- useHashRouter router Home
     
     showLogin  <- R.useState' false
     showCorpus <- R.useState' false
     
-    let forested      = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
+    let forested      = forestLayout frontends (fst sessions) (fst route) (snd showLogin) memories
     let mCurrentRoute = fst route
     let backends      = fromFoldable defaultBackends
-    let withSession = \sid f -> maybe' (\_ -> forested $ homeLayout EN) f $ Sessions.lookup sid (fst sessions)
+    let currentSession = Sessions.lookup sid (fst sessions)
+    let withSession = \sid f -> maybe' (\_ -> forested $ homeLayout EN) f currentSession
     pure $ case fst showLogin of
       true -> forested $ login { sessions, backends, visible: showLogin }
       false ->
@@ -75,18 +79,25 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
             withSession sid $
               \session ->
                 simpleLayout $
-                  explorerLayout { graphId, mCurrentRoute, session
+                  explorerLayout { graphId, mCurrentRoute, session, memories
                                  , sessions: (fst sessions), treeId: Nothing, frontends}
 
-forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
-forestLayout frontends sessions route showLogin child =
+forestLayout
+  :: Frontends
+  -> Sessions
+  -> AppRoute
+  -> R2.Setter Boolean
+  -> R2.Reductor Memories Memories.Action
+  -> R.Element
+  -> R.Element
+forestLayout frontends sessions route showLogin memories child =
   R.fragment [ topBar {}, row main, footer {} ]
   where
     row child' = H.div {className: "row"} [child']
     main =
       R.fragment
       [ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
-              [ forest {sessions, route, frontends, showLogin} ]
+              [ forest {sessions, route, frontends, showLogin, memories} ]
       , mainPage child
       ]
 

src/Gargantext/Components/Forest.purs

@@ -9,6 +9,8 @@ import Gargantext.Ends (Frontends)
 import Gargantext.Routes (AppRoute)
 import Gargantext.Sessions (Session(..), Sessions, unSessions)
 import Gargantext.Components.Forest.Tree (treeView)
+import Gargantext.Components.Forest.Memories as Memories
+import Gargantext.Components.Forest.Memories (Memories)
 import Gargantext.Utils.Reactix as R2
 
 type Props =
@@ -16,6 +18,7 @@ type Props =
   , route     :: AppRoute
   , frontends :: Frontends
   , showLogin :: R2.Setter Boolean
+  , memories  :: R2.Reductor Memories Memories.Action
   )
 
 forest :: Record Props -> R.Element
@@ -23,7 +26,7 @@ forest props = R.createElement forestCpt props []
 
 forestCpt :: R.Component Props
 forestCpt = R.staticComponent "G.C.Forest.forest" cpt where
-  cpt {sessions, route, frontends, showLogin} _ =
+  cpt {sessions, route, frontends, showLogin, memories} _ =
     R.fragment $ A.cons (plus showLogin) trees
     where
       trees = tree <$> unSessions sessions

src/Gargantext/Components/Forest/Memories.purs

+-- | The memory is a persisted dynamic state of the forest, so the
+-- | user can pick up where they left off after a page refresh
+module Gargantext.Components.Forest.Memories where
+  -- ( Memory(..), Memories(..)
+  -- , emptyMemory, emptyMemories
+  -- , loadMemories, saveMemories
+  -- ) where
+
+import Prelude
+import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
+import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
+import Data.Argonaut.Parser (jsonParser)
+import Data.Array as Array
+import Data.Either (Either(..))
+import Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe (Maybe(..), maybe)
+import Data.Set as Set
+import Data.Set (Set)
+import Data.Traversable (traverse)
+import DOM.Simple.Console (log2)
+import Effect (Effect)
+import Reactix as R
+import Web.HTML (window)
+import Web.HTML.Window (localStorage)
+import Web.Storage.Storage (Storage, getItem, setItem, removeItem)
+
+import Gargantext.Utils.Reactix as R2
+import Gargantext.Sessions (Session, mapLeft, sessionId)
+import Gargantext.Types (SessionId)
+
+newtype Memory = Memory
+  { openTrees :: Set Int }
+
+isOpen :: Memory -> Int -> Boolean
+isOpen (Memory { openTrees }) tid = Set.member tid openTrees
+
+toggleOpen' :: Memory -> Int -> Boolean -> Memory
+toggleOpen' (Memory {openTrees}) tid true =
+  Memory { openTrees: Set.insert tid openTrees }
+toggleOpen' (Memory {openTrees}) tid false =
+  Memory { openTrees: Set.delete tid openTrees }
+
+toggleOpen :: Memories -> Session -> Int -> Boolean -> Memories
+toggleOpen (Memories {sessions}) s tid set =
+  Memories {sessions: memories} where
+    sid = sessionId s
+    origMemory = maybe emptyMemory identity $ Map.lookup sid sessions
+    memory = toggleOpen' origMemory tid set
+    memories = Map.insert sid memory sessions
+
+emptyMemory :: Memory
+emptyMemory = Memory
+  { openTrees: mempty }
+
+newtype Memories = Memories
+  { sessions :: Map SessionId Memory }
+
+emptyMemories :: Memories
+emptyMemories = Memories
+  { sessions: mempty }
+
+null :: Memories -> Boolean
+null (Memories {sessions}) = Map.isEmpty sessions
+
+findMemory :: Memories -> Session -> Maybe Memory
+findMemory (Memories {sessions}) s = Map.lookup (sessionId s) sessions
+
+-- Key we will store the data under
+localStorageKey :: String
+localStorageKey = "garg-forest-memories"
+
+loadMemories :: Effect Memories
+loadMemories = getls >>= getItem localStorageKey >>= handleMaybe
+  where
+    -- a localstorage lookup can find nothing
+    handleMaybe (Just val) = handleEither (parse val >>= decode)
+    handleMaybe Nothing    = pure emptyMemories
+
+    -- either parsing or decoding could fail, hence two errors
+    handleEither (Left err) = err *> pure emptyMemories
+    handleEither (Right ss) = pure ss
+
+    parse  s = mapLeft (log2 "Error parsing serialised forest memories:") (jsonParser s)
+    decode j = mapLeft (log2 "Error decoding serialised forest memories:") (decodeJson j)
+
+saveMemories :: Memories -> Effect Memories
+saveMemories memories = effect *> pure memories where
+  rem = getls >>= removeItem localStorageKey
+  set v  = getls >>= setItem    localStorageKey v
+  effect
+    | null memories = rem
+    | otherwise = set (stringify $ encodeJson memories)
+
+data Action = ToggleTreeOpen Session Int Boolean
+
+useMemories :: R.Hooks (R2.Reductor Memories Action)
+useMemories = do
+  R2.useReductor actAndSave (const loadMemories) unit
+  where
+    actAndSave :: R2.Actor Memories Action
+    actAndSave a m = act m a >>= saveMemories
+
+act :: Memories -> Action -> Effect Memories
+act m (ToggleTreeOpen s tid b) = pure $ toggleOpen m s tid b
+
+getls :: Effect Storage
+getls = window >>= localStorage
+
+instance encodeJsonMemory :: EncodeJson Memory where
+  encodeJson (Memory { openTrees })
+    = "openTrees" := encodeJson (Array.fromFoldable openTrees)
+    ~> jsonEmptyObject
+
+instance decodeJsonMemory :: DecodeJson Memory where
+  decodeJson json = do
+    obj <- decodeJson json
+    (openTrees :: Array Int) <- obj .: "openTrees"
+    pure $ Memory { openTrees: Set.fromFoldable openTrees }
+
+instance encodeJsonMemories :: EncodeJson Memories where
+  encodeJson (Memories { sessions })
+    = "sessions" := encodeJson sessions
+    ~> jsonEmptyObject
+
+instance decodeJsonMemories :: DecodeJson Memories where
+  decodeJson json = do
+    obj <- decodeJson json
+    sessions <- obj .: "sessions"
+    pure $ Memories { sessions }

src/Gargantext/Components/Forest/Tree.purs

 module Gargantext.Components.Forest.Tree where
 
-import Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>), (||))
+import Prelude (Unit, bind, discard, map, pure, void, identity, ($), (+), (<>), (||))
 import DOM.Simple.Console (log2)
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe, maybe)
 -- import Data.Newtype (class Newtype)
+import Data.Tuple (fst)
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
+import Gargantext.Components.Forest.Memories as Memories
+import Gargantext.Components.Forest.Memories (Memories, Memory)
 import Gargantext.Components.Forest.Tree.Node.Action
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
 import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
@@ -18,10 +21,12 @@ import Reactix as R
 import Reactix.DOM.HTML as H
 
 ------------------------------------------------------------------------
-type Props = ( root          :: ID
+type Props = ( root          :: Int
              , mCurrentRoute :: Maybe AppRoute
              , session       :: Session
              , frontends     :: Frontends
+             , memory        :: Memory
+             , remember      :: Memories.Action -> Effect Unit
              )
 
 treeView :: Record Props -> R.Element
@@ -39,61 +44,71 @@ treeLoadView :: R.State Reload -> Record Props -> R.Element
 treeLoadView reload p = R.createElement el p []
   where
     el = R.staticComponent "TreeLoadView" cpt
-    cpt {root, mCurrentRoute, session, frontends} _ = do
+    cpt {root, mCurrentRoute, session, frontends, memory, remember} _ = do
       loader root (loadNode session) $ \loaded ->
-        loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends}
-
-type TreeViewProps = ( tree          :: FTree
-                     , mCurrentRoute :: Maybe AppRoute
-                     , frontends     :: Frontends
-                     , session       :: Session 
-                     )
-
-loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
-loadedTreeView reload p = R.createElement el p []
-  where
-    el = R.hooksComponent "LoadedTreeView" cpt
-    cpt {tree, mCurrentRoute, session, frontends} _ = do
-      treeState <- R.useState' {tree}
-
-      pure $ H.div {className: "tree"}
-        [ toHtml reload treeState session frontends mCurrentRoute ]
+        loadedTreeView {tree: loaded, reload, mCurrentRoute, session, frontends}
+
+type TreeViewProps =
+  ( tree          :: FTree
+  , reload        :: R.State Reload
+  , mCurrentRoute :: Maybe AppRoute
+  , frontends     :: Frontends
+  , session       :: Session 
+  , memory        :: Memory
+  , remember      :: Memories.Action -> Effect Unit
+  )
+
+loadedTreeView :: Record TreeViewProps -> R.Element
+loadedTreeView props = R.createElement loadedTreeViewCpt props []
+
+loadedTreeViewCpt :: R.Component TreeViewProps
+loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt where
+  cpt {tree, mCurrentRoute, session, frontends, memory, remember} _ = do
+    treeState <- R.useState' {tree}
+    pure $ H.div {className: "tree"}
+      [ toHtml reload treeState session frontends mCurrentRoute ]
 
 ------------------------------------------------------------------------
-toHtml :: R.State Reload
-       -> R.State Tree
-       -> Session
-       -> Frontends
-       -> Maybe AppRoute
-       -> R.Element
-toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType, open}) ary)} /\ _) session frontends mCurrentRoute = R.createElement el {} []
+toHtml
+  :: R.State Reload
+  -> R.State Tree
+  -> Session
+  -> Frontends
+  -> Maybe AppRoute
+  -> Memory
+  -> Memories.Action -> Effect Unit
+  -> R.Element
+toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType, open}) ary)} /\ _) session frontends mCurrentRoute memory remember = R.createElement el {} []
   where
     el = R.hooksComponent "NodeView" cpt
     pAction = performAction session reload treeState
 
     cpt props _ = do
+      open <- 
       folderOpen@(o /\ _) <- R.useState' false
-      let open' = o || open
+      let open' = o || maybe false fst open
       let withId (NTree (LNode {id: id', open:open'}) _) = id'
 
       pure $ H.ul {}
         [ H.li {}
           ( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute, open:open'} folderOpen session frontends ]
-            <> childNodes session frontends reload folderOpen mCurrentRoute ary
+            <> childNodes session frontends reload folderOpen mCurrentRoute memory remember ary
           )
         ]
 
-
-childNodes :: Session
-           -> Frontends
-           -> R.State Reload
-           -> R.State Boolean
-           -> Maybe AppRoute
-           -> Array FTree
-           -> Array R.Element
-childNodes _ _ _ _ _ [] = []
-childNodes _ _ _ (false /\ _) _ _ = []
-childNodes session frontends reload (true /\ _) mCurrentRoute ary =
+childNodes
+  :: Session
+     -> Frontends
+     -> R.State Reload
+     -> R.State Boolean
+     -> Maybe AppRoute
+     -> Memory
+     -> Memories.Action -> Effect Unit
+     -> Array FTree
+     -> Array R.Element
+childNodes _ _ _ _ _ _ _ [] = []
+childNodes _ _ _ (false /\ _) _ _ _ _ = []
+childNodes session frontends reload (true /\ _) mCurrentRoute memory remember ary =
   map (\ctree -> childNode {tree: ctree}) ary
     where
       childNode :: Tree -> R.Element
@@ -101,7 +116,7 @@ childNodes session frontends reload (true /\ _) mCurrentRoute ary =
       el = R.hooksComponent "ChildNodeView" cpt
       cpt {tree} _ = do
         treeState <- R.useState' {tree}
-        pure $ toHtml reload treeState session frontends mCurrentRoute
+        pure $ toHtml reload treeState session frontends mCurrentRoute memory remember
 
 
 performAction :: Session

src/Gargantext/Types.purs

@@ -8,6 +8,7 @@ import Prim.Row (class Union)
 import URI.Query (Query)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Ord (genericCompare)
 import Data.Generic.Rep.Show (genericShow)
 
 newtype SessionId = SessionId String
@@ -17,9 +18,18 @@ derive instance genericSessionId :: Generic SessionId _
 instance eqSessionId :: Eq SessionId where
   eq = genericEq
 
+instance ordSessionId :: Ord SessionId where
+  compare = genericCompare
+
 instance showSessionId :: Show SessionId where
   show (SessionId s) = s
 
+instance decodeJsonSessionId :: DecodeJson SessionId where
+  decodeJson json = SessionId <$> decodeJson json
+
+instance encodeJsonSessionId :: EncodeJson SessionId where
+  encodeJson (SessionId s) = encodeJson s
+
 data TermSize = MonoTerm | MultiTerm
 
 data Term = Term String TermList