Commit 3ddddbeb authored by Sudhir Kumar's avatar Sudhir Kumar

updated build script & added tree for testing

parent cb9cfeca
#!/bin/bash
yarn install && psc-package install && pulp --psc-package build && pulp --psc-package browserify --to dist/bundle.js
yarn && yarn psc-package install && yarn pulp --psc-package build && yarn pulp --psc-package browserify --to dist/bundle.js
module Gargantext.Components.Tree where
import Prelude hiding (div)
import Unsafe.Coerce
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import CSS (backgroundColor, borderRadius, boxShadow, justifyContent, marginTop)
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Traversable (traverse)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Prelude (identity)
import React (ReactElement)
import React.DOM (a, button, div, h5, i, input, li, text, ul)
import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get, put, post, delete)
import Gargantext.Config (NodeType(..), toUrl, End(..), defaultRoot)
import React.DOM (a, button, div, h5, i, input, li, span, text, ul)
import React.DOM.Props (Props, _id, _type, className, href, title, onClick, onInput, placeholder, style, value, _data)
import Thermite (PerformAction, Render, Spec, cotransform, defaultPerformAction, defaultRender, modifyState, simpleSpec)
type Name = String
type Open = Boolean
type URL = String
......@@ -26,42 +32,147 @@ data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode
data Action = ShowPopOver
data Action = ShowPopOver ID
| ToggleFolder ID
| RenameNode String
| Submit
-- | Initialize
| RenameNode String ID
| Submit ID String
--| Initialize
| DeleteNode ID
| Create ID
| SetNodeValue String ID
| ToggleCreateNode ID
| ShowRenameBox ID
| CancelRename ID
type State = FTree
initialState :: State
initialState = NTree (LNode { id : 3
, name : ""
, nodeType : NodeUser
, open : true
, popOver : false
, renameNodeValue : ""
}) []
initialState = NTree (LNode {id : 3, name : "hello", nodeType : "", open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "InitialNode", showRenameBox : false}) []
performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ = void $
cotransform (\td -> toggleNode i td)
performAction (ShowPopOver id) _ _ = void $
cotransform (\td -> popOverNode id td)
performAction (ShowRenameBox id) _ _ = void $
cotransform (\td -> showPopOverNode id td)
performAction (CancelRename id) _ _ = void $
cotransform (\td -> showPopOverNode id td)
performAction (ToggleCreateNode id) _ _ = void $
cotransform (\td -> showCreateNode id td)
--- TODO : Need to update state once API is called
performAction (DeleteNode nid) _ _ = void $ do
s' <- lift $ deleteNode nid
case s' of
Left err -> modifyState identity
Right d -> modifyState identity
--- TODO : Need to update state once API is called
performAction (Submit rid s'') _ _ = void $ do
s' <- lift $ renameNode rid $ RenameValue { name : s''}
case s' of
Left err -> do
liftEffect $ log err
modifyState identity
Right d -> do
-- _ <- cotransform (\td -> popOverNode rid td)
cotransform (\td -> showPopOverNode rid td) -- add this function to toggle rename function
performAction (RenameNode r nid) _ _ = void $
cotransform (\td -> rename nid r td)
performAction (Create nid) _ _ = void $
cotransform (\td -> showCreateNode nid td)
performAction (SetNodeValue v nid) _ _ = void $
cotransform (\td -> setNodeValue nid v td)
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
popOverNode :: Int -> NTree LNode -> NTree LNode
popOverNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver : npopOver, renameNodeValue, createNode, nodeValue, showRenameBox}) $ map (popOverNode sid) ary
where
npopOver = if sid == id then not popOver else popOver
showPopOverNode :: Int -> NTree LNode -> NTree LNode
showPopOverNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue, createNode, nodeValue, showRenameBox: nshowRenameBox}) $ map (showPopOverNode sid) ary
where
nshowRenameBox = if sid == id then not showRenameBox else showRenameBox
showCreateNode :: Int -> NTree LNode -> NTree LNode
showCreateNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver, renameNodeValue, createNode : createNode', nodeValue, showRenameBox}) $ map (showCreateNode sid) ary
where
createNode' = if sid == id then not createNode else createNode
----TODO get id and value to send API to call
-- getCreateNode :: Int -> 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 ""
rename :: Int -> String -> NTree LNode -> NTree LNode
rename sid v (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue : rvalue, createNode, nodeValue, showRenameBox}) $ map (rename sid v) ary
where
rvalue = if sid == id then v else ""
setNodeValue :: Int -> String -> NTree LNode -> NTree LNode
setNodeValue sid v (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue , createNode, nodeValue : nvalue, showRenameBox}) $ map (setNodeValue sid v) ary
where
nvalue = if sid == id then v else ""
toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue}) $ map (toggleNode sid) ary
toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) $ map (toggleNode sid) ary
where
nopen = if sid == id then not open else open
------------------------------------------------------------------------
-- Realistic Tree for the UI
exampleTree :: NTree LNode
exampleTree = NTree (LNode { id : 1
, name : ""
, nodeType : NodeUser
, open : false
, popOver : false
, renameNodeValue : ""
}
) []
exampleTree = NTree (LNode {id : 1, name : "", nodeType : "", open : false, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}) []
-- exampleTree :: NTree LNode
-- exampleTree =
......@@ -77,7 +188,7 @@ exampleTree = NTree (LNode { id : 1
-- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
-- [ NTree (Tuple "Tabs" "#/corpus") []
-- [ NTree (Tuple "Facets" "#/corpus") []
-- , NTree (Tuple "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ]
......@@ -103,10 +214,10 @@ nodeOptionsView activated = case activated of
false -> []
nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> Array ReactElement
nodeOptionsRename d activated = case activated of
nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> ID -> Array ReactElement
nodeOptionsRename d activated id = case activated of
true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"}
, onClick $ (\_-> d $ ShowPopOver)
] []
]
false -> []
......@@ -116,22 +227,6 @@ nodeOptionsRename d activated = case activated of
treeview :: Spec State {} Action
treeview = simpleSpec performAction render
where
performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ =
void $ modifyState (\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
d <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s}
modifyState identity -- TODO why ???
performAction (RenameNode r) _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
render :: Render State {} Action
render dispatch _ state _ =
[ div [className "tree"]
......@@ -142,29 +237,92 @@ treeview = simpleSpec performAction render
renameTreeView :: (Action -> Effect Unit) -> State -> ReactElement
renameTreeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) =
renameTreeView :: (Action -> Effect Unit) -> State -> Int -> ReactElement
renameTreeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) nid =
div [className "col-md-12", _id "rename-tooltip",className "btn btn-secondary", _data {toggle : "tooltip", placement : "right"}, title "Settings on right"]
[ div [_id "arrow"] []
, div [className "panel panel-default", style {border:"1px solid rgba(0,0,0,0.2)", boxShadow : "0 2px 5px rgba(0,0,0,0.2)"}]
[
div [className "panel-heading", style {float:"left", width: "100%"}]
[
if (showRenameBox) then div [_id "afterClick"]
[
div [className "col-md-12"]
[
input [ _type "text"
, placeholder "Rename Node"
, value $ getRenameNodeValue s
, style {float: "left"}
, className "col-md-2 form-control"
, onInput \e -> d (RenameNode (unsafeEventValue e) nid)
]
]
, div [className "col-md-12"]
[ div [className "row", style {marginTop : "11px"}]
[ div [className "col-md-6"] [
a [className "btn btn-danger"
, _type "button"
, onClick \_ -> d $ (Submit nid renameNodeValue)
, style {float:"left"}
] [text "Rename"]
]
, div [className "col-md-6"]
[a [className "btn btn-primary"
, _type "button"
, onClick \_ -> d $ (CancelRename nid)
, style {float:"left", backgroundColor: "white", color:"black"}
] [text "cancel"]
]
]
]
]
else
div [ _id "beforeClick", className "col-md-12"]
[ div [className "row"]
[ div [className "col-md-6"] [text name]
, a [ style {color:"black"},className "glyphitem glyphicon glyphicon-pencil col-md-6", _id "rename1", title "Rename", onClick $ (\_-> d $ (ShowRenameBox id))] [ ]
]
]
]
,div [className "panel-body", style {display:"flex", justifyContent : "center", backgroundColor: "white", border: "none"}]
[ div [className "col-md-4"] [a [ style {color:"black", paddingTop: "6px", paddingBottom: "6px"},className "glyphitem glyphicon glyphicon-download-alt", _id "rename1", title "Download [WIP]"] [ ]]
, div [className "col-md-4"] [a [ style {color:"black", paddingTop: "6px", paddingBottom: "6px"},className "glyphitem glyphicon glyphicon-duplicate", _id "rename1", title "Duplicate [WIP]"] [ ]]
, div [className "col-md-4"] [ a [style {color:"black", paddingTop: "6px", paddingBottom: "6px"}, className "glyphitem glyphicon glyphicon-trash", _id "rename2",title "Delete", onClick $ (\_-> d $ (DeleteNode id))] [ ]]
]
]
]
createNodeView :: (Action -> Effect Unit) -> State -> Int -> ReactElement
createNodeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) nid =
div [className ""]
[ div [className "panel panel-default"]
[
div [className "panel-heading"]
[
h5 [] [text "Rename Node"]
h5 [] [text "Create Node"]
]
,div [className "panel-body"]
[
input [ _type "text"
, placeholder "Rename Node"
, value $ getRenameNodeValue s
, placeholder "Create Node"
, value $ getCreateNodeValue s
, className "col-md-12 form-control"
, onInput \e -> d (RenameNode (unsafeEventValue e))
, onInput \e -> d (SetNodeValue (unsafeEventValue e) nid)
]
]
, div [className "panel-footer"]
[ button [className "btn btn-danger"
[ button [className "btn btn-success"
, _type "button"
, onClick \_ -> d $ Submit
] [text "Rename"]
, onClick \_ -> d $ (Create nid )
] [text "Create"]
]
]
]
......@@ -175,50 +333,46 @@ renameTreeViewDummy :: (Action -> Effect Unit) -> State -> ReactElement
renameTreeViewDummy d s = div [] []
popOverValue :: State -> Boolean
popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) = popOver
popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) = popOver
getRenameNodeValue :: State -> String
getRenameNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) = renameNodeValue
getRenameNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) = renameNodeValue
getCreateNodeValue :: State -> String
getCreateNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, nodeValue, showRenameBox}) ary) = nodeValue
toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml d (NTree (LNode {id, name, nodeType : Folder, open, popOver, renameNodeValue}) []) =
ul [ ]
[ li [] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, a [ href (toUrl Front Folder id )]
[ text $ " " <> name <> " " ]
] <> nodeOptionsCorp false
)
]
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) []) =
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode,nodeValue, showRenameBox }) []) =
ul []
[
li [ style {width:"100%"}]
li []
[
a [ href (toUrl Front nodeType id)]
a [ href "#"]
( [ text (name <> " ")
]
<> nodeOptionsView false
<> (nodeOptionsRename d false)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
)
, a [className "glyphicon glyphicon-cog", _id "rename",onClick $ (\_-> d $ (ShowPopOver id))]
[
]
, if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s)
, if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s)
]
]
--- need to add renameTreeview value to this function
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
ul [ ]
[ li [style {width : "100%"}] $
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue,createNode, nodeValue, showRenameBox}) ary) =
ul []
[ li [] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, a [ href (toUrl Front nodeType id )]
[ text $ " " <> name <> " " ]
] <> nodeOptionsCorp false <>
, text $ " " <> name <> " "
] <>
if open then
map (toHtml d) ary
else []
<> nodeOptionsView false
<> (nodeOptionsRename d false)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
)
]
......@@ -228,13 +382,7 @@ fldr :: Boolean -> Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
newtype LNode = LNode { id :: Int
, name :: String
, nodeType :: NodeType
, open :: Boolean
, popOver :: Boolean
, renameNodeValue :: String
}
newtype LNode = LNode {id :: Int, name :: String, nodeType :: String, open :: Boolean, popOver :: Boolean, renameNodeValue :: String, nodeValue :: String, createNode :: Boolean, showRenameBox :: Boolean}
derive instance newtypeLNode :: Newtype LNode _
......@@ -244,15 +392,9 @@ instance decodeJsonLNode :: DecodeJson LNode where
id_ <- obj .? "id"
name <- obj .? "name"
nodeType <- obj .? "type"
pure $ LNode { id : id_
, name
, nodeType
, open : true
, popOver : false
, renameNodeValue : ""
}
pure $ LNode {id : id_, name, nodeType, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}
instance decodeJsonNTree :: DecodeJson a => DecodeJson (NTree a) where
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .? "node"
......@@ -261,8 +403,24 @@ instance decodeJsonNTree :: DecodeJson a => DecodeJson (NTree a) where
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
loadDefaultNode :: Aff (NTree LNode)
loadDefaultNode = get $ toUrl Back Tree defaultRoot
loadDefaultNode :: Aff (Either String (NTree LNode))
loadDefaultNode = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/api/v1.0/tree/1" --- http://localhost:8008/api/v1.0/tree/1
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
----- TREE CRUD Operations
......@@ -273,29 +431,100 @@ newtype RenameValue = RenameValue
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue post)
= "name" := post.name
= "r_name" := post.name
~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff Int --- need to change return type herre
renameNode renameNodeId reqbody =
put ("http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename")
reqbody
renameNode :: Int -> RenameValue -> Aff (Either String Unit) --- need to change return type herre
renameNode renameNodeId reqbody = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename"
, responseFormat = ResponseFormat.json
, method = Left PUT
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
--let obj = decodeJson json
pure $ Right unit --- TODO decode when getting proper data get
deleteNode :: Int -> Aff (Either String (Int))
deleteNode renameNodeId = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/api/v1.0/node/" <> show renameNodeId
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
}
deleteNode :: Int -> Aff Int
deleteNode = delete <<< toUrl Back Tree
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
deleteNodes :: String -> Aff (Either String Int)
deleteNodes reqbody = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/api/v1.0/nodes"
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
createNode :: String -> Aff (Either String (Int))
createNode reqbody= do
res <- request $ defaultRequest
{ url = "http://localhost:8008/api/v1.0/node/"
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
-- See https://stackoverflow.com/questions/21863326/delete-multiple-records-using-rest
-- As of now I would recommend simply issuing many requests.
-- In a second time implement a set of end points for batch edition.
deleteNodes :: Array Int -> Aff (Array Int)
deleteNodes = traverse deleteNode
createNode :: String -> Aff Int
createNode reqbody = post (toUrl Back Tree 1) reqbody
fnTransform :: LNode -> FTree
fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
......@@ -68,9 +68,13 @@ performAction Initialize _ state = void do
case state.initialized of
false -> do
lnodes <- lift $ Tree.loadDefaultNode
void $ modifyState $ _ { initialized = true, ntreeState = lnodes }
case lnodes of
Left err -> do
modifyState identity
Right d -> do
modifyState $ _ { initialized = true, ntreeState = d }
_ -> do
pure unit
modifyState identity
performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit
......
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