Skip to content

P
purescript-gargantext
Commit 3ddddbeb authored by Sudhir Kumar's avatar Sudhir Kumar
Browse files
Options

updated build script & added tree for testing

parent cb9cfeca
Hide whitespace changes
Inline Side-by-side
Showing with 356 additions and 123 deletions
build
View file @ 3ddddbeb
#!/bin/bash #!/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
src/Gargantext/Components/Tree.purs
View file @ 3ddddbeb
module Gargantext.Components.Tree where 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 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.Newtype (class Newtype)
import Data.Traversable (traverse)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Prelude (identity) import Prelude (identity)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, button, div, h5, i, input, li, text, ul) import React.DOM (a, button, div, h5, i, input, li, span, text, ul)
import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value) import React.DOM.Props (Props, _id, _type, className, href, title, onClick, onInput, placeholder, style, value, _data)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, cotransform, defaultPerformAction, defaultRender, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get, put, post, delete)
import Gargantext.Config (NodeType(..), toUrl, End(..), defaultRoot)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
type URL = String type URL = String
...@@ -26,42 +32,147 @@ data NTree a = NTree a (Array (NTree a)) ...@@ -26,42 +32,147 @@ data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode type FTree = NTree LNode
data Action = ShowPopOver data Action = ShowPopOver ID
| ToggleFolder ID | ToggleFolder ID
| RenameNode String | RenameNode String ID
| Submit | Submit ID String
-- | Initialize --| Initialize
| DeleteNode ID
| Create ID
| SetNodeValue String ID
| ToggleCreateNode ID
| ShowRenameBox ID
| CancelRename ID
type State = FTree type State = FTree
initialState :: State initialState :: State
initialState = NTree (LNode { id : 3 initialState = NTree (LNode {id : 3, name : "hello", nodeType : "", open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "InitialNode", showRenameBox : false}) []
, name : ""
, nodeType : NodeUser
, open : true
, popOver : false performAction :: PerformAction State {} Action
, renameNodeValue : ""
}) [] 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 :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue}) $ map (toggleNode sid) ary NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) $ map (toggleNode sid) ary
where where
nopen = if sid == id then not open else open nopen = if sid == id then not open else open
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Realistic Tree for the UI -- Realistic Tree for the UI
exampleTree :: NTree LNode exampleTree :: NTree LNode
exampleTree = NTree (LNode { id : 1 exampleTree = NTree (LNode {id : 1, name : "", nodeType : "", open : false, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}) []
, name : ""
, nodeType : NodeUser
, open : false
, popOver : false
, renameNodeValue : ""
}
) []
-- exampleTree :: NTree LNode -- exampleTree :: NTree LNode
-- exampleTree = -- exampleTree =
...@@ -77,7 +188,7 @@ exampleTree = NTree (LNode { id : 1 ...@@ -77,7 +188,7 @@ exampleTree = NTree (LNode { id : 1
-- corpus :: Int -> String -> NTree (Tuple String String) -- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false}) -- 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 "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") [] -- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ] -- ]
...@@ -103,10 +214,10 @@ nodeOptionsView activated = case activated of ...@@ -103,10 +214,10 @@ nodeOptionsView activated = case activated of
false -> [] false -> []
nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> Array ReactElement nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> ID -> Array ReactElement
nodeOptionsRename d activated = case activated of nodeOptionsRename d activated id = case activated of
true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"} true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"}
, onClick $ (\_-> d $ ShowPopOver)
] [] ] []
] ]
false -> [] false -> []
...@@ -116,22 +227,6 @@ nodeOptionsRename d activated = case activated of ...@@ -116,22 +227,6 @@ nodeOptionsRename d activated = case activated of
treeview :: Spec State {} Action treeview :: Spec State {} Action
treeview = simpleSpec performAction render treeview = simpleSpec performAction render
where 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 :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ div [className "tree"] [ div [className "tree"]
...@@ -142,29 +237,92 @@ treeview = simpleSpec performAction render ...@@ -142,29 +237,92 @@ treeview = simpleSpec performAction render
renameTreeView :: (Action -> Effect Unit) -> State -> ReactElement renameTreeView :: (Action -> Effect Unit) -> State -> Int -> ReactElement
renameTreeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) = 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 ""]
[ div [className "panel panel-default"] [ div [className "panel panel-default"]
[ [
div [className "panel-heading"] div [className "panel-heading"]
[ [
h5 [] [text "Rename Node"] h5 [] [text "Create Node"]
] ]
,div [className "panel-body"] ,div [className "panel-body"]
[ [
input [ _type "text" input [ _type "text"
, placeholder "Rename Node" , placeholder "Create Node"
, value $ getRenameNodeValue s , value $ getCreateNodeValue s
, className "col-md-12 form-control" , className "col-md-12 form-control"
, onInput \e -> d (RenameNode (unsafeEventValue e)) , onInput \e -> d (SetNodeValue (unsafeEventValue e) nid)
] ]
] ]
, div [className "panel-footer"] , div [className "panel-footer"]
[ button [className "btn btn-danger" [ button [className "btn btn-success"
, _type "button" , _type "button"
, onClick \_ -> d $ Submit , onClick \_ -> d $ (Create nid )
] [text "Rename"] ] [text "Create"]
] ]
] ]
] ]
...@@ -175,50 +333,46 @@ renameTreeViewDummy :: (Action -> Effect Unit) -> State -> ReactElement ...@@ -175,50 +333,46 @@ renameTreeViewDummy :: (Action -> Effect Unit) -> State -> ReactElement
renameTreeViewDummy d s = div [] [] renameTreeViewDummy d s = div [] []
popOverValue :: State -> Boolean 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 :: 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 :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml d (NTree (LNode {id, name, nodeType : Folder, open, popOver, renameNodeValue}) []) = toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode,nodeValue, showRenameBox }) []) =
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}) []) =
ul [] ul []
[ [
li [ style {width:"100%"}] li []
[ [
a [ href (toUrl Front nodeType id)]
a [ href "#"]
( [ text (name <> " ") ( [ 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 --- need to add renameTreeview value to this function
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue,createNode, nodeValue, showRenameBox}) ary) =
ul [ ] ul []
[ li [style {width : "100%"}] $ [ li [] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []] ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, a [ href (toUrl Front nodeType id )] , text $ " " <> name <> " "
[ text $ " " <> name <> " " ]
] <> nodeOptionsCorp false <> ] <>
if open then if open then
map (toHtml d) ary map (toHtml d) ary
else [] 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 ...@@ -228,13 +382,7 @@ 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 newtype LNode = LNode {id :: Int, name :: String, nodeType :: String, open :: Boolean, popOver :: Boolean, renameNodeValue :: String, nodeValue :: String, createNode :: Boolean, showRenameBox :: Boolean}
, name :: String
, nodeType :: NodeType
, open :: Boolean
, popOver :: Boolean
, renameNodeValue :: String
}
derive instance newtypeLNode :: Newtype LNode _ derive instance newtypeLNode :: Newtype LNode _
...@@ -244,15 +392,9 @@ instance decodeJsonLNode :: DecodeJson LNode where ...@@ -244,15 +392,9 @@ 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_ pure $ LNode {id : id_, name, nodeType, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}
, name
, nodeType instance decodeJsonFTree :: DecodeJson (NTree LNode) where
, open : true
, popOver : false
, renameNodeValue : ""
}
instance decodeJsonNTree :: DecodeJson a => DecodeJson (NTree a) where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
node <- obj .? "node" node <- obj .? "node"
...@@ -261,8 +403,24 @@ instance decodeJsonNTree :: DecodeJson a => DecodeJson (NTree a) where ...@@ -261,8 +403,24 @@ instance decodeJsonNTree :: DecodeJson a => DecodeJson (NTree a) where
nodes' <- decodeJson nodes nodes' <- decodeJson nodes
pure $ NTree node' nodes' pure $ NTree node' nodes'
loadDefaultNode :: Aff (NTree LNode) loadDefaultNode :: Aff (Either String (NTree LNode))
loadDefaultNode = get $ toUrl Back Tree defaultRoot 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 ----- TREE CRUD Operations
...@@ -273,29 +431,100 @@ newtype RenameValue = RenameValue ...@@ -273,29 +431,100 @@ newtype RenameValue = RenameValue
instance encodeJsonRenameValue :: EncodeJson RenameValue where instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue post) encodeJson (RenameValue post)
= "name" := post.name = "r_name" := post.name
~> jsonEmptyObject ~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff Int --- need to change return type herre renameNode :: Int -> RenameValue -> Aff (Either String Unit) --- need to change return type herre
renameNode renameNodeId reqbody = renameNode renameNodeId reqbody = do
put ("http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename") res <- request $ defaultRequest
reqbody { 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 = []
}
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
deleteNode :: Int -> Aff Int
deleteNode = delete <<< toUrl Back Tree
-- 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 :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value unsafeEventValue e = (unsafeCoerce e).target.value
src/Gargantext/Pages/Layout/Actions.purs
View file @ 3ddddbeb
...@@ -68,9 +68,13 @@ performAction Initialize _ state = void do ...@@ -68,9 +68,13 @@ performAction Initialize _ state = void do
case state.initialized of case state.initialized of
false -> do false -> do
lnodes <- lift $ Tree.loadDefaultNode 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 _ -> do
pure unit modifyState identity
performAction (LoginA _) _ _ = pure unit performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = 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