Commit 9b7d6db6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[REFACT] performAction parameters clearer + code alignment

parent 8b8e6345
...@@ -33,27 +33,45 @@ forestCpt :: R.Component Props ...@@ -33,27 +33,45 @@ forestCpt :: R.Component Props
forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
cpt { frontends, reload: extReload, route, sessions, showLogin } _ = do cpt { frontends, reload: extReload, route, sessions, showLogin } _ = do
-- NOTE: this is a hack to reload the tree view on demand -- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload) reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes) openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
R2.useCache R2.useCache
(frontends /\ route /\ sessions /\ fst openNodes /\ fst extReload /\ fst reload /\ fst asyncTasks) ( frontends
/\ route
/\ sessions
/\ fst openNodes
/\ fst extReload
/\ fst reload
/\ fst asyncTasks
)
(cpt' openNodes asyncTasks reload showLogin) (cpt' openNodes asyncTasks reload showLogin)
cpt' openNodes asyncTasks reload showLogin (frontends /\ route /\ sessions /\ _ /\ _ /\ _ /\ _) = do cpt' openNodes asyncTasks reload showLogin (frontends /\ route /\ sessions /\ _ /\ _ /\ _ /\ _) = do
pure $ R.fragment $ A.cons (plus showLogin) trees pure $ R.fragment $ A.cons (plus showLogin) trees
where where
trees = tree <$> unSessions sessions trees = tree <$> unSessions sessions
tree s@(Session {treeId}) = tree s@(Session {treeId}) =
treeView { root: treeId, asyncTasks, frontends, mCurrentRoute: Just route, session: s, openNodes, reload } treeView { root: treeId
, asyncTasks
, frontends
, mCurrentRoute: Just route
, session: s
, openNodes
, reload
}
plus :: R2.Setter Boolean -> R.Element plus :: R2.Setter Boolean -> R.Element
plus showLogin = plus showLogin =
H.button {on: {click}, className: "btn btn-primary"} H.button { on: {click}
[ H.div { "type": "", className: "fa fa-universal-access fa-lg"} [H.text " Log "] , className: "btn btn-primary"
, H.div {} [H.text " "] }
[ H.div { "type": ""
, className: "fa fa-universal-access fa-lg"
} [H.text " Log "]
, H.div {} [H.text " "]
--, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} [] --, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
--, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} [] --, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
] ]
-- TODO same as the one in the Login Modal (same CSS) -- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ] -- [ H.i { className: "material-icons md-36"} [] ]
where where
......
...@@ -30,7 +30,6 @@ import Record as Record ...@@ -30,7 +30,6 @@ import Record as Record
import Record.Extra as RecordE import Record.Extra as RecordE
------------------------------------------------------------------------ ------------------------------------------------------------------------
type CommonProps = type CommonProps =
( frontends :: Frontends ( frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute , mCurrentRoute :: Maybe AppRoute
...@@ -63,8 +62,7 @@ treeLoadView p = R.createElement treeLoadViewCpt p [] ...@@ -63,8 +62,7 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
where where
cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do
let fetch _ = loadNode session root let fetch _ = loadNode session root
let paint loaded = loadedTreeView { let paint loaded = loadedTreeView { asyncTasks
asyncTasks
, frontends , frontends
, mCurrentRoute , mCurrentRoute
, openNodes , openNodes
...@@ -112,7 +110,7 @@ toHtml p@{ asyncTasks ...@@ -112,7 +110,7 @@ toHtml p@{ asyncTasks
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
commonProps = RecordE.pick p :: Record CommonProps commonProps = RecordE.pick p :: Record CommonProps
pAction = performAction (RecordE.pick p :: Record PerformActionProps) pAction a = performAction a (RecordE.pick p :: Record PerformActionProps)
cpt _ _ = do cpt _ _ = do
let nodeId = mkNodeId session id let nodeId = mkNodeId session id
...@@ -173,58 +171,73 @@ type PerformActionProps = ...@@ -173,58 +171,73 @@ type PerformActionProps =
, tree :: FTree , tree :: FTree
) )
performAction :: Record PerformActionProps performAction :: Action
-> Action -> Record PerformActionProps
-> Aff Unit -> Aff Unit
performAction p@{ openNodes: (_ /\ setOpenNodes) performAction DeleteNode p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload) , reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) } DeleteNode = do , tree: (NTree (LNode {id}) _)
void $ deleteNode session id } =
liftEffect do do
setOpenNodes (Set.delete (mkNodeId session id)) void $ deleteNode session id
performAction p RefreshTree liftEffect do
setOpenNodes (Set.delete (mkNodeId session id))
performAction { reload: (_ /\ setReload) performAction RefreshTree p
, session
, tasks: { onTaskAdd } performAction (DoSearch task) { reload: (_ /\ setReload)
, tree: (NTree (LNode {id}) _) } (DoSearch task) = do , session
liftEffect $ onTaskAdd task , tasks: { onTaskAdd }
liftEffect $ log2 "[performAction] DoSearch task:" task , tree: (NTree (LNode {id}) _)
} =
performAction { reload: (_ /\ setReload) do
, session liftEffect $ onTaskAdd task
, tasks: {onTaskAdd} liftEffect $ log2 "[performAction] DoSearch task:" task
, tree: (NTree (LNode {id}) _) } (UpdateNode task) = do
liftEffect $ onTaskAdd task performAction (UpdateNode task) { reload: (_ /\ setReload)
liftEffect $ log2 "[performAction] UpdateNode task:" task , session
, tasks: {onTaskAdd}
performAction p@{ reload: (_ /\ setReload) , tree: (NTree (LNode {id}) _)
, session } =
, tree: (NTree (LNode {id}) _) } (RenameNode name) = do do
void $ rename session id $ RenameValue {text:name} liftEffect $ onTaskAdd task
performAction p RefreshTree liftEffect $ log2 "[performAction] UpdateNode task:" task
performAction p@{ reload: (_ /\ setReload) performAction (RenameNode name) p@{ reload: (_ /\ setReload)
, session , session
, tree: (NTree (LNode {id}) _) } (ShareNode username) = do , tree: (NTree (LNode {id}) _)
void $ share session id $ ShareValue {text:username} }
=
performAction p@{ openNodes: (_ /\ setOpenNodes) do
, reload: (_ /\ setReload) void $ rename session id $ RenameValue {text:name}
, session performAction RefreshTree p
, tree: (NTree (LNode {id}) _) } (AddNode name nodeType) = do
task <- addNode session id $ AddNodeValue {name, nodeType} performAction (ShareNode username) p@{ reload: (_ /\ setReload)
liftEffect do , session
setOpenNodes (Set.insert (mkNodeId session id)) , tree: (NTree (LNode {id}) _)
performAction p RefreshTree } =
do
performAction { session void $ share session id $ ShareValue {text:username}
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _) } (UploadFile nodeType fileType mName contents) = do performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
task <- uploadFile session nodeType id fileType {mName, contents} , reload: (_ /\ setReload)
liftEffect $ onTaskAdd task , session
liftEffect $ log2 "uploaded, task:" task , tree: (NTree (LNode {id}) _)
} =
performAction { reload: (_ /\ setReload) } RefreshTree = do do
task <- addNode session id $ AddNodeValue {name, nodeType}
liftEffect do
setOpenNodes (Set.insert (mkNodeId session id))
performAction RefreshTree p
performAction (UploadFile nodeType fileType mName contents) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadFile session nodeType id fileType {mName, contents}
liftEffect $ onTaskAdd task
liftEffect $ log2 "uploaded, task:" task
performAction RefreshTree { reload: (_ /\ setReload) } = do
liftEffect $ setReload (_ + 1) liftEffect $ setReload (_ + 1)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment