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
255b31ef
Commit
255b31ef
authored
Oct 05, 2018
by
Sudhir Kumar
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Tree Rename Node design
parent
7e500e2d
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
126 additions
and
20 deletions
+126
-20
Tree.purs
src/Gargantext/Components/Tree.purs
+126
-20
No files found.
src/Gargantext/Components/Tree.purs
View file @
255b31ef
...
@@ -6,7 +6,7 @@ import Affjax (defaultRequest, printResponseFormatError, request)
...
@@ -6,7 +6,7 @@ import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson,
Json, decodeJson, encodeJson, (.?
))
import Data.Argonaut (class DecodeJson,
class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>
))
import Data.Argonaut.Core (Json)
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.HTTP.Method (Method(..))
...
@@ -16,10 +16,12 @@ import Effect (Effect)
...
@@ -16,10 +16,12 @@ import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Effect.Console (log)
import Prelude (identity)
import React (ReactElement)
import React (ReactElement)
import React.DOM (a,
div, i, li
, text, ul)
import React.DOM (a,
button, div, h5, i, input, li, span
, text, ul)
import React.DOM.Props (Props,
className, href, onClick
)
import React.DOM.Props (Props,
_type, className, href, onClick, onInput, placeholder, style, value
)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
type Name = String
type Name = String
type Open = Boolean
type Open = Boolean
...
@@ -30,17 +32,41 @@ data NTree a = NTree a (Array (NTree a))
...
@@ -30,17 +32,41 @@ data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
type FTree = NTree LNode
data Action = ToggleFolder ID --| Initialize
data Action = ShowPopOver
| ToggleFolder ID
| RenameNode String
| Submit
--| Initialize
type State = FTree
type State = FTree
initialState :: State
initialState :: State
initialState = NTree (LNode {id : 1, name : "", nodeType : "", open : true}) []
initialState = NTree (LNode {id : 3, name : "", nodeType : "", open : true, popOver : false, renameNodeValue : ""}) []
performAction :: PerformAction State {} Action
performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ = void $
performAction (ToggleFolder i) _ _ = void $
cotransform (\td -> toggleNode i td)
cotransform (\td -> toggleNode i td)
performAction ShowPopOver _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { popOver = true }) ary
performAction Submit _ s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = void $ do
s' <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s}
case s' of
Left err -> modifyState identity
Right d -> modifyState identity
performAction (RenameNode r) _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary
-- performAction Initialize _ _ = void $ do
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- s <- lift $ loadDefaultNode
-- case s of
-- case s of
...
@@ -49,8 +75,8 @@ performAction (ToggleFolder i) _ _ = void $
...
@@ -49,8 +75,8 @@ performAction (ToggleFolder i) _ _ = void $
toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) =
toggleNode sid (NTree (LNode {id, name, nodeType, open
, popOver, renameNodeValue
}) ary) =
NTree (LNode {id,name, nodeType, open : nopen}) $ map (toggleNode sid) ary
NTree (LNode {id,name, nodeType, open : nopen
, popOver, renameNodeValue
}) $ map (toggleNode sid) ary
where
where
nopen = if sid == id then not open else open
nopen = if sid == id then not open else open
...
@@ -60,7 +86,7 @@ toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) =
...
@@ -60,7 +86,7 @@ toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) =
-- Realistic Tree for the UI
-- Realistic Tree for the UI
exampleTree :: NTree LNode
exampleTree :: NTree LNode
exampleTree = NTree (LNode {id : 1, name : "", nodeType : "", open : false}) []
exampleTree = NTree (LNode {id : 1, name : "", nodeType : "", open : false
, popOver : false, renameNodeValue : ""
}) []
-- exampleTree :: NTree LNode
-- exampleTree :: NTree LNode
-- exampleTree =
-- exampleTree =
...
@@ -102,43 +128,107 @@ nodeOptionsView activated = case activated of
...
@@ -102,43 +128,107 @@ nodeOptionsView activated = case activated of
false -> []
false -> []
nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> Array ReactElement
nodeOptionsRename d activated = case activated of
true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"}
, onClick $ (\_-> d $ ShowPopOver)
] []
]
false -> []
treeview :: Spec State {} Action
treeview :: Spec State {} Action
treeview = simpleSpec performAction render
treeview = simpleSpec performAction render
where
where
render :: Render State {} Action
render :: Render State {} Action
render dispatch _ state _ =
render dispatch _ state _ =
[div [className "tree"] [toHtml dispatch state]]
[ div [className "tree"]
[ toHtml dispatch state
]
]
renameTreeView :: (Action -> Effect Unit) -> State -> ReactElement
renameTreeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) =
div [className ""]
[ div [className "panel panel-default"]
[
div [className "panel-heading"]
[
h5 [] [text "Rename Node"]
]
,div [className "panel-body"]
[
input [ _type "text"
, placeholder "Rename Node"
, value $ getRenameNodeValue s
, className "col-md-12 form-control"
, onInput \e -> d (RenameNode (unsafeEventValue e))
]
]
, div [className "panel-footer"]
[ button [className "btn btn-danger"
, _type "button"
, onClick \_ -> d $ Submit
] [text "Rename"]
]
]
]
renameTreeViewDummy :: (Action -> Effect Unit) -> State -> ReactElement
renameTreeViewDummy d s = div [] []
popOverValue :: State -> Boolean
popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) = popOver
getRenameNodeValue :: State -> String
getRenameNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) = renameNodeValue
toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml d
(NTree (LNode {id, name, nodeType, open
}) []) =
toHtml d
s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue
}) []) =
ul []
ul []
[
[
li []
li [
style {width:"100%"}
]
[
[
a [ href "#"]
a [ href "#"]
( [ text (name <> " ")
( [ text (name <> " ")
] <> nodeOptionsView false
]
<> nodeOptionsView false
<> (nodeOptionsRename d true)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
)
)
]
]
]
]
toHtml d (NTree (LNode {id, name, nodeType, open}) ary) =
--- need to add renameTreeview value to this function
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
ul [ ]
ul [ ]
[ li [] $
[ li [
style {width : "100%"}
] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, text $ " " <> name <> " "
, text $ " " <> name <> " "
] <> nodeOptionsCorp false <>
] <> nodeOptionsCorp false <>
if open then
if open then
map (toHtml d) ary
map (toHtml d) ary
else []
else []
<> nodeOptionsView false
<> (nodeOptionsRename d true)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
)
)
]
]
fldr :: Boolean -> Props
fldr :: Boolean -> 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 :: Int, name :: String, nodeType :: String, open :: Boolean}
newtype LNode = LNode {id :: Int, name :: String, nodeType :: String, open :: Boolean
, popOver :: Boolean, renameNodeValue :: String
}
derive instance newtypeLNode :: Newtype LNode _
derive instance newtypeLNode :: Newtype LNode _
...
@@ -148,7 +238,7 @@ instance decodeJsonLNode :: DecodeJson LNode where
...
@@ -148,7 +238,7 @@ instance decodeJsonLNode :: DecodeJson LNode where
id_ <- obj .? "id"
id_ <- obj .? "id"
name <- obj .? "name"
name <- obj .? "name"
nodeType <- obj .? "type"
nodeType <- obj .? "type"
pure $ LNode {id : id_, name, nodeType, open : true}
pure $ LNode {id : id_, name, nodeType, open : true
, popOver : false, renameNodeValue : ""
}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
decodeJson json = do
...
@@ -162,7 +252,7 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
...
@@ -162,7 +252,7 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
loadDefaultNode :: Aff (Either String (NTree LNode))
loadDefaultNode :: Aff (Either String (NTree LNode))
loadDefaultNode = do
loadDefaultNode = do
res <- request $ defaultRequest
res <- request $ defaultRequest
{ url = "http://localhost:8008/
tree/1"
{ url = "http://localhost:8008/
api/v1.0/tree/1" --- http://localhost:8008/api/v1.0/tree/1
, responseFormat = ResponseFormat.json
, responseFormat = ResponseFormat.json
, method = Left GET
, method = Left GET
, headers = []
, headers = []
...
@@ -180,13 +270,25 @@ loadDefaultNode = do
...
@@ -180,13 +270,25 @@ loadDefaultNode = do
----- TREE CRUD Operations
----- TREE CRUD Operations
renameNode :: Aff (Either String (Int)) --- need to change return type herre
newtype RenameValue = RenameValue
renameNode = do
{
name :: String
}
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue post)
= "name" := post.name
~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff (Either String (Int)) --- need to change return type herre
renameNode renameNodeId reqbody = do
res <- request $ defaultRequest
res <- request $ defaultRequest
{ url = "http://localhost:8008/
tree/1
"
{ url = "http://localhost:8008/
api/v1.0/node/" <> show renameNodeId <> "/rename
"
, responseFormat = ResponseFormat.json
, responseFormat = ResponseFormat.json
, method = Left PUT
, method = Left PUT
, headers = []
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
}
case res.body of
case res.body of
Left err -> do
Left err -> do
...
@@ -268,3 +370,7 @@ createNode reqbody= do
...
@@ -268,3 +370,7 @@ createNode reqbody= do
fnTransform :: LNode -> FTree
fnTransform :: LNode -> FTree
fnTransform n = NTree n []
fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
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