Commit 0313061a authored by James Laver's avatar James Laver

Partial refactor of G.C.Tree

parent bf93eb01
...@@ -28,8 +28,7 @@ import Web.File.File (toBlob) ...@@ -28,8 +28,7 @@ import Web.File.File (toBlob)
import Web.File.FileList (FileList, item) import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
import Gargantext.Config (toUrl, EndConfig, endConfig, End(..), NodeType(..), readNodeType) import Gargantext.Config (Ends, NodeType(..), BackendRoute(..), NodePath(..), readNodeType, url)
import Gargantext.Config as C
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete) import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Router as Router import Gargantext.Router as Router
...@@ -45,7 +44,9 @@ type Reload = Int ...@@ -45,7 +44,9 @@ type Reload = Int
data NodePopup = CreatePopup | NodePopup 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)) data NTree a = NTree a (Array (NTree a))
...@@ -112,29 +113,27 @@ data Action = Submit String ...@@ -112,29 +113,27 @@ data Action = Submit String
| UploadFile FileType UploadFileContents | UploadFile FileType UploadFileContents
type Tree = { type Tree = { tree :: FTree }
tree :: FTree
}
mapFTree :: (FTree -> FTree) -> Tree -> Tree mapFTree :: (FTree -> FTree) -> Tree -> Tree
mapFTree f s@{tree} = s {tree = f tree} mapFTree f s@{tree} = s {tree = f tree}
performAction :: EndConfig -> R.State Int -> R.State Tree -> Action -> Aff Unit performAction :: Ends -> R.State Int -> R.State Tree -> Action -> Aff Unit
performAction endConfig (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do performAction ends (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode endConfig id void $ deleteNode ends id
liftEffect $ setReload $ \r -> r + 1 liftEffect $ setReload (_ + 1)
performAction endConfig _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do performAction ends _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode endConfig id $ RenameValue {name} void $ renameNode ends id $ RenameValue {name}
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr} liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
performAction endConfig (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do performAction ends (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode endConfig id $ CreateValue {name, nodeType} void $ createNode ends id $ CreateValue {name, nodeType}
liftEffect $ setReload $ \r -> r + 1 liftEffect $ setReload (_ + 1)
performAction endConfig _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do performAction ends _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile endConfig id fileType contents hashes <- uploadFile ends id fileType contents
liftEffect $ log2 "uploaded:" hashes liftEffect $ log2 "uploaded:" hashes
...@@ -146,45 +145,42 @@ mCorpusId (Just (Router.Corpus id)) = Just id ...@@ -146,45 +145,42 @@ mCorpusId (Just (Router.Corpus id)) = Just id
mCorpusId (Just (Router.CorpusDocument id _ _)) = Just id mCorpusId (Just (Router.CorpusDocument id _ _)) = Just id
mCorpusId _ = Nothing mCorpusId _ = Nothing
type TreeViewProps = { tree :: FTree treeView :: Record Props -> R.Element
, mCurrentRoute :: Maybe Router.Routes treeView props = R.createElement treeViewCpt props []
, endConfig :: EndConfig
}
treeview :: Spec {} Props Void treeViewCpt :: R.Component Props
treeview = R2.elSpec $ R.hooksComponent "TreeView" cpt treeViewCpt = R.hooksComponent "TreeView" cpt
where where
cpt props _children = do cpt props _children = do
-- NOTE: this is a hack to reload the tree view on demand -- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload) reload <- R.useState' (0 :: Reload)
pure $ treeLoadView reload props 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 [] treeLoadView reload p = R.createElement el p []
where where
el = R.hooksComponent "TreeLoadView" cpt el = R.hooksComponent "TreeLoadView" cpt
cpt {root, mCurrentRoute, endConfig} _ = do cpt {root, mCurrentRoute, ends} _ = do
useLoader root (loadNode endConfig) $ \{loaded} -> useLoader root (loadNode ends) $ \loaded ->
loadedTreeView reload {tree: loaded, mCurrentRoute, endConfig} loadedTreeView reload {tree: loaded, mCurrentRoute, ends}
loadedTreeView :: R.State Reload -> TreeViewProps -> R.Element loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p [] loadedTreeView reload p = R.createElement el p []
where where
el = R.hooksComponent "LoadedTreeView" cpt el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, endConfig} _ = do cpt {tree, mCurrentRoute, ends} _ = do
treeState <- R.useState' {tree} treeState <- R.useState' {tree}
pure $ H.div {className: "tree"} pure $ H.div {className: "tree"}
[ toHtml reload treeState endConfig mCurrentRoute ] [ toHtml reload treeState ends mCurrentRoute ]
-- START toHtml -- START toHtml
toHtml :: R.State Reload -> R.State Tree -> EndConfig -> Maybe Router.Routes -> R.Element toHtml :: R.State Reload -> R.State Tree -> Ends -> Maybe Router.Routes -> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) endConfig mCurrentRoute = R.createElement el {} [] toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) ends mCurrentRoute = R.createElement el {} []
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
pAction = performAction endConfig reload treeState pAction = performAction ends reload treeState
cpt props _ = do cpt props _ = do
folderOpen <- R.useState' true folderOpen <- R.useState' true
...@@ -192,8 +188,8 @@ toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) ...@@ -192,8 +188,8 @@ toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _)
pure $ H.ul {} pure $ H.ul {}
[ H.li {} [ H.li {}
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen endConfig ] ( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen ends ]
<> childNodes endConfig reload folderOpen mCurrentRoute ary <> childNodes ends reload folderOpen mCurrentRoute ary
) )
] ]
...@@ -206,9 +202,9 @@ type NodeMainSpanProps = ...@@ -206,9 +202,9 @@ type NodeMainSpanProps =
nodeMainSpan :: (Action -> Aff Unit) nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps -> Record NodeMainSpanProps
-> R.State Boolean -> R.State Boolean
-> EndConfig -> Ends
-> R.Element -> R.Element
nodeMainSpan d p folderOpen endConfig = R.createElement el p [] nodeMainSpan d p folderOpen ends = R.createElement el p []
where where
el = R.hooksComponent "NodeMainSpan" cpt el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do cpt {id, name, nodeType, mCurrentRoute} _ = do
...@@ -219,7 +215,7 @@ nodeMainSpan d p folderOpen endConfig = R.createElement el p [] ...@@ -219,7 +215,7 @@ nodeMainSpan d p folderOpen endConfig = R.createElement el p []
pure $ H.span (dropProps droppedFile isDragOver) pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen [ folderIcon folderOpen
, H.a { href: (toUrl endConfig Front nodeType (Just id)) , H.a { href: (url ends (NodePath nodeType (Just id)))
, style: {marginLeft: "22px"} , style: {marginLeft: "22px"}
} }
[ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name} ] [ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name} ]
...@@ -271,10 +267,10 @@ fldr :: Boolean -> String ...@@ -271,10 +267,10 @@ fldr :: Boolean -> String
fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close" fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close"
childNodes :: EndConfig -> R.State Reload -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element childNodes :: Ends -> R.State Reload -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element
childNodes _ _ _ _ [] = [] childNodes _ _ _ _ [] = []
childNodes _ _ (false /\ _) _ _ = [] childNodes _ _ (false /\ _) _ _ = []
childNodes endConfig reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary childNodes ends reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
where where
childNode :: Tree -> R.Element childNode :: Tree -> R.Element
childNode props = R.createElement el props [] childNode props = R.createElement el props []
...@@ -282,7 +278,7 @@ childNodes endConfig reload (true /\ _) mCurrentRoute ary = map (\ctree -> child ...@@ -282,7 +278,7 @@ childNodes endConfig reload (true /\ _) mCurrentRoute ary = map (\ctree -> child
cpt {tree} _ = do cpt {tree} _ = do
treeState <- R.useState' {tree} treeState <- R.useState' {tree}
pure $ toHtml reload treeState endConfig mCurrentRoute pure $ toHtml reload treeState ends mCurrentRoute
-- END toHtml -- END toHtml
...@@ -622,8 +618,8 @@ nodeText p = R.createElement el p [] ...@@ -622,8 +618,8 @@ nodeText p = R.createElement el p []
-- END node text -- END node text
loadNode :: EndConfig -> ID -> Aff FTree loadNode :: Ends -> ID -> Aff FTree
loadNode ec = get <<< toUrl ec Back Tree <<< Just loadNode ends = get <<< url ends <<< NodeAPI Tree <<< Just
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -649,15 +645,15 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where ...@@ -649,15 +645,15 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
~> "pn_typename" := nodeType ~> "pn_typename" := nodeType
~> jsonEmptyObject ~> jsonEmptyObject
createNode :: EndConfig -> ID -> CreateValue -> Aff ID createNode :: Ends -> ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new" --createNode = post $ urlPlease Back $ "new"
createNode ec parentId = post $ toUrl ec Back Node (Just parentId) createNode ends parentId = post $ url ends (NodeAPI Node $ Just parentId)
renameNode :: EndConfig -> ID -> RenameValue -> Aff (Array ID) renameNode :: Ends -> ID -> RenameValue -> Aff (Array ID)
renameNode ec renameNodeId = put $ toUrl ec Back Node (Just renameNodeId) <> "/rename" renameNode ends renameNodeId = put $ url ends (NodeAPI Node $ Just renameNodeId) <> "/rename"
deleteNode :: EndConfig -> ID -> Aff ID deleteNode :: Ends -> ID -> Aff ID
deleteNode ec = delete <<< toUrl ec Back Node <<< Just deleteNode ends = delete <<< url ends <<< NodeAPI Node <<< Just
newtype FileUploadQuery = FileUploadQuery { newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType fileType :: FileType
...@@ -670,11 +666,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where ...@@ -670,11 +666,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value)) 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) ] pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: EndConfig -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash) uploadFile :: Ends -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile ec id fileType (UploadFileContents fileContents) = postWwwUrlencoded url fileContents uploadFile ends id fileType (UploadFileContents fileContents) = postWwwUrlencoded url2 fileContents
where where
q = FileUploadQuery { fileType: fileType } q = FileUploadQuery { fileType: fileType }
url = toUrl ec Back Node (Just id) <> "/upload" <> Q.print (toQuery q) url2 = url ends (NodeAPI Node (Just id)) <> "/upload" <> Q.print (toQuery q)
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
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