Skip to content

P
purescript-gargantext
Commit 5f4866b5 authored by James Laver's avatar James Laver
Browse files
Options

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

parents 3a9f1c0d 06deb5ac
Hide whitespace changes
Inline Side-by-side
Showing with 153 additions and 92 deletions
src/Gargantext/Components/App.purs
View file @ 5f4866b5
......@@ -288,7 +288,7 @@ versionCpt = R.hooksComponent "G.C.A.version" cpt
showVersions frontendVer backendVer =
H.div { className: "row" }
[ H.h5 {} [ H.text $ "Frontend version: " <> frontendVer ]
, H.h5 {} [ H.text $ "backend version: " <> backendVer ]
, H.h5 {} [ H.text $ "Backend version: " <> backendVer ]
]
footer :: Record VersionProps -> R.Element
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 5f4866b5
......@@ -16,7 +16,8 @@ import Record as Record
import Record.Extra as RecordE
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), CreateValue(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, createNode, deleteNode, loadNode, renameNode)
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.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan, Tasks, tasksStruct)
import Gargantext.Ends (Frontends)
......@@ -26,6 +27,8 @@ import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
------------------------------------------------------------------------
type CommonProps =
( frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute
......@@ -42,23 +45,33 @@ type Props = ( root :: ID
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where
cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do
let fetch _ = loadNode session root
let paint loaded = loadedTreeView {
asyncTasks
, frontends
, mCurrentRoute
, openNodes
, reload
, session
, tasks: tasksStruct root asyncTasks reload
, tree: loaded
}
useLoader { root, counter: fst reload } fetch paint
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where
cpt { root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks} _children = do
pure $ treeLoadView
{ root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks}
treeLoadView :: Record Props -> R.Element
treeLoadView p = R.createElement treeLoadViewCpt p []
where
treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponent "TreeLoadView" cpt
where
cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do
let fetch _ = loadNode session root
let paint loaded = loadedTreeView {
asyncTasks
, frontends
, mCurrentRoute
, openNodes
, reload
, session
, tasks: tasksStruct root asyncTasks reload
, tree: loaded
}
useLoader { root, counter: fst reload } fetch paint
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree
......@@ -66,19 +79,17 @@ type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
| CommonProps
)
loadedTreeView :: Record TreeViewProps -> R.Element
loadedTreeView p = R.createElement loadedTreeView' p []
loadedTreeView' :: R.Component TreeViewProps
loadedTreeView' = R.hooksComponent "LoadedTreeView" cpt
loadedTreeView p = R.createElement loadedTreeViewCpt p []
where
cpt { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do
pure $ H.div {className: "tree"}
[ toHtml { asyncTasks, frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
loadedTreeViewCpt :: R.Component TreeViewProps
loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
where
cpt { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do
pure $ H.div {className: "tree"}
[ toHtml { asyncTasks, frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
------------------------------------------------------------------------
type ToHtmlProps =
(
asyncTasks :: R.State GAT.Storage
......@@ -131,14 +142,12 @@ toHtml p@{ asyncTasks
type ChildNodesProps =
(
asyncTasks :: R.State GAT.Storage
, children :: Array FTree
, folderOpen :: R.State Boolean
| CommonProps
( asyncTasks :: R.State GAT.Storage
, children :: Array FTree
, folderOpen :: R.State Boolean
| CommonProps
)
childNodes :: Record ChildNodesProps -> Array R.Element
childNodes { children: [] } = []
childNodes { folderOpen: (false /\ _) } = []
......@@ -181,6 +190,14 @@ performAction { reload: (_ /\ setReload)
liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] SearchQuery task:" task
performAction { reload: (_ /\ setReload)
, session
, tasks: {onTaskAdd}
, tree: (NTree (LNode {id}) _) } (UpdateNode task) = do
liftEffect $ onTaskAdd task
liftEffect $ log2 "[performAction] UpdateNode task:" task
performAction p@{ reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (Submit name) = do
......@@ -191,7 +208,7 @@ performAction p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
task <- createNode session id $ CreateValue {name, nodeType}
task <- addNode session id $ AddNodeValue {name, nodeType}
liftEffect do
setOpenNodes (Set.insert (mkNodeId session id))
performAction p RefreshTree
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ 5f4866b5
......@@ -17,8 +17,9 @@ import Gargantext.Types as GT
data Action = CreateSubmit String GT.NodeType
| DeleteNode
| UpdateNode GT.AsyncTaskWithType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| Submit String
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| RefreshTree
......@@ -42,11 +43,12 @@ readFileType "PresseRIS" = Just PresseRIS
readFileType "WOS" = Just WOS
readFileType _ = Nothing
data DroppedFile = DroppedFile {
contents :: UploadFileContents
, fileType :: Maybe FileType
, lang :: Maybe Lang
}
data DroppedFile =
DroppedFile { contents :: UploadFileContents
, fileType :: Maybe FileType
, lang :: Maybe Lang
}
type FileHash = String
type Name = String
......@@ -54,23 +56,12 @@ type ID = Int
type Reload = Int
newtype UploadFileContents = UploadFileContents String
type UploadFile = {
contents :: UploadFileContents
type UploadFile =
{ contents :: UploadFileContents
, name :: String
}
createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
createNode session parentId = post session $ NodeAPI GT.Node (Just parentId) ""
createNodeAsync :: Session
-> ID
-> CreateValue
-> Aff GT.AsyncTaskWithType
createNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.CreateNode}
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.CreateNode)
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
......@@ -81,32 +72,47 @@ 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
}
{ name :: Name }
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {name})
= "r_name" := name
~> jsonEmptyObject
newtype CreateValue = CreateValue
{
name :: Name
, nodeType :: GT.NodeType
}
-----------------------------------------------------------------------
-----------------------------------------------------------------------
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
-----------------------------------------------------------------------
instance encodeJsonCreateValue :: EncodeJson CreateValue where
encodeJson (CreateValue {name, nodeType})
= "pn_name" := name
~> "pn_typename" := nodeType
~> jsonEmptyObject
data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
type Tree = { tree :: FTree, asyncTasks :: Array GT.AsyncTaskWithType }
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)
......@@ -126,7 +132,8 @@ instance decodeJsonLNode :: DecodeJson LNode where
nodeType <- obj .: "type"
pure $ LNode { id : id_
, name
, nodeType}
, nodeType
}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
......
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ 5f4866b5
module Gargantext.Components.Forest.Tree.Node.Action.Add 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 ((/\))
......@@ -10,29 +11,58 @@ 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
-- START Create Node
type Dispatch = Action -> Aff Unit
addNode :: Session -> ID -> AddNodeValue -> Aff (Array ID)
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session
-> ID
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
addNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
----------------------------------------------------------------------
newtype AddNodeValue = AddNodeValue
{ name :: Name
, nodeType :: GT.NodeType
}
instance encodeJsonAddNodeValue :: EncodeJson AddNodeValue where
encodeJson (AddNodeValue {name, nodeType})
= "pn_name" := name
~> "pn_typename" := nodeType
~> jsonEmptyObject
----------------------------------------------------------------------
type Dispatch = Action -> Aff Unit
data NodePopup = CreatePopup | NodePopup
type CreateNodeProps =
( id :: ID
, dispatch :: Dispatch
, dispatch :: Action -> Aff Unit
, name :: Name
, nodeType :: NodeType
, nodeTypes :: Array NodeType
)
createNodeView :: Record CreateNodeProps
addNodeView :: Record CreateNodeProps
-> R.Element
createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
el = R.hooksComponent "AddNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' "Name"
nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
......@@ -103,7 +133,6 @@ createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
-- END Create Node
showConfig :: NodeType -> R.Element
showConfig NodeUser = H.div {} []
showConfig FolderPrivate = H.div {} [H.text "This folder will be private only"]
......@@ -111,4 +140,3 @@ showConfig FolderShared = H.div {} [H.text "This folder will be shared"]
showConfig FolderPublic = H.div {} [H.text "This folder will be public"]
showConfig nt = H.div {} [H.h4 {} [H.text $ "Config of " <> show nt ]]
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ 5f4866b5
......@@ -31,9 +31,9 @@ type Dispatch = Action -> Aff Unit
type Props =
( dispatch :: Dispatch
, id :: Int
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
, session :: Session
)
......@@ -110,8 +110,7 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
type UploadButtonProps =
(
dispatch :: Dispatch
( dispatch :: Dispatch
, fileType :: R.State FileType
, id :: Int
, lang :: R.State (Maybe Lang)
......@@ -285,8 +284,7 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
type UploadTermButtonProps =
(
dispatch :: Dispatch
( dispatch :: Dispatch
, id :: Int
, mFile :: R.State (Maybe UploadFile)
, nodeType :: GT.NodeType
......@@ -324,9 +322,8 @@ copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
type CorpusTreeProps =
(
tree :: FTree
| Props
( tree :: FTree
| Props
)
copyFromCorpusViewLoaded :: Record CorpusTreeProps -> R.Element
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ 5f4866b5
......@@ -28,7 +28,7 @@ import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, Reload, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
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.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..))
......@@ -539,7 +539,6 @@ type NodeProps =
, nodeType :: GT.NodeType
)
type Open = Boolean
type PanelActionProps =
( id :: ID
......@@ -564,7 +563,7 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
cpt {action: Delete, nodeType, dispatch} _ = actionDelete nodeType dispatch
cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do
pure $ createNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
cpt {action: CopyFromCorpus, dispatch, id, nodeType, session} _ = do
pure $ copyFromCorpusView {dispatch, id, nodeType, session}
......@@ -589,7 +588,11 @@ actionSearch search session dispatch nodePopup =
pure $ R.fragment [ H.p {"style": {"margin" :"10px"}}
[ H.text $ "Search and create a private "
<> "corpus with the search query as corpus name." ]
, searchBar {langs: allLangs, onSearch: searchOn dispatch nodePopup, search, session}
, searchBar { langs: allLangs
, onSearch: searchOn dispatch nodePopup
, search
, session
}
]
where
searchOn :: (Action -> Aff Unit)
......
src/Gargantext/Components/Search/SearchBar.purs
View file @ 5f4866b5
......@@ -33,4 +33,10 @@ searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s
pure $ H.div {"style": {"margin" :"10px"}}
[ searchField {databases:allDatabases, langs, onSearch, search, session}]
[ searchField { databases:allDatabases
, langs
, onSearch
, search
, session
}
]
src/Gargantext/Types.purs
View file @ 5f4866b5
......@@ -463,7 +463,10 @@ modeFromString _ = Nothing
-- Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form | GraphT | Query | CreateNode
data AsyncTaskType = Form
| GraphT
| Query
| AddNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where
eq = genericEq
......@@ -478,14 +481,14 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
"Form" -> pure Form
"GraphT" -> pure GraphT
"Query" -> pure Query
"CreateNode" -> pure CreateNode
"AddNode" -> pure AddNode
s -> Left ("Unknown string " <> s)
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath CreateNode = "async/nobody/"
asyncTaskTypePath AddNode = "async/nobody/"
type AsyncTaskID = String
......
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