[REFACT|Tree/Action] WIP

src/Gargantext/Components/Forest/Tree/Node/Action.purs

@@ -24,123 +24,7 @@ data Action = CreateSubmit String GT.NodeType
             | RefreshTree
 
 -----------------------------------------------------
--- UploadFile Action
--- file upload types
-data FileType = CSV | CSV_HAL | WOS | PresseRIS
-
-derive instance genericFileType :: Generic FileType _
-
-instance eqFileType :: Eq FileType where
-    eq = genericEq
-
-instance showFileType :: Show FileType where
-    show = genericShow
-
-readFileType :: String -> Maybe FileType
-readFileType "CSV"       = Just CSV
-readFileType "CSV_HAL"   = Just CSV_HAL
-readFileType "PresseRIS" = Just PresseRIS
-readFileType "WOS"       = Just WOS
-readFileType _           = Nothing
-
-data DroppedFile =
-  DroppedFile { contents :: UploadFileContents
-              , fileType :: Maybe FileType
-              , lang     :: Maybe Lang
-              }
-
-type FileHash = String
-
-type Name = String
-type ID   = Int
-type Reload = Int
-
-newtype UploadFileContents = UploadFileContents String
-type UploadFile = 
-  { contents :: UploadFileContents
-  , name     :: String
-  }
-
-
-
-renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
-renameNode session renameNodeId = put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
-
-deleteNode :: Session -> ID -> Aff ID
+-- TODO Delete with asyncTaskWithType
+deleteNode :: Session -> GT.ID -> Aff GT.ID
 deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
-
-loadNode :: Session -> ID -> Aff FTree
-loadNode session nodeId = get session $ NodeAPI GT.Tree (Just nodeId) ""
-
-{-
-updateNode :: Session -> ID -> Aff ID
-updateNode session nodeId = post session 
--}
-
 -----------------------------------------------------------------------
-newtype RenameValue = RenameValue
-  { name :: Name }
-
-instance encodeJsonRenameValue :: EncodeJson RenameValue where
-  encodeJson (RenameValue {name})
-     = "r_name" := name
-    ~> jsonEmptyObject
-
------------------------------------------------------------------------
------------------------------------------------------------------------
-data UpdateNodeParams = UpdateNodeParamsList { method :: Int }
-                      | UpdateNodeParamsGraph { method :: String }
-                      | UpdateNodeParamsTexts { method :: Int }
-
-instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
-  where
-    encodeJson (UpdateNodeParamsList { method })
-      = "method" := method
-      ~> jsonEmptyObject
-    encodeJson (UpdateNodeParamsGraph { method })
-      = "method" := method
-      ~> jsonEmptyObject
-    encodeJson (UpdateNodeParamsTexts { method })
-      = "method" := method
-      ~> jsonEmptyObject
-
-
------------------------------------------------------------------------
-
-
-data NTree a = NTree a (Array (NTree a))
-type FTree = NTree LNode
-type Tree = { tree       :: FTree
-            , asyncTasks :: Array GT.AsyncTaskWithType
-            }
-
-instance ntreeFunctor :: Functor NTree where
-  map f (NTree x ary) = NTree (f x) (map (map f) ary)
-
-newtype LNode = LNode { id :: ID
-                      , name :: Name
-                      , nodeType :: GT.NodeType
-                      }
-
-derive instance newtypeLNode :: Newtype LNode _
-
-instance decodeJsonLNode :: DecodeJson LNode where
-  decodeJson json = do
-    obj  <- decodeJson json
-    id_  <- obj .: "id"
-    name <- obj .: "name"
-    nodeType <- obj .: "type"
-    pure $ LNode { id : id_
-                 , name
-                 , nodeType
-                 }
-
-instance decodeJsonFTree :: DecodeJson (NTree LNode) where
-  decodeJson json = do
-    obj    <- decodeJson json
-    node   <- obj .: "node"
-    nodes  <- obj .: "children"
-    node'  <- decodeJson node
-    nodes' <- decodeJson nodes
-    pure $ NTree node' nodes'
-

src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs

@@ -18,8 +18,7 @@ import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<
 import Reactix as R
 import Reactix.DOM.HTML as H
 
--- START Create Node
-
+----------------------------------------------------------------------
 addNode :: Session -> ID -> AddNodeValue -> Aff (Array ID)
 addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
 
@@ -34,6 +33,7 @@ addNodeAsync session parentId q = do
     p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
 
 ----------------------------------------------------------------------
+-- TODO AddNodeParams
 newtype AddNodeValue = AddNodeValue
   { name     :: Name
   , nodeType :: GT.NodeType
@@ -46,15 +46,13 @@ instance encodeJsonAddNodeValue :: EncodeJson AddNodeValue where
     ~> jsonEmptyObject
 
 ----------------------------------------------------------------------
-
-type Dispatch = Action -> Aff Unit
 data NodePopup = CreatePopup | NodePopup
 
 type CreateNodeProps =
-  ( id       :: ID
-  , dispatch :: Action -> Aff Unit
-  , name     :: Name
-  , nodeType :: NodeType
+  ( id        :: ID
+  , dispatch  :: Action -> Aff Unit
+  , name      :: Name
+  , nodeType  :: NodeType
   , nodeTypes :: Array NodeType
   )
 

src/Gargantext/Components/Forest/Tree/Node/Action/CopyFrom.purs

+module Gargantext.Components.Forest.Tree.Node.Action.CopyFrom where
+
+import Data.Array as A
+import Data.Maybe (Maybe(..), fromJust)
+import Data.Newtype (class Newtype)
+import Data.Tuple (Tuple(..))
+import Data.Tuple.Nested ((/\))
+import DOM.Simple.Console (log2)
+import Effect.Aff (Aff, launchAff)
+import Effect.Class (liftEffect)
+import Effect (Effect)
+import Partial.Unsafe (unsafePartial)
+import React.SyntheticEvent as E
+import Reactix as R
+import Reactix.DOM.HTML as H
+import URI.Extra.QueryPairs as QP
+import Web.File.FileReader.Aff (readAsText)
+
+import Gargantext.Prelude (class Show, Unit, bind, const, discard, map, pure, show, unit, void, ($), (&&), (/=), (<>))
+
+import Gargantext.Components.Lang (readLang, Lang(..))
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
+import Gargantext.Components.Forest.Tree.Node.FTree (FTree, ID, LNode(..), NTree(..))
+import Gargantext.Hooks.Loader (useLoader)
+import Gargantext.Routes as GR
+import Gargantext.Sessions (Session(..), postWwwUrlencoded, get)
+import Gargantext.Types as GT
+import Gargantext.Utils (id)
+import Gargantext.Utils.Reactix as R2
+
+
+loadNode :: Session -> GT.ID -> Aff FTree
+loadNode session nodeId = get session $ NodeAPI GT.Tree (Just nodeId) ""
+
+copyFromCorpusView :: Record Props -> R.Element
+copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
+
+copyFromCorpusViewCpt :: R.Component Props
+copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
+  where
+    cpt {dispatch, id, nodeType, session} _ = do
+      useLoader session loadCorporaTree $
+        \tree ->
+          copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
+
+type CorpusTreeProps =
+  ( tree :: FTree
+  | Props
+  )
+
+copyFromCorpusViewLoaded :: Record CorpusTreeProps -> R.Element
+copyFromCorpusViewLoaded props = R.createElement copyFromCorpusViewLoadedCpt props []
+
+copyFromCorpusViewLoadedCpt :: R.Component CorpusTreeProps
+copyFromCorpusViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusViewLoadedCpt" cpt
+  where
+    cpt p@{dispatch, id, nodeType, session, tree} _ = do
+      pure $ H.div { className: "copy-from-corpus" } [
+        H.div { className: "tree" } [copyFromCorpusTreeView p]
+      ]
+
+copyFromCorpusTreeView :: Record CorpusTreeProps -> R.Element
+copyFromCorpusTreeView props = R.createElement copyFromCorpusTreeViewCpt props []
+
+copyFromCorpusTreeViewCpt :: R.Component CorpusTreeProps
+copyFromCorpusTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusTreeViewCpt" cpt
+  where
+    cpt p@{id, tree: NTree (LNode { id: sourceId, name, nodeType }) ary} _ = do
+      pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} []
+      , -} H.div { className: "node" } ([ H.span { className: "name " <> clickable
+                                                              , on: { click: onClick }
+                                                              } [ H.text name ]
+
+                                                     ] <> children)
+                      -- ]
+      where
+        children = map (\c -> copyFromCorpusTreeView (p { tree = c })) ary
+        validNodeType = (A.elem nodeType [GT.NodeList]) && (id /= sourceId)
+        clickable = if validNodeType then "clickable" else ""
+        onClick _ = case validNodeType of
+          false -> pure unit
+          true  -> do
+            log2 "[copyFromCorpusTreeViewCpt] issue copy into" id
+            log2 "[copyFromCorpusTreeViewCpt] issue copy from" sourceId
+
+loadCorporaTree :: Session -> Aff FTree
+loadCorporaTree session = getCorporaTree session treeId
+  where
+    Session { treeId } = session
+
+getCorporaTree :: Session -> Int -> Aff FTree
+getCorporaTree session treeId = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
+  where
+    nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" [ GT.FolderPrivate
+                                                             , GT.FolderShared
+                                                             , GT.Team
+                                                             , GT.FolderPublic
+                                                             , GT.Folder
+                                                             , GT.Corpus
+                                                             , GT.NodeList]

src/Gargantext/Components/Forest/Tree/Node/Action/Rename.purs

@@ -12,14 +12,25 @@ import Gargantext.Types (NodeType)
 import Gargantext.Utils.Reactix as R2
 
 
-type Dispatch = Action -> Aff Unit
+renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
+renameNode session renameNodeId =
+  put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
+
+newtype RenameValue = RenameValue
+  { name :: Name }
+
+instance encodeJsonRenameValue :: EncodeJson RenameValue where
+  encodeJson (RenameValue {name})
+     = "r_name" := name
+    ~> jsonEmptyObject
+
 
 -- | START Rename Box
 type RenameBoxProps =
-  ( id :: ID
-  , dispatch :: Dispatch
-  , name :: Name
-  , nodeType :: NodeType
+  ( id            :: ID
+  , dispatch      :: Action -> Aff Unit
+  , name          :: Name
+  , nodeType      :: NodeType
   , renameBoxOpen :: R.State Boolean
   )
 
@@ -65,5 +76,3 @@ renameBox p@{ renameBoxOpen: (false /\ _) } = R.createElement el p []
 
 -- END Rename Box
 
-
-

src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs

+module Gargantext.Components.Forest.Tree.Node.Action.Update where
+
+import Data.Array (length, head)
+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
+import Data.Maybe (Maybe(..), fromMaybe)
+-- import Data.Newtype (class Newtype)
+import Data.Tuple.Nested ((/\))
+import Effect.Aff (Aff, launchAff)
+import Effect.Uncurried (mkEffectFn1)
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..), ID, Name)
+import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
+import Gargantext.Types (NodeType(..), readNodeType)
+import Gargantext.Utils.Reactix as R2
+import Gargantext.Sessions (Session, post)
+import Gargantext.Routes as GR
+import Gargantext.Types  as GT
+import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<<))
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+{-
+updateNode :: Session -> ID -> UpdateNodeParams -> Aff (Array ID)
+updateNode session nodeId params = post session $ GR.NodeAPI GT.Node (Just nodeId) ""
+-}
+
+data UpdateNodeParams = UpdateNodeParamsList { method :: Int }
+                      | UpdateNodeParamsGraph { method :: String }
+                      | UpdateNodeParamsTexts { method :: Int }
+
+instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
+  where
+    encodeJson (UpdateNodeParamsList { method })
+      = "method" := method
+      ~> jsonEmptyObject
+    encodeJson (UpdateNodeParamsGraph { method })
+      = "method" := method
+      ~> jsonEmptyObject
+    encodeJson (UpdateNodeParamsTexts { method })
+      = "method" := method
+      ~> jsonEmptyObject
+----------------------------------------------------------------------
+
+type UpdateNodeProps =
+  ( id       :: ID
+  , dispatch :: Action -> Aff Unit
+  , name     :: Name
+  , nodeType :: NodeType
+  , params   :: UpdateNodeParams
+  )
+

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

@@ -19,7 +19,8 @@ import Web.File.FileReader.Aff (readAsText)
 import Gargantext.Prelude (class Show, Unit, bind, const, discard, map, pure, show, unit, void, ($), (&&), (/=), (<>))
 
 import Gargantext.Components.Lang (readLang, Lang(..))
-import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FTree, FileType(..), ID, LNode(..), NTree(..), UploadFile, UploadFileContents(..), readFileType)
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
+import Gargantext.Components.Forest.Tree.Node.FTree (FTree, ID, LNode(..), NTree(..))
 import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Routes as GR
 import Gargantext.Sessions (Session(..), postWwwUrlencoded, get)
@@ -27,16 +28,46 @@ import Gargantext.Types as GT
 import Gargantext.Utils (id)
 import Gargantext.Utils.Reactix as R2
 
-type Dispatch = Action -> Aff Unit
+-- UploadFile Action
+-- file upload types
+data FileType = CSV | CSV_HAL | WOS | PresseRIS
+
+derive instance genericFileType :: Generic FileType _
+
+instance eqFileType :: Eq FileType where
+    eq = genericEq
+
+instance showFileType :: Show FileType where
+    show = genericShow
+
+readFileType :: String -> Maybe FileType
+readFileType "CSV"       = Just CSV
+readFileType "CSV_HAL"   = Just CSV_HAL
+readFileType "PresseRIS" = Just PresseRIS
+readFileType "WOS"       = Just WOS
+readFileType _           = Nothing
+
+data DroppedFile =
+  DroppedFile { contents :: UploadFileContents
+              , fileType :: Maybe FileType
+              , lang     :: Maybe Lang
+              }
+
+type FileHash = String
+
+newtype UploadFileContents = UploadFileContents String
+type UploadFile = 
+  { contents :: UploadFileContents
+  , name     :: String
+  }
 
 type Props =
-  ( dispatch :: Dispatch
+  ( dispatch :: Action -> Aff Unit
   , id       :: Int
   , nodeType :: GT.NodeType
   , session  :: Session
   )
 
-
 uploadFileView :: Record Props -> R.Element
 uploadFileView props = R.createElement uploadFileViewCpt props []
 
@@ -44,7 +75,7 @@ uploadFileViewCpt :: R.Component Props
 uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
   where
     cpt {dispatch, id, nodeType} _ = do
-      mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
+      mFile    :: R.State (Maybe UploadFile) <- R.useState' Nothing
       fileType :: R.State FileType     <- R.useState' CSV
       lang     :: R.State (Maybe Lang) <- R.useState' (Just EN)
 
@@ -112,9 +143,9 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
 type UploadButtonProps =
   ( dispatch :: Dispatch
   , fileType :: R.State FileType
-  , id :: Int
-  , lang :: R.State (Maybe Lang)
-  , mFile :: R.State (Maybe UploadFile)
+  , id       :: GT.ID
+  , lang     :: R.State (Maybe Lang)
+  , mFile    :: R.State (Maybe UploadFile)
   , nodeType :: GT.NodeType
   )
 
@@ -310,69 +341,3 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
             liftEffect $ do
               setMFile $ const $ Nothing
 
-copyFromCorpusView :: Record Props -> R.Element
-copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
-
-copyFromCorpusViewCpt :: R.Component Props
-copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
-  where
-    cpt {dispatch, id, nodeType, session} _ = do
-      useLoader session loadCorporaTree $
-        \tree ->
-          copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
-
-type CorpusTreeProps =
-  ( tree :: FTree
-  | Props
-  )
-
-copyFromCorpusViewLoaded :: Record CorpusTreeProps -> R.Element
-copyFromCorpusViewLoaded props = R.createElement copyFromCorpusViewLoadedCpt props []
-
-copyFromCorpusViewLoadedCpt :: R.Component CorpusTreeProps
-copyFromCorpusViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusViewLoadedCpt" cpt
-  where
-    cpt p@{dispatch, id, nodeType, session, tree} _ = do
-      pure $ H.div { className: "copy-from-corpus" } [
-        H.div { className: "tree" } [copyFromCorpusTreeView p]
-      ]
-
-copyFromCorpusTreeView :: Record CorpusTreeProps -> R.Element
-copyFromCorpusTreeView props = R.createElement copyFromCorpusTreeViewCpt props []
-
-copyFromCorpusTreeViewCpt :: R.Component CorpusTreeProps
-copyFromCorpusTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusTreeViewCpt" cpt
-  where
-    cpt p@{id, tree: NTree (LNode { id: sourceId, name, nodeType }) ary} _ = do
-      pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} []
-      , -} H.div { className: "node" } ([ H.span { className: "name " <> clickable
-                                                              , on: { click: onClick }
-                                                              } [ H.text name ]
-
-                                                     ] <> children)
-                      -- ]
-      where
-        children = map (\c -> copyFromCorpusTreeView (p { tree = c })) ary
-        validNodeType = (A.elem nodeType [GT.NodeList]) && (id /= sourceId)
-        clickable = if validNodeType then "clickable" else ""
-        onClick _ = case validNodeType of
-          false -> pure unit
-          true  -> do
-            log2 "[copyFromCorpusTreeViewCpt] issue copy into" id
-            log2 "[copyFromCorpusTreeViewCpt] issue copy from" sourceId
-
-loadCorporaTree :: Session -> Aff FTree
-loadCorporaTree session = getCorporaTree session treeId
-  where
-    Session { treeId } = session
-
-getCorporaTree :: Session -> Int -> Aff FTree
-getCorporaTree session treeId = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
-  where
-    nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" [ GT.FolderPrivate
-                                                             , GT.FolderShared
-                                                             , GT.Team
-                                                             , GT.FolderPublic
-                                                             , GT.Folder
-                                                             , GT.Corpus
-                                                             , GT.NodeList]

src/Gargantext/Components/Forest/Tree/Node/Box.purs

@@ -30,6 +30,7 @@ import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..),
 import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, Reload, UploadFileContents(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
 import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
+import Gargantext.Components.Forest.Tree.Node.Action.Update
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
 import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..))
 import Gargantext.Components.GraphExplorer.API as GraphAPI

src/Gargantext/Components/Forest/Tree/Node/FTree.purs

+module Gargantext.Components.Forest.Tree.Node.FTree where
+
+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype)
+import Effect.Aff (Aff)
+import Prelude hiding (div)
+
+import Gargantext.Components.Lang (Lang)
+import Gargantext.Routes (SessionRoute(..))
+import Gargantext.Sessions (Session, get, put, post, delete)
+import Gargantext.Routes as GR
+import Gargantext.Types  as GT
+
+-----------------------------------------------------------------------
+type ID   = Int
+type Name = String
+-----------------------------------------------------------------------
+type FTree = NTree LNode
+data NTree a = NTree a (Array (NTree a))
+type Tree = { tree       :: FTree
+            , asyncTasks :: Array GT.AsyncTaskWithType
+            }
+
+instance ntreeFunctor :: Functor NTree where
+  map f (NTree x ary) = NTree (f x) (map (map f) ary)
+
+newtype LNode = LNode { id :: ID
+                      , name :: Name
+                      , nodeType :: GT.NodeType
+                      }
+
+derive instance newtypeLNode :: Newtype LNode _
+
+instance decodeJsonLNode :: DecodeJson LNode where
+  decodeJson json = do
+    obj  <- decodeJson json
+    id_  <- obj .: "id"
+    name <- obj .: "name"
+    nodeType <- obj .: "type"
+    pure $ LNode { id : id_
+                 , name
+                 , nodeType
+                 }
+
+instance decodeJsonFTree :: DecodeJson (NTree LNode) where
+  decodeJson json = do
+    obj    <- decodeJson json
+    node   <- obj .: "node"
+    nodes  <- obj .: "children"
+    node'  <- decodeJson node
+    nodes' <- decodeJson nodes
+    pure $ NTree node' nodes'
+

src/Gargantext/Types.purs

@@ -15,6 +15,9 @@ import Effect.Aff (Aff)
 import Prim.Row (class Union)
 import URI.Query (Query)
 
+type ID   = Int
+type Name = String
+
 newtype SessionId = SessionId String
 type NodeID = Int