Commit 9cc53eb9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

tree: implemented NodeType choosing in create node popup

- migrated createNode and fileType boxes to reactix
- small Config refactoring
- added 'select' element to G.U.Reactix
parent 4933ddeb
module Gargantext.Components.Tree where module Gargantext.Components.Tree where
import Prelude hiding (div) import Prelude hiding (div)
import Unsafe.Coerce (unsafeCoerce)
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Array (filter) import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
...@@ -13,30 +13,35 @@ import Data.Maybe (Maybe(..), fromJust) ...@@ -13,30 +13,35 @@ import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, runAff) import Effect.Aff (Aff, runAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import FFI.Simple ((..)) import Effect.Exception (error, throwException)
import Effect.Uncurried (mkEffectFn1)
import Effect.Unsafe (unsafePerformEffect)
import FFI.Simple ((..), (.=))
import Gargantext.Components.Loader as Loader
import Gargantext.Config (toUrl, End(..), NodeType(..), readNodeType)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactClass, ReactElement) import React (ReactClass, ReactElement)
import React as React import React as React
import React.DOM (a, button, div, h5, i, input, li, span, text, ul, b, u, select, option) import React.DOM (a, div, i, input, li, span, text, ul, b, u)
import React.DOM.Props (_id, _type, className, href, title, onClick, onDrop, onDragOver, onInput, placeholder, style, defaultValue, _data) import React.DOM.Props (_id, _type, className, href, title, onClick, onDrop, onDragOver, onInput, placeholder, style, defaultValue, _data)
import React.DOM.Props as DOM import React.DOM.Props as DOM
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, simpleSpec, modifyState_) import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, simpleSpec, modifyState_)
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import URI.Query as Q import URI.Query as Q
import Unsafe.Coerce (unsafeCoerce)
import Web.File.File (toBlob) import Web.File.File (toBlob)
import Web.File.FileReader.Aff (readAsText)
import Web.File.FileList (FileList, item) import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Config (toUrl, End(..), NodeType(..), urlPlease)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Components.Loader as Loader
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
...@@ -56,6 +61,46 @@ filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a ...@@ -56,6 +61,46 @@ filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a
filterNTree p (NTree x ary) = filterNTree p (NTree x ary) =
NTree x $ map (filterNTree p) $ filter (\(NTree a _) -> p a) ary NTree x $ map (filterNTree p) $ filter (\(NTree a _) -> p a) ary
newtype LNode = LNode { id :: ID
, name :: String
, nodeType :: NodeType
, open :: Boolean
, popOver :: Boolean
, renameNodeValue :: String
, nodeValue :: String
, createNode :: Boolean
, droppedFile :: Maybe DroppedFile
, showRenameBox :: Boolean}
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
, open : true
, popOver : false
, renameNodeValue : ""
, createNode : false
, nodeValue : ""
, droppedFile: Nothing
, showRenameBox : false}
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'
type FTree = NTree LNode type FTree = NTree LNode
-- file upload types -- file upload types
...@@ -65,6 +110,11 @@ instance eqFileType :: Eq FileType where ...@@ -65,6 +110,11 @@ instance eqFileType :: Eq FileType where
eq = genericEq eq = genericEq
instance showFileType :: Show FileType where instance showFileType :: Show FileType where
show = genericShow show = genericShow
readFileType :: String -> FileType
readFileType "CSV" = CSV
readFileType "PresseRIS" = PresseRIS
readFileType ft = unsafePerformEffect $ throwException $ error $ "File type unknown: " <> ft
newtype UploadFileContents = UploadFileContents String newtype UploadFileContents = UploadFileContents String
data DroppedFile = DroppedFile { data DroppedFile = DroppedFile {
contents :: UploadFileContents contents :: UploadFileContents
...@@ -79,7 +129,7 @@ data Action = ShowPopOver ID ...@@ -79,7 +129,7 @@ data Action = ShowPopOver ID
| Submit ID String | Submit ID String
| DeleteNode ID | DeleteNode ID
| Create ID | Create ID
| CreateSubmit ID String | CreateSubmit ID String NodeType
| SetNodeValue String ID | SetNodeValue String ID
| ToggleCreateNode ID | ToggleCreateNode ID
| ShowRenameBox ID | ShowRenameBox ID
...@@ -93,33 +143,6 @@ type State = { state :: FTree ...@@ -93,33 +143,6 @@ type State = { state :: FTree
, currentNode :: Maybe ID , currentNode :: Maybe ID
} }
-- TODO remove
initialNode :: { createNode :: Boolean
, id :: ID
, name :: String
, nodeType :: NodeType
, nodeValue :: String
, open :: Boolean
, popOver :: Boolean
, renameNodeValue :: String
, droppedFile :: Maybe DroppedFile
, showRenameBox :: Boolean
}
initialNode = { id : 3
, name : "hello"
, nodeType : Node
, open : true
, popOver : false
, renameNodeValue : ""
, createNode : false
, nodeValue : "InitialNode"
, droppedFile : Nothing
, showRenameBox : false}
initialState :: State
initialState = { state: NTree (LNode initialNode) []
, currentNode : Nothing}
mapFTree :: (FTree -> FTree) -> State -> State mapFTree :: (FTree -> FTree) -> State -> State
mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode} mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode}
...@@ -154,8 +177,8 @@ performAction (Submit rid name) _ _ = do ...@@ -154,8 +177,8 @@ performAction (Submit rid name) _ _ = do
performAction (RenameNode r nid) _ _ = performAction (RenameNode r nid) _ _ =
modifyState_ $ mapFTree $ rename nid r modifyState_ $ mapFTree $ rename nid r
performAction (CreateSubmit nid name) _ _ = do performAction (CreateSubmit nid name nodeType) _ _ = do
void $ lift $ createNode $ CreateValue {name} void $ lift $ createNode nid $ CreateValue {name, nodeType}
modifyState_ $ mapFTree $ map $ hidePopOverNode nid modifyState_ $ mapFTree $ map $ hidePopOverNode nid
performAction (Create nid) _ _ = do performAction (Create nid) _ _ = do
...@@ -210,15 +233,6 @@ showCreateNode sid (NTree (LNode node@{id, createNode}) ary) = ...@@ -210,15 +233,6 @@ showCreateNode sid (NTree (LNode node@{id, createNode}) ary) =
where where
createNode' = if sid == id then not createNode else createNode createNode' = if sid == id then not createNode else createNode
----TODO get id and value to send API to call
-- getCreateNode :: ID -> NTree LNode -> String
-- getCreateNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue}) ary) =
-- createNode
-- where
-- NTree (LNode {id,name, nodeType, open , popOver, renameNodeValue, createNode , nodeValue}) $ map (getCreateNode sid) ary
-- createNode' = if sid == id then nodeValue else ""
-- TODO: DRY, NTree.map -- TODO: DRY, NTree.map
rename :: ID -> String -> NTree LNode -> NTree LNode rename :: ID -> String -> NTree LNode -> NTree LNode
rename sid v (NTree (LNode node@{id}) ary) = rename sid v (NTree (LNode node@{id}) ary) =
...@@ -242,41 +256,6 @@ toggleNode sid (NTree (LNode node@{id, open}) ary) = ...@@ -242,41 +256,6 @@ toggleNode sid (NTree (LNode node@{id, open}) ary) =
------------------------------------------------------------------------
-- Realistic Tree for the UI
exampleTree :: NTree LNode
exampleTree = NTree (LNode { id : 1
, name : ""
, nodeType : Node
, open : false
, popOver : false
, renameNodeValue : ""
, createNode : false
, nodeValue : ""
, droppedFile: Nothing
, showRenameBox : false}) []
-- exampleTree :: NTree LNode
-- exampleTree =
-- NTree 1 true "françois.pineau"
-- [ --annuaire 2 "Annuaire"
-- --, corpus 3 "IMT publications"
-- ]
-- annuaire :: ID -> String -> NTree (Tuple String String)
-- annuaire n name = NTree n false name
-- [ NTree (Tuple "IMT community" "#/docView")
-- ]
-- corpus :: ID -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
-- [ NTree (Tuple "Facets" "#/corpus") []
-- , NTree (Tuple "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ]
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO -- TODO
-- alignment to the right -- alignment to the right
...@@ -348,8 +327,8 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show ...@@ -348,8 +327,8 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show
[ div [className "panel-heading"] [ div [className "panel-heading"]
[ div [ className "row" ] $ [ div [ className "row" ] $
[ div [className (if (showRenameBox) then "col-md-10" else "col-md-8")] [ div [className (if (showRenameBox) then "col-md-10" else "col-md-8")]
[ if (showRenameBox) then renameBox else renameBoxLabel ] [ renameBox showRenameBox ]
] <> [ if (showRenameBox) then editIconDummy else editIcon ] <> [ ] <> [ editIcon showRenameBox ] <> [
div [ className "col-md-2" ] div [ className "col-md-2" ]
[ a [className "btn text-danger glyphitem glyphicon glyphicon-remove" [ a [className "btn text-danger glyphitem glyphicon glyphicon-remove"
, onClick $ \_ -> d $ ShowPopOver nid , onClick $ \_ -> d $ ShowPopOver nid
...@@ -362,7 +341,7 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show ...@@ -362,7 +341,7 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show
[ div [className "col-md-4"] [ div [className "col-md-4"]
[a [ style iconAStyle [a [ style iconAStyle
, className (glyphicon "plus") , className (glyphicon "plus")
, _id "rename1" , _id "create"
, title "Create" , title "Create"
, onClick $ (\_ -> d $ (ToggleCreateNode id))] , onClick $ (\_ -> d $ (ToggleCreateNode id))]
[] []
...@@ -370,14 +349,14 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show ...@@ -370,14 +349,14 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show
, div [className "col-md-4"] , div [className "col-md-4"]
[a [ style iconAStyle [a [ style iconAStyle
, className (glyphicon "download-alt") , className (glyphicon "download-alt")
, _id "rename1" , _id "download"
, title "Download [WIP]"] , title "Download [WIP]"]
[] []
] ]
, div [className "col-md-4"] , div [className "col-md-4"]
[a [ style iconAStyle [a [ style iconAStyle
, className (glyphicon "duplicate") , className (glyphicon "duplicate")
, _id "rename1" , _id "duplicate"
, title "Duplicate [WIP]"] , title "Duplicate [WIP]"]
[] []
] ]
...@@ -395,7 +374,7 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show ...@@ -395,7 +374,7 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show
where where
iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"} iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
glyphicon t = "glyphitem glyphicon glyphicon-" <> t glyphicon t = "glyphitem glyphicon glyphicon-" <> t
editIcon = div [ className "col-md-2" ] editIcon false = div [ className "col-md-2" ]
[ a [ style {color:"black"} [ a [ style {color:"black"}
, className "btn glyphitem glyphicon glyphicon-pencil" , className "btn glyphitem glyphicon glyphicon-pencil"
, _id "rename1" , _id "rename1"
...@@ -403,107 +382,145 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show ...@@ -403,107 +382,145 @@ renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, show
, onClick $ (\_-> d $ (ShowRenameBox id))] , onClick $ (\_-> d $ (ShowRenameBox id))]
[] []
] ]
editIconDummy = div [] [] editIcon true = div [] []
renameBox = div [ className "from-group row-no-padding" ] renameBox true = div [ className "from-group row-no-padding" ]
[ div [className "col-md-8"] [ div [className "col-md-8"]
[ input [ _type "text" [ input [ _type "text"
, placeholder "Rename Node" , placeholder "Rename Node"
, defaultValue $ name , defaultValue $ name
, className "form-control" , className "form-control"
, onInput \e -> d (RenameNode (unsafeEventValue e) nid) , onInput \e -> d (RenameNode (unsafeEventValue e) nid)
] ]
] ]
, a [className "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left" , a [className "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, _type "button" , _type "button"
, onClick \_ -> d $ (Submit nid renameNodeValue) , onClick \_ -> d $ (Submit nid renameNodeValue)
, title "Rename" , title "Rename"
] [] ] []
, a [className "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left" , a [className "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, _type "button" , _type "button"
, onClick \_ -> d $ (CancelRename nid) , onClick \_ -> d $ (CancelRename nid)
, title "Cancel" , title "Cancel"
] [] ] []
] ]
renameBoxLabel = div [] [ text name ] renameBox false = div [] [ text name ]
renameTreeView _ _ _ = div [] [] renameTreeView _ _ _ = div [] []
createNodeView :: (Action -> Effect Unit) -> FTree -> R.Element
createNodeView :: (Action -> Effect Unit) -> FTree -> ID -> ReactElement createNodeView d s@(NTree (LNode {id, createNode: true, nodeValue}) _) = R.createElement el {} []
createNodeView d s@(NTree (LNode { createNode: true, nodeValue }) ary) nid = where
div [ className "" el = R.hooksComponent "CreateNodeView" cpt
, _id "create-node-tooltip" cpt props _ = do
, _data {toggle: "tooltip", placement: "right"} nodeName <- R.useState $ \_ -> pure ""
, title "Create new node"] $ nodeType <- R.useState $ \_ -> pure Corpus
[ div [className "panel panel-default"] pure $ H.div tooltipProps $
[ div [className "panel-heading"] [ H.div {className: "panel panel-default"}
[ [ panelHeading
div [className "row"] , panelBody nodeName nodeType
[ div [ className "col-md-10"] , panelFooter nodeName nodeType
[ h5 [] [text "Create Node"] ]
, div [className "col-md-2"]
[ a [className "btn text-danger glyphitem glyphicon glyphicon-remove"
, onClick $ \_ -> d $ ToggleCreateNode nid
, title "Close"] []
] ]
] ]
] where
, div [className "panel-body"] tooltipProps = ({ className: ""
[ , id: "create-node-tooltip"
input [ _type "text" , title: "Create new node"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
, placeholder "Create Node" panelHeading =
, defaultValue $ getCreateNodeValue s H.div {className: "panel-heading"}
, className "col-md-12 form-control" [ H.div {className: "row"}
, onInput \e -> d (SetNodeValue (unsafeEventValue e) nid) [ H.div {className: "col-md-10"}
] [ H.h5 {} [H.text "Create Node"] ]
] , H.div {className: "col-md-2"}
, div [className "panel-footer"] [ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove"
[ button [className "btn btn-success" , onClick: mkEffectFn1 $ \_ -> d $ ToggleCreateNode id
, _type "button" , title: "Close"} []
, onClick \_ -> d $ (CreateSubmit nid nodeValue) ]
] [text "Create"] ]
] ]
] panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
] H.div {className: "panel-body"}
createNodeView _ _ _ = div [] [] [ H.div {className: "row form-group"}
[ H.div {className: "col-md-12"}
[ H.div {className: "row"}
[ H.input { _type: "text"
, placeholder: "Create Node"
, defaultValue: getCreateNodeValue s
, className: "col-md-12 form-control"
, onInput: mkEffectFn1 $ \e -> setNodeName $ e .. "target" .. "value"
}
]
, H.div {className: "row"}
[ R2.select { className: "col-md-12 form-control"
, onChange: mkEffectFn1 $ \e -> setNodeType $ readNodeType $ e .. "target" .. "value"
}
(map renderOption [Corpus, Folder])
]
]
]
]
renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
panelFooter (name /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
, _type: "button"
, onClick: mkEffectFn1 $ \_ -> d $ (CreateSubmit id name nt)
} [H.text "Create"]
]
createNodeView _ _ = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} []
fileTypeView :: (Action -> Effect Unit) -> FTree -> ID -> ReactElement
fileTypeView d s@(NTree (LNode {droppedFile: Just (DroppedFile {contents, fileType: Nothing})}) ary) nid = fileTypeView :: (Action -> Effect Unit) -> FTree -> R.Element
div [ className "" fileTypeView d s@(NTree (LNode {id, droppedFile: Just (DroppedFile {contents, fileType: Nothing})}) _) = R.createElement el {} []
, _id "file-type-tooltip" where
, _data {toggle: "tooltip", placement: "right"} el = R.hooksComponent "FileTypeView" cpt
, title "Choose file type"] $ cpt props _ = do
[ div [className "panel panel-default"] fileType <- R.useState $ \_ -> pure CSV
[ div [className "panel-heading"] pure $ H.div tooltipProps $
[ [ H.div {className: "panel panel-default"}
div [className "row"] [ panelHeading
[ div [ className "col-md-10"] , panelBody fileType
[ h5 [] [text "Choose file type"] ] , panelFooter fileType
, div [className "col-md-2"]
[ a [className "btn text-danger glyphitem glyphicon glyphicon-remove"
, onClick $ \_ -> d $ PrepareUploadFile nid contents
, title "Close"] []
] ]
] ]
] where
, div [className "panel-body"] tooltipProps = ({ className: ""
[ , id: "file-type-tooltip"
select [ className "col-md-12 form-control" , title: "Choose file type"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
--, onInput \e -> d (SetNodeValue (unsafeEventValue e) nid) panelHeading =
H.div {className: "panel-heading"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.h5 {} [H.text "Choose file type"] ]
, H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove"
--, onClick $ \_ -> d $ PrepareUploadFile nid contents
, title: "Close"} []
] ]
(map renderOption [CSV, PresseRIS]) ]
] ]
, div [className "panel-footer"] panelBody (_ /\ setFileType) =
[ button [className "btn btn-success" H.div {className: "panel-body"}
, _type "button" [ R2.select {className: "col-md-12 form-control"
, onClick \_ -> d $ (UploadFile nid CSV contents) , onChange: onChange}
] [text "Upload"] (map renderOption [CSV, PresseRIS])
] ]
] where
] onChange = mkEffectFn1 $ \e -> setFileType $ readFileType $ e .. "target" .. "value"
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter (ft /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
, _type: "button"
, onClick: mkEffectFn1 $ \_ -> d $ (UploadFile id ft contents)
} [H.text "Upload"]
]
fileTypeView _ _ = R.createElement el {} []
where where
renderOption opt = option [] [ text $ show opt ] el = R.hooksComponent "FileTypeView" cpt
fileTypeView d s@(NTree (LNode node) ary) nid = div [] [] cpt props _ = pure $ H.div {} []
popOverValue :: FTree -> Boolean popOverValue :: FTree -> Boolean
popOverValue (NTree (LNode {popOver}) ary) = popOver popOverValue (NTree (LNode {popOver}) ary) = popOver
...@@ -523,8 +540,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType}) []) n = ...@@ -523,8 +540,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType}) []) n =
] ]
[ if n == (Just id) then u [] [b [] [text ("| " <> name <> " | ")]] else text (name <> " ") ] [ if n == (Just id) then u [] [b [] [text ("| " <> name <> " | ")]] else text (name <> " ") ]
, renameTreeView d s id , renameTreeView d s id
, createNodeView d s id , (R2.scuff $ createNodeView d s)
, fileTypeView d s id , (R2.scuff $ fileTypeView d s)
] ]
]] ]]
--- need to add renameTreeview value to this function --- need to add renameTreeview value to this function
...@@ -543,11 +560,11 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open}) ary) n = ...@@ -543,11 +560,11 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open}) ary) n =
, onClick $ (\_-> d $ (ShowPopOver id)) , onClick $ (\_-> d $ (ShowPopOver id))
] [] ] []
, renameTreeView d s id , renameTreeView d s id
, createNodeView d s id , (R2.scuff $ createNodeView d s)
, fileTypeView d s id , (R2.scuff $ fileTypeView d s)
] ]
] <> if open then ] <> if open then
map (\s -> toHtml d s n) ary map (\cs -> toHtml d cs n) ary
else [] else []
) )
] ]
...@@ -573,45 +590,6 @@ fldr :: Boolean -> DOM.Props ...@@ -573,45 +590,6 @@ fldr :: Boolean -> DOM.Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder" fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
newtype LNode = LNode { id :: ID
, name :: String
, nodeType :: NodeType
, open :: Boolean
, popOver :: Boolean
, renameNodeValue :: String
, nodeValue :: String
, createNode :: Boolean
, droppedFile :: Maybe DroppedFile
, showRenameBox :: Boolean}
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
, open : true
, popOver : false
, renameNodeValue : ""
, createNode : false
, nodeValue : ""
, droppedFile: Nothing
, showRenameBox : false}
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'
loadNode :: ID -> Aff FTree loadNode :: ID -> Aff FTree
loadNode = get <<< toUrl Back Tree <<< Just loadNode = get <<< toUrl Back Tree <<< Just
...@@ -630,17 +608,18 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where ...@@ -630,17 +608,18 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
newtype CreateValue = CreateValue newtype CreateValue = CreateValue
{ {
name :: String name :: String
, nodeType :: NodeType
} }
instance encodeJsonCreateValue :: EncodeJson CreateValue where instance encodeJsonCreateValue :: EncodeJson CreateValue where
encodeJson (CreateValue {name}) encodeJson (CreateValue {name, nodeType})
= "query" := name = "pn_name" := name
~> "corpus_id" := 0 ~> "pn_typename" := nodeType
~> "files_id" := ([] :: Array String)
~> jsonEmptyObject ~> jsonEmptyObject
createNode :: CreateValue -> Aff ID createNode :: ID -> CreateValue -> Aff ID
createNode = post $ urlPlease Back $ "new" --createNode = post $ urlPlease Back $ "new"
createNode parentId = post $ toUrl Back Node (Just parentId)
renameNode :: ID -> RenameValue -> Aff (Array ID) renameNode :: ID -> RenameValue -> Aff (Array ID)
renameNode renameNodeId = put $ toUrl Back Node (Just renameNodeId) <> "/rename" renameNode renameNodeId = put $ toUrl Back Node (Just renameNodeId) <> "/rename"
......
...@@ -10,7 +10,7 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1" ...@@ -10,7 +10,7 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
module Gargantext.Config where module Gargantext.Config where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
...@@ -258,6 +258,57 @@ instance showNodeType :: Show NodeType where ...@@ -258,6 +258,57 @@ instance showNodeType :: Show NodeType where
show Tree = "NodeTree" show Tree = "NodeTree"
show NodeList = "NodeList" show NodeList = "NodeList"
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeList" = NodeList
readNodeType _ = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
nodeTypeUrl :: NodeType -> Url
nodeTypeUrl Annuaire = "annuaire"
nodeTypeUrl Corpus = "corpus"
nodeTypeUrl CorpusV3 = "corpus"
nodeTypeUrl Dashboard = "dashboard"
nodeTypeUrl Url_Document = "document"
nodeTypeUrl Error = "ErrorNodeType"
nodeTypeUrl Folder = "folder"
nodeTypeUrl Graph = "graph"
nodeTypeUrl Individu = "individu"
nodeTypeUrl Node = "node"
nodeTypeUrl Nodes = "nodes"
nodeTypeUrl NodeUser = "user"
nodeTypeUrl NodeContact = "contact"
nodeTypeUrl Tree = "tree"
nodeTypeUrl NodeList = "list"
------------------------------------------------------------
type ListId = Int type ListId = Int
data Path data Path
...@@ -365,50 +416,3 @@ derive instance genericTabType :: Generic TabType _ ...@@ -365,50 +416,3 @@ derive instance genericTabType :: Generic TabType _
instance showTabType :: Show TabType where instance showTabType :: Show TabType where
show = genericShow show = genericShow
------------------------------------------------------------
nodeTypeUrl :: NodeType -> Url
nodeTypeUrl Annuaire = "annuaire"
nodeTypeUrl Corpus = "corpus"
nodeTypeUrl CorpusV3 = "corpus"
nodeTypeUrl Dashboard = "dashboard"
nodeTypeUrl Url_Document = "document"
nodeTypeUrl Error = "ErrorNodeType"
nodeTypeUrl Folder = "folder"
nodeTypeUrl Graph = "graph"
nodeTypeUrl Individu = "individu"
nodeTypeUrl Node = "node"
nodeTypeUrl Nodes = "nodes"
nodeTypeUrl NodeUser = "user"
nodeTypeUrl NodeContact = "contact"
nodeTypeUrl Tree = "tree"
nodeTypeUrl NodeList = "list"
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "Nodes" = Nodes
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
readNodeType "NodeContact" = NodeContact
readNodeType "Tree" = Tree
readNodeType "NodeList" = NodeList
readNodeType _ = Error
{-
------------------------------------------------------------
instance ordNodeType :: Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
-}
------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
...@@ -12,6 +12,8 @@ import Effect (Effect) ...@@ -12,6 +12,8 @@ import Effect (Effect)
import FFI.Simple ( (...), defineProperty ) import FFI.Simple ( (...), defineProperty )
import React ( ReactElement ) import React ( ReactElement )
import Reactix as R import Reactix as R
import Reactix.DOM.HTML (ElemFactory)
import Reactix.React (createElement)
import Reactix.SyntheticEvent as RE import Reactix.SyntheticEvent as RE
import Unsafe.Coerce ( unsafeCoerce ) import Unsafe.Coerce ( unsafeCoerce )
newtype Point = Point { x :: Number, y :: Number } newtype Point = Point { x :: Number, y :: Number }
...@@ -40,3 +42,7 @@ useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit ...@@ -40,3 +42,7 @@ useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit
useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ -> useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ ->
do f unit do f unit
pure $ \_ -> pure unit pure $ \_ -> pure unit
select :: ElemFactory
select = createElement "select"
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