Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
0313061a
Commit
0313061a
authored
Sep 20, 2019
by
James Laver
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Partial refactor of G.C.Tree
parent
bf93eb01
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
49 additions
and
53 deletions
+49
-53
Tree.purs
src/Gargantext/Components/Tree.purs
+49
-53
No files found.
src/Gargantext/Components/Tree.purs
View file @
0313061a
...
...
@@ -28,8 +28,7 @@ import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Config (toUrl, EndConfig, endConfig, End(..), NodeType(..), readNodeType)
import Gargantext.Config as C
import Gargantext.Config (Ends, NodeType(..), BackendRoute(..), NodePath(..), readNodeType, url)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Router as Router
...
...
@@ -45,7 +44,9 @@ type Reload = Int
data NodePopup = CreatePopup | NodePopup
type Props = { root :: ID, mCurrentRoute :: Maybe Router.Routes, endConfig :: EndConfig }
type Props = ( root :: ID, mCurrentRoute :: Maybe Router.Routes, ends :: Ends )
type TreeViewProps = ( tree :: FTree, mCurrentRoute :: Maybe Router.Routes, ends :: Ends )
data NTree a = NTree a (Array (NTree a))
...
...
@@ -112,29 +113,27 @@ data Action = Submit String
| UploadFile FileType UploadFileContents
type Tree = {
tree :: FTree
}
type Tree = { tree :: FTree }
mapFTree :: (FTree -> FTree) -> Tree -> Tree
mapFTree f s@{tree} = s {tree = f tree}
performAction :: End
Config
-> R.State Int -> R.State Tree -> Action -> Aff Unit
performAction :: End
s
-> R.State Int -> R.State Tree -> Action -> Aff Unit
performAction end
Config
(_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode end
Config
id
liftEffect $ setReload
$ \r -> r + 1
performAction end
s
(_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode end
s
id
liftEffect $ setReload
(_ + 1)
performAction end
Config
_ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode end
Config
id $ RenameValue {name}
performAction end
s
_ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode end
s
id $ RenameValue {name}
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
performAction end
Config
(_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode end
Config
id $ CreateValue {name, nodeType}
liftEffect $ setReload
$ \r -> r + 1
performAction end
s
(_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode end
s
id $ CreateValue {name, nodeType}
liftEffect $ setReload
(_ + 1)
performAction end
Config
_ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile end
Config
id fileType contents
performAction end
s
_ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile end
s
id fileType contents
liftEffect $ log2 "uploaded:" hashes
...
...
@@ -146,45 +145,42 @@ mCorpusId (Just (Router.Corpus id)) = Just id
mCorpusId (Just (Router.CorpusDocument id _ _)) = Just id
mCorpusId _ = Nothing
type TreeViewProps = { tree :: FTree
, mCurrentRoute :: Maybe Router.Routes
, endConfig :: EndConfig
}
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
tree
view :: Spec {} Props Void
tree
view = R2.elSpec $
R.hooksComponent "TreeView" cpt
tree
ViewCpt :: R.Component Props
tree
ViewCpt =
R.hooksComponent "TreeView" cpt
where
cpt props _children = do
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
pure $ treeLoadView reload props
treeLoadView :: R.State Reload -> Props -> R.Element
treeLoadView :: R.State Reload ->
Record
Props -> R.Element
treeLoadView reload p = R.createElement el p []
where
el = R.hooksComponent "TreeLoadView" cpt
cpt {root, mCurrentRoute, end
Config
} _ = do
useLoader root (loadNode end
Config) $ \{loaded}
->
loadedTreeView reload {tree: loaded, mCurrentRoute, end
Config
}
cpt {root, mCurrentRoute, end
s
} _ = do
useLoader root (loadNode end
s) $ \loaded
->
loadedTreeView reload {tree: loaded, mCurrentRoute, end
s
}
loadedTreeView :: R.State Reload -> TreeViewProps -> R.Element
loadedTreeView :: R.State Reload ->
Record
TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p []
where
el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, end
Config
} _ = do
cpt {tree, mCurrentRoute, end
s
} _ = do
treeState <- R.useState' {tree}
pure $ H.div {className: "tree"}
[ toHtml reload treeState end
Config
mCurrentRoute ]
[ toHtml reload treeState end
s
mCurrentRoute ]
-- START toHtml
toHtml :: R.State Reload -> R.State Tree -> End
Config
-> Maybe Router.Routes -> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) end
Config
mCurrentRoute = R.createElement el {} []
toHtml :: R.State Reload -> R.State Tree -> End
s
-> Maybe Router.Routes -> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) end
s
mCurrentRoute = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
pAction = performAction end
Config
reload treeState
pAction = performAction end
s
reload treeState
cpt props _ = do
folderOpen <- R.useState' true
...
...
@@ -192,8 +188,8 @@ toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _)
pure $ H.ul {}
[ H.li {}
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen end
Config
]
<> childNodes end
Config
reload folderOpen mCurrentRoute ary
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen end
s
]
<> childNodes end
s
reload folderOpen mCurrentRoute ary
)
]
...
...
@@ -206,9 +202,9 @@ type NodeMainSpanProps =
nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps
-> R.State Boolean
-> End
Config
-> End
s
-> R.Element
nodeMainSpan d p folderOpen end
Config
= R.createElement el p []
nodeMainSpan d p folderOpen end
s
= R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do
...
...
@@ -219,7 +215,7 @@ nodeMainSpan d p folderOpen endConfig = R.createElement el p []
pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen
, H.a { href: (
toUrl endConfig Front nodeType (Just id
))
, H.a { href: (
url ends (NodePath nodeType (Just id)
))
, style: {marginLeft: "22px"}
}
[ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name} ]
...
...
@@ -271,10 +267,10 @@ fldr :: Boolean -> String
fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close"
childNodes :: End
Config
-> R.State Reload -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element
childNodes :: End
s
-> R.State Reload -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element
childNodes _ _ _ _ [] = []
childNodes _ _ (false /\ _) _ _ = []
childNodes end
Config
reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
childNodes end
s
reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
where
childNode :: Tree -> R.Element
childNode props = R.createElement el props []
...
...
@@ -282,7 +278,7 @@ childNodes endConfig reload (true /\ _) mCurrentRoute ary = map (\ctree -> child
cpt {tree} _ = do
treeState <- R.useState' {tree}
pure $ toHtml reload treeState end
Config
mCurrentRoute
pure $ toHtml reload treeState end
s
mCurrentRoute
-- END toHtml
...
...
@@ -622,8 +618,8 @@ nodeText p = R.createElement el p []
-- END node text
loadNode :: End
Config
-> ID -> Aff FTree
loadNode e
c = get <<< toUrl ec Back
Tree <<< Just
loadNode :: End
s
-> ID -> Aff FTree
loadNode e
nds = get <<< url ends <<< NodeAPI
Tree <<< Just
----- TREE CRUD Operations
...
...
@@ -649,15 +645,15 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
~> "pn_typename" := nodeType
~> jsonEmptyObject
createNode :: End
Config
-> ID -> CreateValue -> Aff ID
createNode :: End
s
-> ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new"
createNode e
c parentId = post $ toUrl ec Back Node (
Just parentId)
createNode e
nds parentId = post $ url ends (NodeAPI Node $
Just parentId)
renameNode :: End
Config
-> ID -> RenameValue -> Aff (Array ID)
renameNode e
c renameNodeId = put $ toUrl ec Back Node (
Just renameNodeId) <> "/rename"
renameNode :: End
s
-> ID -> RenameValue -> Aff (Array ID)
renameNode e
nds renameNodeId = put $ url ends (NodeAPI Node $
Just renameNodeId) <> "/rename"
deleteNode :: End
Config
-> ID -> Aff ID
deleteNode e
c = delete <<< toUrl ec Back
Node <<< Just
deleteNode :: End
s
-> ID -> Aff ID
deleteNode e
nds = delete <<< url ends <<< NodeAPI
Node <<< Just
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
...
...
@@ -670,11 +666,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: End
Config
-> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile e
c id fileType (UploadFileContents fileContents) = postWwwUrlencoded url
fileContents
uploadFile :: End
s
-> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile e
nds id fileType (UploadFileContents fileContents) = postWwwUrlencoded url2
fileContents
where
q = FileUploadQuery { fileType: fileType }
url
= toUrl ec Back Node (Just id
) <> "/upload" <> Q.print (toQuery q)
url
2 = url ends (NodeAPI Node (Just id)
) <> "/upload" <> Q.print (toQuery q)
fnTransform :: LNode -> FTree
fnTransform n = NTree n []
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment