Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev

package.json

 {
     "name": "Gargantext",
-    "version": "0.0.1.4.2",
+    "version": "0.0.1.5",
     "scripts": {
         "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
         "rebuild-set": "spago psc-package-insdhall",

src/Gargantext/Components/Forest.purs

@@ -3,21 +3,19 @@ module Gargantext.Components.Forest where
 import Gargantext.Prelude
 
 import Data.Array as A
-import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Set as Set
 import Data.Tuple (fst)
 import Data.Tuple.Nested ((/\))
-import Effect (Effect)
 import Reactix as R
 import Reactix.DOM.HTML as H
 
 import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree (treeView)
-import Gargantext.Components.Forest.Tree.Node.Action (Reload)
 import Gargantext.Ends (Frontends)
 import Gargantext.Routes (AppRoute)
 import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
+import Gargantext.Types (Reload)
 import Gargantext.Utils.Reactix as R2
 
 type Props =

src/Gargantext/Components/Forest/Tree.purs

 module Gargantext.Components.Forest.Tree where
 
+import DOM.Simple.Console (log2)
 import Data.Array as A
-import Data.Map as Map
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe)
 import Data.Set as Set
 import Data.Tuple (Tuple(..), fst, snd)
 import Data.Tuple.Nested ((/\))
-import DOM.Simple.Console (log2)
-import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
-import Reactix as R
-import Reactix.DOM.HTML as H
-import Record as Record
-import Record.Extra as RecordE
-
 import Gargantext.AsyncTasks as GAT
-import Gargantext.Components.Forest.Tree.Node.Action (Action(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, deleteNode, loadNode, renameNode)
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
+import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (loadNode)
+import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode)
+import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
+import Gargantext.Components.Forest.Tree.Node.Action.Share (ShareValue(..), share)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
 import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan, Tasks, tasksStruct)
+import Gargantext.Components.Forest.Tree.Node.FTree (FTree, LNode(..), NTree(..))
 import Gargantext.Ends (Frontends)
 import Gargantext.Hooks.Loader (useLoader)
-import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>), identity)
+import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
 import Gargantext.Routes (AppRoute)
 import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
-import Gargantext.Types as GT
+import Gargantext.Types (ID, Reload)
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Record as Record
+import Record.Extra as RecordE
 
 ------------------------------------------------------------------------
 
@@ -186,9 +188,9 @@ performAction p@{ openNodes: (_ /\ setOpenNodes)
 performAction { reload: (_ /\ setReload)
               , session
               , tasks: { onTaskAdd }
-              , tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
+              , tree: (NTree (LNode {id}) _) } (DoSearch task) = do
   liftEffect $ onTaskAdd task
-  liftEffect $ log2 "[performAction] SearchQuery task:" task
+  liftEffect $ log2 "[performAction] DoSearch task:" task
 
 performAction { reload: (_ /\ setReload)
               , session
@@ -197,17 +199,21 @@ performAction { reload: (_ /\ setReload)
   liftEffect $ onTaskAdd task
   liftEffect $ log2 "[performAction] UpdateNode task:" task
 
-
 performAction p@{ reload: (_ /\ setReload)
                 , session
-                , tree: (NTree (LNode {id}) _) } (Submit name)  = do
-  void $ renameNode session id $ RenameValue {name}
+                , tree: (NTree (LNode {id}) _) } (RenameNode name)  = do
+  void $ rename session id $ RenameValue {text:name}
   performAction p RefreshTree
 
+performAction p@{ reload: (_ /\ setReload)
+                , session
+                , tree: (NTree (LNode {id}) _) } (ShareNode username)  = do
+  void $ share session id $ ShareValue {text:username}
+
 performAction p@{ openNodes: (_ /\ setOpenNodes)
                 , reload:    (_ /\ setReload)
                 , session
-                , tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
+                , tree: (NTree (LNode {id}) _) } (AddNode name nodeType) = do
   task <- addNode session id $ AddNodeValue {name, nodeType}
   liftEffect do
     setOpenNodes (Set.insert (mkNodeId session id))

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

@@ -2,17 +2,13 @@ module Gargantext.Components.Forest.Tree.Node where
 
 import Prelude (class Eq, class Show, show, (&&), (<>), (==))
 import Data.Array (foldl)
-import Data.Maybe (Maybe(..))
-import Data.Tuple (Tuple(..))
-
 import Gargantext.Types
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 {-
--- | TODO
-filterWithRights (show action if user can only)
-
+-- | RIGHT Management
+if user has access to node then he can do all his related actions
 -}
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -38,8 +34,8 @@ instance eqNodeAction :: Eq NodeAction where
   eq Clone Clone       = true
   eq Delete Delete     = true
   eq Share Share       = true
-  eq (Link x) (Link y) = true && (x == y)
-  eq (Add  x) (Add  y) = true && (x == y)
+  eq (Link x) (Link y) = (x == y)
+  eq (Add  x) (Add  y) = (x == y)
   eq CopyFromCorpus CopyFromCorpus = true
   eq Config Config     = true
   eq _ _               = false
@@ -61,16 +57,17 @@ instance showNodeAction :: Show NodeAction where
 
 
 glyphiconNodeAction :: NodeAction -> String
-glyphiconNodeAction (Documentation _) = "question-sign"
+glyphiconNodeAction (Documentation _) = "question-circle"
 glyphiconNodeAction Delete            = "trash"
 glyphiconNodeAction (Add _)           = "plus"
 glyphiconNodeAction SearchBox         = "search"
 glyphiconNodeAction Upload            = "upload"
-glyphiconNodeAction (Link _)          = "transfer"
+glyphiconNodeAction (Link _)          = "arrows-h"
 glyphiconNodeAction Download          = "download"
 glyphiconNodeAction CopyFromCorpus    = "random"
 glyphiconNodeAction Refresh           = "refresh"
 glyphiconNodeAction Config            = "wrench"
+glyphiconNodeAction Share             = "user-plus"
 glyphiconNodeAction _                 = ""
 
 
@@ -110,6 +107,7 @@ settingsBox Team = SettingsBox {
                     , Folder
                     , Annuaire
                     ]
+              , Share
               , Delete]
   }
 
@@ -155,7 +153,6 @@ settingsBox Corpus =
                                 ]
                           , Upload
                           , Download
-                            --, Share
                             --, Move
                             --, Clone
                           , Link Annuaire

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

 module Gargantext.Components.Forest.Tree.Node.Action 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 Data.Maybe (Maybe)
 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.Prelude
+import Gargantext.Sessions (Session)
 import Gargantext.Types  as GT
+import Gargantext.Components.Forest.Tree.Node (NodeAction(..), glyphiconNodeAction)
+
+type Props =
+  ( dispatch :: Action -> Aff Unit
+  , id       :: Int
+  , nodeType :: GT.NodeType
+  , session  :: Session
+  )
 
-data Action = CreateSubmit String GT.NodeType
+data Action = AddNode     String GT.NodeType
             | DeleteNode
             | UpdateNode  GT.AsyncTaskWithType
-            | SearchQuery GT.AsyncTaskWithType
-            | Submit      String
+            | RenameNode  String
+            | DoSearch    GT.AsyncTaskWithType
             | UploadFile  GT.NodeType FileType (Maybe String) UploadFileContents
             | RefreshTree
+            | ShareNode   String
+
 
------------------------------------------------------
--- UploadFile Action
--- file upload types
+instance showShow :: Show Action where
+  show  DeleteNode          = "DeleteNode"
+  show  RefreshTree         = "RefreshTree"
+  show (ShareNode   _      )= "ShareNode"
+  show (UpdateNode  _      )= "UpdateNode"
+  show (RenameNode  _      )= "RenameNode"
+  show (DoSearch    _      )= "SearchQuery"
+  show (AddNode     _ _    )= "AddNode"
+  show (UploadFile  _ _ _ _)= "UploadFile"
+
+-----------------------------------------------------------------------
+icon :: Action -> String
+icon (AddNode _ _)        = glyphiconNodeAction (Add [])
+icon DeleteNode           = glyphiconNodeAction Delete
+icon (UpdateNode _)       = glyphiconNodeAction Refresh
+icon (RenameNode _)       = glyphiconNodeAction Config
+icon (DoSearch   _)       = glyphiconNodeAction SearchBox
+icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
+icon RefreshTree          = glyphiconNodeAction Refresh
+icon (ShareNode _)        = glyphiconNodeAction Share
+-- icon _             = "hand-o-right"
+
+
+
+text :: Action -> String
+text  DeleteNode          = "Delete !"
+text  RefreshTree         = "Refresh Tree !"
+text (AddNode     _ _    )= "Add !"
+text (UpdateNode  _      )= "Update !"
+text (RenameNode  _      )= "Rename !"
+text (DoSearch    _      )= "Launch search !"
+text (ShareNode   _      )= "Share !"
+text (UploadFile  _ _ _ _)= "Upload File !"
+-----------------------------------------------------------------------
+
+-- TODO move code below elsewhere
 data FileType = CSV | CSV_HAL | WOS | PresseRIS
 
 derive instance genericFileType :: Generic FileType _
@@ -36,111 +73,4 @@ instance eqFileType :: Eq FileType where
 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
-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

 module Gargantext.Components.Forest.Tree.Node.Action.Add where
 
+import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
 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.Aff (Aff)
 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.Components.Forest.Tree.Node.Action (Action(..))
+import Gargantext.Components.Forest.Tree.Node.Tools (submitButton)
 import Gargantext.Routes as GR
+import Gargantext.Sessions (Session, post)
 import Gargantext.Types  as GT
-import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<<))
+import Gargantext.Types (NodeType(..), readNodeType)
+import Gargantext.Utils.Reactix as R2
+import Prelude (Unit, bind, const, 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 -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
 addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
 
 addNodeAsync :: Session
-                -> ID
+                -> GT.ID
                 -> AddNodeValue
                 -> Aff GT.AsyncTaskWithType
 addNodeAsync session parentId q = do
@@ -34,8 +33,9 @@ addNodeAsync session parentId q = do
     p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
 
 ----------------------------------------------------------------------
+-- TODO AddNodeParams
 newtype AddNodeValue = AddNodeValue
-  { name     :: Name
+  { name     :: GT.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        :: GT.ID
+  , dispatch  :: Action -> Aff Unit
+  , name      :: GT.Name
+  , nodeType  :: NodeType
   , nodeTypes :: Array NodeType
   )
 
@@ -64,11 +62,11 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
   where
     el = R.hooksComponent "AddNodeView" cpt
     cpt {id, name} _ = do
-      nodeName <- R.useState' "Name"
-      nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
+      nodeName@(name' /\ _) <- R.useState' "Name"
+      nodeType'@(nt /\ _)  <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
       pure $ H.div {}
           [ panelBody   readNodeType nodeName nodeType'
-          , panelFooter nodeName nodeType'
+          , submitButton (AddNode name' nt) dispatch -- panelFooter nodeName nodeType'
           ]
       where
         panelBody :: (String -> NodeType)
@@ -108,7 +106,7 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
                                          -- , showConfig nt
                                     ]
                                 else
-                                H.button { className : "btn btn-primary"
+                                H.button { className : "btn btn-primary center"
                                            , type : "button"
                                            , onClick : mkEffectFn1 $ \_ -> setNodeType ( const
                                                                                        $ fromMaybe nt 
@@ -118,19 +116,6 @@ addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
                                ]
 
 
-
-        panelFooter :: R.State String  -> R.State NodeType -> R.Element
-        panelFooter (name' /\ _) (nt /\ _) =
-          H.div {className: "panel-footer"}
-          [ H.button {className: "btn btn-primary text-center"
-                     , type: "button"
-                     , onClick: mkEffectFn1 $ \_ -> do
-                         -- TODO
-                         --setPopupOpen $ const Nothing
-                         launchAff    $ dispatch $ CreateSubmit name' nt
-                     } [H.text "Add"]
-          ]
-
 -- END Create Node
 
 showConfig :: NodeType -> R.Element

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

+module Gargantext.Components.Forest.Tree.Node.Action.CopyFrom where
+
+import DOM.Simple.Console (log2)
+import Data.Array as A
+import Data.Maybe (Maybe(..))
+import Effect.Aff (Aff)
+import Gargantext.Components.Forest.Tree.Node.Action (Props)
+import Gargantext.Components.Forest.Tree.Node.FTree (FTree, LNode(..), NTree(..))
+import Gargantext.Hooks.Loader (useLoader)
+import Gargantext.Prelude (discard, map, pure, show, unit, ($), (&&), (/=), (<>))
+import Gargantext.Routes as GR
+import Gargantext.Sessions (Session(..), get)
+import Gargantext.Types as GT
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+
+loadNode :: Session -> GT.ID -> Aff FTree
+loadNode session nodeId = get session $ GR.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/Delete.purs

+module Gargantext.Components.Forest.Tree.Node.Action.Delete
+  where
+
+import Data.Maybe (Maybe(..))
+import Gargantext.Prelude
+import Effect.Aff (Aff)
+import Gargantext.Types  as GT
+import Gargantext.Sessions (Session, delete)
+import Gargantext.Routes (SessionRoute(..))
+import Gargantext.Types (NodeType(..))
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
+import Reactix as R
+import Gargantext.Components.Forest.Tree.Node.Tools (submitButton)
+import Reactix.DOM.HTML as H
+
+-- TODO Delete with asyncTaskWithType
+deleteNode :: Session -> GT.ID -> Aff GT.ID
+deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
+
+-- | Action : Delete
+actionDelete :: NodeType -> (Action -> Aff Unit) -> R.Hooks R.Element
+actionDelete NodeUser _ = do
+  pure $ R.fragment [
+    H.div {style: {margin: "10px"}} 
+          [H.text $ "Yes, we are RGPD compliant!"
+                 <> " But you can not delete User Node yet."
+                 <> " We are still on development."
+                 <> " Thanks for your comprehensin."
+          ]
+  ]
+
+actionDelete _ dispatch = do
+  pure $ R.fragment [
+    H.div {style: {margin: "10px"}} 
+          (map (\t -> H.p {} [H.text t]) 
+               [ "Are your sure you want to delete it ?"
+               , "If yes, click again below."
+               ]
+          )
+    , submitButton DeleteNode dispatch
+    ]
+
+
+
+

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

+module Gargantext.Components.Forest.Tree.Node.Action.Documentation where
+
+import Gargantext.Prelude (map, pure, show, ($), (<>))
+import Gargantext.Types (NodeType)
+import Gargantext.Types as GT
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+-- | Action: Show Documentation
+actionDoc :: NodeType -> R.Hooks R.Element
+actionDoc nodeType =
+  pure $ R.fragment [ H.div { style: {margin: "10px"} }
+                            $ [ infoTitle nodeType ]
+                            <> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
+                    ]
+  where
+    infoTitle :: NodeType -> R.Element
+    infoTitle nt = H.div { style: {margin: "10px"}}
+                         [ H.h3 {} [H.text "Documentation about " ]
+                         , H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
+                         ]
+
+-- | TODO add documentation of all NodeType
+docOf :: NodeType -> Array String
+docOf GT.NodeUser = [ "This account is personal"
+                    , "See the instances terms of uses."
+                    ]
+docOf GT.FolderPrivate = ["This folder and its children are private only."]
+docOf GT.FolderPublic  = ["Soon, you will be able to build public folders to share your work with the world!"]
+docOf GT.FolderShared  = ["Soon, you will be able to build teams folders to share your work"]
+docOf nodeType         = ["More information on " <> show nodeType]
+
+
+

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

+module Gargantext.Components.Forest.Tree.Node.Action.Download where
+
+import Data.Maybe (Maybe(..))
+import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT)
+import Gargantext.Ends (url)
+import Gargantext.Prelude (pure, ($))
+import Gargantext.Routes as Routes
+import Gargantext.Sessions (Session)
+import Gargantext.Types (NodeType(..), ID)
+import Gargantext.Types as GT
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+-- | Action : Download
+actionDownload :: NodeType -> ID -> Session -> R.Hooks R.Element
+actionDownload NodeList id session = downloadButton href label info
+    where
+      href  = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
+      label = "Download List"
+      info  = "Info about the List as JSON format"
+
+actionDownload GT.Graph id session = downloadButton href label info
+    where
+      href  = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
+      label = "Download Graph"
+      info  = "Info about the Graph as GEXF format"
+
+actionDownload GT.Corpus id session = downloadButton href label info
+    where
+      href  = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
+      label = "Download Corpus"
+      info  = "Download as JSON"
+
+actionDownload GT.Texts id session = downloadButton href label info
+    where
+      href  = url session $ Routes.NodeAPI GT.Texts (Just id) ""
+      label = "Download texts"
+      info  = "TODO: fix the backend route. What is the expected result ?"
+
+actionDownload _ _ _ = pure $ fragmentPT $ "Soon, you will be able to dowload your file here "
+
+
+type Href  = String
+type Label = String
+type Info  = String
+downloadButton :: Href -> Label -> Info -> R.Hooks R.Element
+downloadButton href label info = do
+  pure $ R.fragment [ H.div { className: "row"}
+                            [ H.div { className: "col-md-2"} []
+                            , H.div { className: "col-md-7 flex-center"}
+                                    [ H.p {} [H.text info] ]
+                            ]
+                    , H.span { className: "row" }
+                             [ H.div { className: "panel-footer"}
+                               [ H.div { className: "col-md-3"} []
+                                       , H.div { className: "col-md-3 flex-center"}
+                                               [ H.a { className: "btn btn-primary"
+                                                     , style : { width: "50%" }
+                                                     , href
+                                                     , target: "_blank" }
+                                                     [ H.text label ]
+                                               ]
+                                       ]
+                               ]
+                    ]
+
+
+
+

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

 module Gargantext.Components.Forest.Tree.Node.Action.Rename where
 
-import Data.Tuple.Nested ((/\))
-import Effect.Aff (Aff, launchAff)
-import Effect.Uncurried (mkEffectFn1)
-import Prelude (Unit, bind, const, discard, pure, ($), (<<<))
-import Reactix as R
-import Reactix.DOM.HTML as H
-
+import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
+import Data.Maybe (Maybe(..))
+import Effect.Aff (Aff)
+import Prelude (($))
 import Gargantext.Components.Forest.Tree.Node.Action
-import Gargantext.Types (NodeType)
-import Gargantext.Utils.Reactix as R2
-
-
-type Dispatch = Action -> Aff Unit
-
--- | START Rename Box
-type RenameBoxProps =
-  ( id :: ID
-  , dispatch :: Dispatch
-  , name :: Name
-  , nodeType :: NodeType
-  , renameBoxOpen :: R.State Boolean
-  )
+import Gargantext.Types as GT
+import Gargantext.Types (ID)
+import Gargantext.Routes as GR
+import Gargantext.Sessions (Session, put)
 
-renameBox :: Record RenameBoxProps -> R.Element
-renameBox p@{ dispatch, renameBoxOpen: (true /\ setRenameBoxOpen) } = R.createElement el p []
-  where
-    el = R.hooksComponent "RenameBox" cpt
-    cpt {id, name, nodeType} _ = do
-      renameNodeName <- R.useState' name
-      pure $ H.div {className: "from-group row-no-padding"}
-        [ renameInput renameNodeName
-        , renameBtn renameNodeName
-        , cancelBtn
-        ]
-      where
-        renameInput (_ /\ setRenameNodeName) =
-          H.div {className: "col-md-8"}
-          [ H.input { type: "text"
-                    , placeholder: "Rename Node"
-                    , defaultValue: name
-                    , className: "form-control"
-                    , onInput: mkEffectFn1 $ setRenameNodeName <<< const <<< R2.unsafeEventValue
-                    }
-          ]
-        renameBtn (newName /\ _) =
-          H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
-              , type: "button"
-              , onClick: mkEffectFn1 $ \_ -> do
-                    setRenameBoxOpen $ const false
-                    launchAff $ dispatch $ Submit newName
-              , title: "Rename"
-              } []
-        cancelBtn =
-          H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
-              , type: "button"
-              , onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
-              , title: "Cancel"
-              } []
-renameBox p@{ renameBoxOpen: (false /\ _) } = R.createElement el p []
-  where
-    el = R.hooksComponent "RenameBox" cpt
-    cpt {name} _ = pure $ H.div {} []
+------------------------------------------------------------------------
+rename :: Session -> ID -> RenameValue -> Aff (Array ID)
+rename session renameNodeId =
+  put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename"
 
--- END Rename Box
+renameAction :: String -> Action
+renameAction newName = RenameNode newName
 
+------------------------------------------------------------------------
+newtype RenameValue = RenameValue
+  { text :: String }
 
+instance encodeJsonRenameValue :: EncodeJson RenameValue where
+  encodeJson (RenameValue {text})
+     = "r_name" := text
+    ~> jsonEmptyObject
 
+------------------------------------------------------------------------

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

+module Gargantext.Components.Forest.Tree.Node.Action.Search.Frame where
+
+{-
+import Data.Array as A
+import Data.Map as Map
+import Data.String as S
+import Gargantext.AsyncTasks as GAT
+import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..), FileType(..), UploadFileContents(..))
+import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
+import Gargantext.Components.Forest.Tree.Node.Action.CopyFrom (copyFromCorpusView)
+import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction)
+import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
+import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
+import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), uploadFileView, fileTypeView, uploadTermListView)
+import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..))
+import Gargantext.Components.Forest.Tree.Node.Tools
+import Gargantext.Components.GraphExplorer.API as GraphAPI
+import Gargantext.Components.Lang (allLangs, Lang(EN))
+import Gargantext.Components.NgramsTable.API as NTAPI
+import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
+import Gargantext.Ends (Frontends, url)
+-}
+
+import DOM.Simple as DOM
+import DOM.Simple.Event (MessageEvent)
+import DOM.Simple.EventListener (Callback, addEventListener, callback)
+import DOM.Simple.Window (window)
+import Data.Maybe (Maybe(..))
+import Data.Nullable (Nullable)
+import Data.Tuple (Tuple(..))
+import Data.Tuple.Nested ((/\))
+import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (Search, isIsTex_Advanced)
+import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..))
+import Gargantext.Components.Forest.Tree.Node.Box.Types
+import Gargantext.Prelude (discard, identity, pure, unit, ($), (<>), (==))
+import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as H
+import URI.Extra.QueryPairs as NQP
+import URI.Query as Query
+
+--------------------
+-- | Iframes
+searchIframes :: Record NodePopupProps
+              -> R.State Search
+              -> R.Ref (Nullable DOM.Element)
+              -> R.Element
+searchIframes {nodeType} search@(search' /\ _) iframeRef =
+  if isIsTex_Advanced search'.datafield then
+    H.div { className: "istex-search panel panel-default" }
+          [ iframeWith "https://istex.gargantext.org" search iframeRef ]
+  else
+    if Just Web == search'.datafield then
+      H.div { className: "istex-search panel panel-default" }
+            [ iframeWith "https://searx.gargantext.org" search iframeRef ]
+    else
+      H.div {} []
+
+iframeWith :: String
+           -> R.State Search
+           -> R.Ref (Nullable DOM.Element)
+           -> R.Element
+iframeWith url (search /\ setSearch) iframeRef =
+  H.iframe { src: isTexTermUrl search.term
+            ,width: "100%"
+            ,height: "100%"
+            ,ref: iframeRef
+            ,on: {
+              load: \_ -> do
+                 addEventListener window "message" (changeSearchOnMessage url)
+                 R2.postMessage iframeRef search.term
+                 }
+           } []
+  where
+    changeSearchOnMessage :: String -> Callback MessageEvent
+    changeSearchOnMessage url' =
+      callback $ \m -> if R2.getMessageOrigin m == url'
+                         then do
+                           let {url'', term} = R2.getMessageData m
+                           setSearch $ _ {url = url'', term = term}
+                         else
+                           pure unit
+    isTexTermUrl term = url <> query
+      where
+        query = Query.print $ NQP.print identity identity qp
+
+        qp = NQP.QueryPairs [
+          Tuple (NQP.keyFromString "query") (Just (NQP.valueFromString term))
+          ]
+

src/Gargantext/Components/Search/SearchBar.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchBar.purs

-module Gargantext.Components.Search.SearchBar
+module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar
   ( Props, searchBar, searchBarCpt
   ) where
 
@@ -7,11 +7,10 @@ import Data.Nullable (Nullable)
 import Reactix as R
 import Reactix.DOM.HTML as H
 
-import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
+import Gargantext.Components.Forest.Tree.Node.Action.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
 import Effect (Effect)
 import Gargantext.Components.Lang (Lang)
-import Gargantext.Components.Search.SearchField (Search, searchField)
-import Gargantext.Components.Search.Types (allDatabases) -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
+import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (Search, searchField)
 import Gargantext.Prelude (Unit, pure, ($))
 import Gargantext.Sessions (Session)
 import Gargantext.Types as GT

src/Gargantext/Components/Search/SearchField.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchField.purs

-module Gargantext.Components.Search.SearchField
+module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField
   ( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex, isIsTex_Advanced) where
 
 import Data.Maybe (Maybe(..), maybe, fromMaybe, isJust)
@@ -20,7 +20,7 @@ import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, ($), (&&
 
 import Gargantext.Data.Array (catMaybes)
 import Gargantext.Components.Lang (Lang)
-import Gargantext.Components.Search.Types (DataOriginApi(..), DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg, datafield2database)
+import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataOriginApi(..), DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, readDatabase, readOrg, datafield2database)
 import Gargantext.Sessions (Session)
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2

src/Gargantext/Components/Search/Types.purs → src/Gargantext/Components/Forest/Tree/Node/Action/Search/Types.purs

-module Gargantext.Components.Search.Types where
+module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
 
 import Data.Array (concat)
 import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
@@ -12,14 +12,13 @@ import Effect.Aff (Aff)
 import URI.Extra.QueryPairs as QP
 import URI.Query as Q
 
-import Gargantext.Prelude (class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
+import Gargantext.Prelude (id, class Eq, class Ord, class Show, bind, map, pure, show, ($), (<>))
 
 import Gargantext.Components.Lang
 import Gargantext.Ends (class ToUrl, backendUrl)
 import Gargantext.Routes as GR
 import Gargantext.Sessions (Session(..), post)
 import Gargantext.Types as GT
-import Gargantext.Utils (id)
 
 ------------------------------------------------------------------------
 class Doc a where

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

+module Gargantext.Components.Forest.Tree.Node.Action.Share where
+
+import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
+import Data.Maybe (Maybe(..))
+import Effect.Aff (Aff)
+import Prelude (($))
+import Reactix as R
+import Gargantext.Components.Forest.Tree.Node.Action
+import Gargantext.Types as GT
+import Gargantext.Types (ID)
+import Gargantext.Routes as GR
+import Gargantext.Sessions (Session, post)
+import Gargantext.Components.Forest.Tree.Node.Tools as Tools
+
+------------------------------------------------------------------------
+share :: Session -> ID -> ShareValue -> Aff (Array ID)
+share session nodeId =
+  post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
+
+shareAction :: String -> Action
+shareAction username = ShareNode username
+
+------------------------------------------------------------------------
+newtype ShareValue = ShareValue
+  { text :: String }
+
+instance encodeJsonShareValue :: EncodeJson ShareValue where
+  encodeJson (ShareValue {text})
+     = "username" := text
+    ~> jsonEmptyObject
+
+------------------------------------------------------------------------
+textInputBox :: Record Tools.TextInputBoxProps -> R.Element
+textInputBox  = Tools.textInputBox
+

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

+module Gargantext.Components.Forest.Tree.Node.Action.Update where
+
+
+import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
+import Effect.Aff (Aff)
+import Gargantext.Components.Forest.Tree.Node.Action (Action)
+import Gargantext.Types (NodeType)
+import Gargantext.Types  as GT
+import Gargantext.Prelude (Unit)
+
+{-
+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       :: GT.ID
+  , dispatch :: Action -> Aff Unit
+  , name     :: GT.Name
+  , nodeType :: NodeType
+  , params   :: UpdateNodeParams
+  )
+

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

+module Gargantext.Components.Forest.Tree.Node.Box.Types where
+
+import DOM.Simple as DOM
+import Data.Maybe (Maybe)
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Gargantext.Components.Forest.Tree.Node (NodeAction)
+import Gargantext.Components.Forest.Tree.Node.Action (Action)
+import Gargantext.Prelude (Unit)
+import Gargantext.Sessions (Session)
+import Gargantext.Types (ID, Name)
+import Gargantext.Types as GT
+
+type CommonProps =
+  ( dispatch :: Action -> Aff Unit
+  , session :: Session
+  )
+
+type NodePopupProps =
+  ( id             :: ID
+  , name           :: Name
+  , nodeType       :: GT.NodeType
+  , onPopoverClose :: DOM.Element -> Effect Unit
+  | CommonProps
+  )
+
+type NodePopupS =
+  ( action   :: Maybe NodeAction
+  , id       :: ID
+  , name     :: Name
+  , nodeType :: GT.NodeType
+  )
+
+

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/Components/Forest/Tree/Node/ProgressBar.purs

@@ -9,7 +9,6 @@ import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Timer (clearInterval, setInterval)
-import Gargantext.Components.Forest.Tree.Node.Action (ID)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get)
 import Gargantext.Types as GT
@@ -26,7 +25,7 @@ type Props =
   (
     asyncTask :: GT.AsyncTaskWithType
   , barType   :: BarType
-  , corpusId  :: ID
+  , corpusId  :: GT.ID
   , onFinish  :: Unit -> Effect Unit
   , session   :: Session
   )

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

+module Gargantext.Components.Forest.Tree.Node.Tools where
+
+import Data.String as S
+import Data.Tuple.Nested ((/\))
+import Effect.Aff (Aff, launchAff)
+import Effect.Uncurried (mkEffectFn1)
+import Gargantext.Components.Forest.Tree.Node.Action
+import Gargantext.Types (ID)
+import Gargantext.Utils.Reactix as R2
+import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<<<), (<>))
+import Reactix as R
+import Reactix.DOM.HTML as H
+
+------------------------------------------------------------------------
+-- | START Rename Box
+type TextInputBoxProps =
+  ( id       :: ID
+  , dispatch :: Action -> Aff Unit
+  , text     :: String
+  , isOpen   :: R.State Boolean
+  , boxName  :: String
+  , boxAction :: String -> Action
+  )
+
+textInputBox :: Record TextInputBoxProps -> R.Element
+textInputBox p@{ boxName, boxAction, dispatch, isOpen: (true /\ setIsOpen) } = R.createElement el p []
+  where
+    el = R.hooksComponent (boxName <> "Box") cpt
+    cpt {id, text} _ = do
+      renameNodeName <- R.useState' text
+      pure $ H.div {className: "from-group row-no-padding"}
+        [ textInput renameNodeName
+        , submitBtn   renameNodeName
+        , cancelBtn
+        ]
+      where
+        textInput (_ /\ setRenameNodeName) =
+          H.div {className: "col-md-8"}
+          [ H.input { type: "text"
+                    , placeholder: (boxName <> " Node")
+                    , defaultValue: text
+                    , className: "form-control"
+                    , onInput: mkEffectFn1 $ setRenameNodeName
+                                         <<< const
+                                         <<< R2.unsafeEventValue
+                    }
+          ]
+        submitBtn (newName /\ _) =
+          H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
+              , type: "button"
+              , onClick: mkEffectFn1 $ \_ -> do
+                    setIsOpen $ const false
+                    launchAff $ dispatch ( boxAction newName )
+              , title: "Submit"
+              } []
+        cancelBtn =
+          H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
+              , type: "button"
+              , onClick: mkEffectFn1 $ \_ -> setIsOpen $ const false
+              , title: "Cancel"
+              } []
+textInputBox p@{ boxName, isOpen: (false /\ _) } = R.createElement el p []
+  where
+    el = R.hooksComponent (boxName <> "Box") cpt
+    cpt {text} _ = pure $ H.div {} []
+
+-- | END Rename Box
+
+
+submitButton :: Action -> (Action -> Aff Unit) -> R.Element
+submitButton action dispatch =
+  H.div {className: "panel-footer"}
+            [ H.div {} []
+            , H.div { className: "center"}
+                    [ H.button { className : "btn btn-primary fa fa-" <> icon action
+                               , type: "button"
+                               , style : { width: "50%" }
+                               , id: S.toLower $ show action
+                               , title: show action
+                               , on: {click: \_ -> launchAff $ dispatch action}
+                               }
+                               [ H.text $ " " <> text action]
+                     ]
+            ]
+
+-- | Sugar Text style
+fragmentPT :: String -> R.Element
+fragmentPT text = H.div {style: {margin: "10px"}} [H.text text]
+
+

src/Gargantext/Components/Login.purs

@@ -63,7 +63,7 @@ modalCpt = R.hooksComponent "G.C.Login.modal" cpt where
             [ H.h2 {className: "text-primary center m-a-2"}
         [
           -- H.i {className: "material-icons md-36"} [ H.text "control_point" ]
-          H.span {className: "icon-text"} [ H.text "Gargantext" ] ] ]
+          H.span {className: "icon-text"} [ H.text "GarganText" ] ] ]
 
       closing = H.button { "type": "button", className: "close"
                            , "data": { dismiss: "modal" } }
@@ -208,8 +208,10 @@ formCpt = R.hooksComponent "G.C.Login.form" cpt where
 
 csrfTokenInput :: {} -> R.Element
 csrfTokenInput _ =
-  H.input { type: "hidden", name: "csrfmiddlewaretoken"
-          , value: csrfMiddlewareToken }-- TODO hard-coded CSRF token
+  H.input { type: "hidden"
+          , name: "csrfmiddlewaretoken"
+          , value: csrfMiddlewareToken
+          } -- TODO hard-coded CSRF token
 
 termsCheckbox :: R.State Boolean -> R.Element
 termsCheckbox setCheckBox =

src/Gargantext/Components/NgramsTable.purs

@@ -226,19 +226,27 @@ tableContainerCpt { dispatch
 
     editor = H.div {} $ maybe [] f ngramsParent
       where
-        f ngrams = [
-            H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
-          , NTC.renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
-          , H.button {className: "btn btn-primary", on: {click: (const $ dispatch AddTermChildren)}} [H.text "Save"]
-          , H.button {className: "btn btn-secondary", on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}} [H.text "Cancel"]
-          ]
+        f ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
+                   , NTC.renderNgramsTree { ngramsTable
+                                          , ngrams
+                                          , ngramsStyle: []
+                                          , ngramsClick
+                                          , ngramsEdit
+                                          }
+                   , H.button { className: "btn btn-primary"
+                              , on: {click: (const $ dispatch AddTermChildren)}
+                              } [H.text "Save"]
+                   , H.button { className: "btn btn-secondary"
+                              , on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
+                              } [H.text "Cancel"]
+                   ]
           where
             ngramsTable = ngramsTableCache # at ngrams
                           <<< _Just
                           <<< _NgramsElement
                           <<< _children
                           %~ applyPatchSet (patchSetFromMap ngramsChildren)
-            ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild true child
+            ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
             ngramsClick _ = Nothing
             ngramsEdit  _ = Nothing
 

src/Gargantext/Prelude.purs

-module Gargantext.Prelude (module Prelude, logs)
+module Gargantext.Prelude (module Prelude, logs, id)
   where
 
 import Prelude (class Applicative, class Apply, class Bind, class BooleanAlgebra, class Bounded, class Category, class CommutativeRing, class Discard, class DivisionRing, class Eq, class EuclideanRing, class Field, class Functor, class HeytingAlgebra, class Monad, class Monoid, class Ord, class Ring, class Semigroup, class Semigroupoid, class Semiring, class Show, type (~>), Ordering(..), Unit, Void, absurd, add, ap, append, apply, between, bind, bottom, clamp, compare, comparing, compose, conj, const, degree, discard, disj, eq, flap, flip, gcd, identity, ifM, join, lcm, liftA1, liftM1, map, max, mempty, min, mod, mul, negate, not, notEq, one, otherwise, pure, recip, show, sub, top, unit, unless, unlessM, void, when, whenM, zero, (#), ($), ($>), (&&), (*), (*>), (+), (-), (/), (/=), (<), (<#>), (<$), (<$>), (<*), (<*>), (<<<), (<=), (<=<), (<>), (<@>), (=<<), (==), (>), (>=), (>=>), (>>=), (>>>), (||))
@@ -6,6 +6,15 @@ import Effect.Console (log)
 import Effect.Class (class MonadEffect, liftEffect)
 
 
+-- | JL: Astonishingly, not in the prelude
+--   AD: recent Preludes in Haskell much prefer identity
+--   then id can be used as a variable name (in records for instance)
+--   since records in Purescript are not the same as in Haskell
+--   this behavior is questionable indeed.
+id :: forall a. a -> a
+id a = a
+
+
 logs:: forall message effect.
        (MonadEffect effect)
        => Show message

src/Gargantext/Types.purs

@@ -15,6 +15,10 @@ import Effect.Aff (Aff)
 import Prim.Row (class Union)
 import URI.Query (Query)
 
+type ID     = Int
+type Name   = String
+type Reload = Int
+
 newtype SessionId = SessionId String
 type NodeID = Int
 
@@ -436,7 +440,10 @@ instance showTabType :: Show TabType where
 type TableResult a = {count :: Int, docs :: Array a}
 type AffTableResult a = Aff (TableResult a)
 
-data Mode = Authors | Sources | Institutes | Terms
+data Mode = Authors
+          | Sources
+          | Institutes
+          | Terms
 
 derive instance genericMode :: Generic Mode _
 instance showMode :: Show Mode where
@@ -467,6 +474,7 @@ data AsyncTaskType = Form
                    | GraphT
                    | Query
                    | AddNode
+
 derive instance genericAsyncTaskType :: Generic AsyncTaskType _
 instance eqAsyncTaskType :: Eq AsyncTaskType where
   eq = genericEq
@@ -492,7 +500,13 @@ asyncTaskTypePath AddNode = "async/nobody/"
 
 type AsyncTaskID = String
 
-data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed
+data AsyncTaskStatus = Running
+                     | Pending
+                     | Received
+                     | Started
+                     | Failed
+                     | Finished
+                     | Killed
 derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
 instance showAsyncTaskStatus :: Show AsyncTaskStatus where
   show = genericShow
@@ -514,10 +528,11 @@ readAsyncTaskStatus "IsRunning"  = Running
 readAsyncTaskStatus "IsStarted"  = Started
 readAsyncTaskStatus _ = Running
 
-newtype AsyncTask = AsyncTask {
-    id     :: AsyncTaskID
-  , status :: AsyncTaskStatus
-  }
+newtype AsyncTask =
+  AsyncTask { id     :: AsyncTaskID
+            , status :: AsyncTaskStatus
+            }
+
 derive instance genericAsyncTask :: Generic AsyncTask _
 instance eqAsyncTask :: Eq AsyncTask where
   eq = genericEq
@@ -528,8 +543,8 @@ instance encodeJsonAsyncTask :: EncodeJson AsyncTask where
      ~> jsonEmptyObject
 instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
   decodeJson json = do
-    obj <- decodeJson json
-    id <- obj .: "id"
+    obj    <- decodeJson json
+    id     <- obj .: "id"
     status <- obj .: "status"
     pure $ AsyncTask { id, status }
 
@@ -547,9 +562,9 @@ instance encodeJsonAsyncTaskWithType :: EncodeJson AsyncTaskWithType where
      ~> jsonEmptyObject
 instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where
   decodeJson json = do
-    obj <- decodeJson json
+    obj  <- decodeJson json
     task <- obj .: "task"
-    typ <- obj .: "typ"
+    typ  <- obj .: "typ"
     pure $ AsyncTaskWithType { task, typ }
 
 newtype AsyncProgress = AsyncProgress {
@@ -560,9 +575,9 @@ newtype AsyncProgress = AsyncProgress {
 derive instance genericAsyncProgress :: Generic AsyncProgress _
 instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
   decodeJson json = do
-    obj <- decodeJson json
-    id <- obj .: "id"
-    log <- obj .: "log"
+    obj    <- decodeJson json
+    id     <- obj .: "id"
+    log    <- obj .: "log"
     status <- obj .: "status"
     pure $ AsyncProgress {id, log, status}
 
@@ -575,9 +590,9 @@ newtype AsyncTaskLog = AsyncTaskLog {
 derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _
 instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where
   decodeJson json = do
-    obj <- decodeJson json
-    events <- obj .: "events"
-    failed <- obj .: "failed"
+    obj       <- decodeJson json
+    events    <- obj .: "events"
+    failed    <- obj .: "failed"
     remaining <- obj .: "remaining"
     succeeded <- obj .: "succeeded"
     pure $ AsyncTaskLog {events, failed, remaining, succeeded}

src/Gargantext/Utils.purs

@@ -7,9 +7,9 @@ import Data.Set as Set
 import Data.Set (Set)
 import Data.String as S
 
--- | Astonishingly, not in the prelude
-id :: forall a. a -> a
-id a = a
+-- | TODO (hard coded)
+csrfMiddlewareToken :: String
+csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
 
 setterv :: forall nt record field.
            Newtype nt record
@@ -45,15 +45,12 @@ invertOrdering LT = GT
 invertOrdering GT = LT
 invertOrdering EQ = EQ
 
-csrfMiddlewareToken :: String
-csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
-
 -- A lens that always returns unit
 _unit :: forall s. Lens' s Unit
 _unit = lens (\_ -> unit) (\s _ -> s)
 
 glyphicon :: String -> String
-glyphicon t = "btn glyphitem glyphicon glyphicon-" <> t
+glyphicon t = "btn glyphitem fa fa-" <> t
 
 glyphiconActive :: String -> Boolean -> String
 glyphiconActive icon b = glyphicon icon <> if b then " active" else ""