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
2e6a1b43
Commit
2e6a1b43
authored
Jul 04, 2019
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[TREE] more reactix work -- got rid of global Thermite dispatch function
parent
23ee97c0
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
85 additions
and
119 deletions
+85
-119
Tree.purs
src/Gargantext/Components/Tree.purs
+85
-119
No files found.
src/Gargantext/Components/Tree.purs
View file @
2e6a1b43
...
...
@@ -14,8 +14,9 @@ import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, runAff)
import Effect.Aff (Aff,
launchAff, launchAff_, killFiber,
runAff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Partial.Unsafe (unsafePartial)
...
...
@@ -47,6 +48,8 @@ type Open = Boolean
type URL = String
type ID = Int
data NodePopup = CreatePopup | NodePopup
type Props = { root :: ID, mCurrentRoute :: Maybe Router.Routes }
data NTree a = NTree a (Array (NTree a))
...
...
@@ -62,7 +65,7 @@ filterNTree p (NTree x ary) =
newtype LNode = LNode { id :: ID
, name ::
String
, name ::
Name
, nodeType :: NodeType}
derive instance newtypeLNode :: Newtype LNode _
...
...
@@ -108,118 +111,69 @@ data DroppedFile = DroppedFile {
type FileHash = String
data Action = Submit
ID
String
| DeleteNode
ID
| CreateSubmit
ID
String NodeType
| CurrentNode
ID
| UploadFile
ID
FileType UploadFileContents
data Action = Submit String
| DeleteNode
| CreateSubmit String NodeType
| CurrentNode
| UploadFile
FileType UploadFileContents
type State = {
state
:: FTree
,
c
urrentNode :: Maybe ID
type State = {
tree
:: FTree
,
mC
urrentNode :: Maybe ID
}
mapFTree :: (FTree -> FTree) -> State -> State
mapFTree f {
state, currentNode} = {state: f state, currentNode: c
urrentNode}
mapFTree f {
tree, mCurrentNode} = {tree: f tree, mC
urrentNode}
-- TODO: make it a local function
performAction :: forall props. PerformAction State props Action
--
performAction :: forall props. PerformAction State props Action
performAction (DeleteNode nid) _ _ = do
void $ lift $ deleteNode nid
modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
performAction :: R.State State -> Action -> Aff Unit
performAction (Submit rid name) _ _ = do
void $ lift $ renameNode rid $ RenameValue {name}
modifyState_ $ mapFTree $ setNodeName rid name
performAction ({tree: NTree (LNode {id}) _} /\ setState) DeleteNode = do
void $ deleteNode id
--modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
liftEffect $ setState $ mapFTree $ filterNTree $ \(LNode {id: nid}) -> nid /= id
performAction (CreateSubmit nid name nodeType) _ _ = do
void $ lift $ createNode nid $ CreateValue {name, nodeType}
performAction ({tree: NTree (LNode {id}) _} /\ setState) (Submit name) = do
void $ renameNode id $ RenameValue {name}
--modifyState_ $ mapFTree $ setNodeName rid name
liftEffect $ setState $ \{tree: NTree (LNode node) arr, mCurrentNode} -> {tree: NTree (LNode node {name = name}) arr, mCurrentNode}
performAction ({tree: NTree (LNode {id}) _} /\ _) (CreateSubmit name nodeType) = do
void $ createNode id $ CreateValue {name, nodeType}
--modifyState_ $ mapFTree $ map $ hidePopOverNode nid
performAction (CurrentNode nid) _ _ =
modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid}
performAction ({tree: NTree (LNode {id}) _} /\ setState) CurrentNode =
--modifyState_ $ \{state: s} -> {state: s, mCurrentNode : Just nid}
liftEffect $ setState $ \{tree} -> {tree, mCurrentNode : Just id}
performAction (
UploadFile nid fileType contents) _ _
= do
hashes <-
lift $ uploadFile n
id fileType contents
performAction (
{tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents)
= do
hashes <-
uploadFile
id fileType contents
liftEffect $ log2 "uploaded:" hashes
--toggleFileTypeBox :: ID -> UploadFileContents -> LNode -> LNode
--toggleFileTypeBox sid contents (LNode node@{id, droppedFile: Nothing}) | sid == id = LNode $ node {droppedFile = droppedFile}
-- where
-- droppedFile = Just $ DroppedFile {contents: contents, fileType: Nothing}
--toggleFileTypeBox sid _ (LNode node) = LNode $ node {droppedFile = Nothing}
-- TODO: DRY, NTree.map
setNodeName :: ID -> String -> NTree LNode -> NTree LNode
setNodeName nid n (NTree (LNode node@{id}) ary) =
NTree (LNode $ node {name = nname}) $ map (setNodeName nid n) ary
where
nname = if nid == id then n else node.name
------------------------------------------------------------------------
-- TODO
-- alignment to the right
nodeOptionsCorp :: Boolean -> Array ReactElement
nodeOptionsCorp activated = case activated of
true -> [ i [className "fab fa-whmcs" ] []]
false -> []
-- TODO
-- alignment to the right
-- on hover make other options available:
nodeOptionsView :: Boolean -> Array ReactElement
nodeOptionsView activated = case activated of
true -> [ i [className "glyphicon glyphicon-refresh" ] []
, i [className "glyphicon glyphicon-upload" ] []
, i [className "glyphicon glyphicon-share"] []
]
false -> []
nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> ID -> Array ReactElement
nodeOptionsRename d activated id = case activated of
true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"}
] []
]
false -> []
type TreeViewProps = { tree :: FTree, mCurrentRoute :: Maybe Router.Routes }
mCorpusId :: Maybe Router.Routes -> Maybe Int
mCorpusId (Just (Router.Corpus id)) = Just id
mCorpusId (Just (Router.CorpusDocument id _ _)) = Just id
mCorpusId _ = Nothing
type TreeViewProps = { tree :: FTree, mCurrentRoute :: Maybe Router.Routes }
loadedTree
view :: Spec State TreeViewProps Action
loadedTree
view = simpleSpec performAction render
loadedTree
View :: TreeViewProps -> R.Element
loadedTree
View p = R.createElement el p []
where
render :: Render State TreeViewProps Action
render dispatch _ {state, currentNode} _ =
[ div [className "tree"]
[ --toHtml dispatch state currentNode
(R2.scuff $ toHtml dispatch state currentNode)
]
]
el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute} _ = do
setState <- R.useState' {tree, mCurrentNode}
treeViewClass :: ReactClass { tree :: FTree, mCurrentRoute :: Maybe Router.Routes, children :: React.Children
}
treeViewClass = createClass "TreeView" loadedTreeview cpt
pure $ H.div {className: "tree"
}
[ toHtml setState ]
where
cpt {tree, mCurrentRoute} = {state: tree, currentNode: mCorpusId mCurrentRoute}
-- loadedTreeView p = R.createElement el p []
-- where
-- el = R.hooksComponent "LoadedTreeView" cpt
-- cpt {tree} _ = do
-- setTree <- R.useState' tree
-- pure $ H.div {className: "tree"}
-- [ toHtml setTree tree Nothing ]
mCurrentNode = mCorpusId mCurrentRoute
treeview :: Spec {} Props Void
treeview = simpleSpec defaultPerformAction render
...
...
@@ -230,17 +184,16 @@ treeview = simpleSpec defaultPerformAction render
cpt =
R.hooksComponent "TreeView" \{root, mCurrentRoute} _children ->
useLoader root loadNode \currentPath loaded ->
R2.buff $ React.createElement treeViewClass {tree: loaded, mCurrentRoute} []
--R2.scuff $ loadedTreeView {tree: loaded}
loadedTreeView {tree: loaded, mCurrentRoute}
-- START Popup View
type NodePopupProps =
( id :: ID
, name ::
String
)
, name ::
Name
)
nodePopupView :: (Action ->
Effect
Unit)
nodePopupView :: (Action ->
Aff
Unit)
-> Record NodePopupProps
-> R.State (Maybe NodePopup)
-> R.Element
...
...
@@ -327,7 +280,7 @@ nodePopupView d p (Just NodePopup /\ setPopupOpen) = R.createElement el p []
, className: (glyphicon "trash")
, id: "rename2"
, title: "Delete"
, onClick: mkEffectFn1 $
(\_-> d $ (DeleteNode id))
}
, onClick: mkEffectFn1 $
\_ -> launchAff $ d $ DeleteNode
}
[]
]
]
...
...
@@ -354,9 +307,9 @@ nodePopupView _ p _ = R.createElement el p []
type RenameBoxProps =
( id :: ID
, name ::
String
)
, name ::
Name
)
renameBox :: (Action ->
Effect
Unit) -> Record RenameBoxProps -> R.State Boolean -> R.Element
renameBox :: (Action ->
Aff
Unit) -> Record RenameBoxProps -> R.State Boolean -> R.Element
renameBox d p (true /\ setRenameBoxOpen) = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
...
...
@@ -382,7 +335,7 @@ renameBox d p (true /\ setRenameBoxOpen) = R.createElement el p []
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setRenameBoxOpen $ const false
d $ Submit id
newName
launchAff $ d $ Submit
newName
, title: "Rename"
} []
cancelBtn =
...
...
@@ -398,6 +351,11 @@ renameBox _ p (false /\ _) = R.createElement el p []
-- END Rename Box
type CreateNodeProps =
( id :: ID
, name :: Name)
createNodeView :: (Action -> Aff Unit) -> Record CreateNodeProps -> R.State (Maybe NodePopup) -> R.Element
createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
...
...
@@ -461,7 +419,7 @@ createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setPopupOpen $ const Nothing
d $ (CreateSubmit id name nt)
launchAff $ d $ CreateSubmit name nt
} [H.text "Create"]
]
createNodeView _ _ _ = R.createElement el {} []
...
...
@@ -474,7 +432,7 @@ createNodeView _ _ _ = R.createElement el {} []
type FileTypeProps =
( id :: ID )
fileTypeView :: (Action ->
Effect
Unit) -> Record FileTypeProps -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element
fileTypeView :: (Action ->
Aff
Unit) -> Record FileTypeProps -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element
fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el p []
where
el = R.hooksComponent "FileTypeView" cpt
...
...
@@ -525,7 +483,7 @@ fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ const Nothing
d $ (UploadFile id ft contents)
launchAff $ d $ UploadFile ft contents
} [H.text "Upload"]
Nothing ->
H.button {className: "btn btn-success disabled"
...
...
@@ -540,36 +498,36 @@ fileTypeView _ _ (Nothing /\ _) _ = R.createElement el {} []
-- END File Type View
toHtml :: (Action -> Effect Unit) -> FTree -> Maybe ID -> R.Element
toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
toHtml :: R.State State -> R.Element
--toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
toHtml setState@({tree: (NTree (LNode {id, name, nodeType}) ary), mCurrentNode} /\ _) = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
pAction = performAction setState
cpt props _ = do
folderOpen <- R.useState' true
pure $ H.ul {}
[ H.li {}
( [ nodeMainSpan
d {id, name, nodeType} n
folderOpen ]
<> childNodes
d n
ary folderOpen
( [ nodeMainSpan
pAction {id, name, nodeType, mCurrentNode}
folderOpen ]
<> childNodes
mCurrentNode
ary folderOpen
)
]
type NodeMainSpanProps =
( id :: ID
, name :: String
, nodeType :: NodeType)
data NodePopup = CreatePopup | NodePopup
, name :: Name
, nodeType :: NodeType
, mCurrentNode :: Maybe ID)
nodeMainSpan :: (Action ->
Effect
Unit)
nodeMainSpan :: (Action ->
Aff
Unit)
-> Record NodeMainSpanProps
-> Maybe ID
-> R.State Boolean
-> R.Element
nodeMainSpan d p
n
folderOpen = R.createElement el p []
nodeMainSpan d p folderOpen = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType} _ = do
cpt {id, name, nodeType
, mCurrentNode
} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
...
...
@@ -579,9 +537,9 @@ nodeMainSpan d p n folderOpen = R.createElement el p []
[ folderIcon folderOpen
, H.a { href: (toUrl Front nodeType (Just id))
, style: {"margin-left": "22px"}
, onClick: mkEffectFn1 $ \e ->
d $ CurrentNode id
, onClick: mkEffectFn1 $ \e ->
launchAff $ d $ CurrentNode
}
[ nodeText {isSelected:
n
== (Just id), name} ]
[ nodeText {isSelected:
mCurrentNode
== (Just id), name} ]
, popOverIcon popupOpen
, nodePopupView d {id, name} popupOpen
, createNodeView d {id, name} popupOpen
...
...
@@ -630,17 +588,25 @@ fldr :: Boolean -> String
fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close"
childNodes :: forall s. (Action -> Effect Unit) -> Maybe ID -> (Array (NTree LNode)) -> R.State Boolean -> Array R.Element
childNodes d n [] _ = []
childNodes d n _ (false /\ _) = []
childNodes d n ary (true /\ _) = map (\cs -> toHtml d cs n) ary
childNodes :: Maybe ID -> Array FTree -> R.State Boolean -> Array R.Element
childNodes _ [] _ = []
childNodes _ _ (false /\ _) = []
childNodes n ary (true /\ _) = map (\ctree -> childNode {tree: ctree, mCurrentNode: n}) ary
where
childNode :: State -> R.Element
childNode props = R.createElement el props []
el = R.hooksComponent "ChildNodeView" cpt
cpt {tree, mCurrentNode} _ = do
setState <- R.useState' {tree, mCurrentNode}
pure $ toHtml setState
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name ::
String
)
, name ::
Name
)
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement el p []
...
...
@@ -661,7 +627,7 @@ loadNode = get <<< toUrl Back Tree <<< Just
newtype RenameValue = RenameValue
{
name ::
String
name ::
Name
}
instance encodeJsonRenameValue :: EncodeJson RenameValue where
...
...
@@ -671,7 +637,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
newtype CreateValue = CreateValue
{
name ::
String
name ::
Name
, nodeType :: NodeType
}
...
...
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