diff --git a/src/Gargantext/Components/Tree.purs b/src/Gargantext/Components/Tree.purs index 99d7fcfb045008c30ad88a4455dc58ab9bba6793..f8bd86f443811ae4c6ba73006723210b5752da05 100644 --- a/src/Gargantext/Components/Tree.purs +++ b/src/Gargantext/Components/Tree.purs @@ -6,7 +6,7 @@ import Affjax (defaultRequest, printResponseFormatError, request) import Affjax.RequestBody (RequestBody(..)) import Affjax.ResponseFormat as ResponseFormat 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.Either (Either(..)) import Data.HTTP.Method (Method(..)) @@ -16,12 +16,13 @@ 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, div, i, li, text, ul) -import React.DOM.Props (Props, className, href, onClick) -import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) - import Gargantext.Config (NodeType(..), readNodeType, toUrl, readNodeType, End(..), ApiVersion, defaultRoot) +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 Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec) +import Unsafe.Coerce (unsafeCoerce) type Name = String type Open = Boolean @@ -32,15 +33,43 @@ data NTree a = NTree a (Array (NTree a)) type FTree = NTree LNode -data Action = ToggleFolder ID --| Initialize +data Action = ShowPopOver + | ToggleFolder ID + | RenameNode String + | Submit + --| Initialize type State = FTree initialState :: State -initialState = NTree (LNode {id : 1, name : "", nodeType : NodeUser, open : true}) [] +initialState = NTree (LNode { id : 3 + , name : "" + , nodeType : NodeUser + , open : true + , popOver : false + , renameNodeValue : "" + }) [] performAction :: PerformAction State {} Action -performAction (ToggleFolder i) _ _ = void $ modifyState $ toggleNode i +performAction (ToggleFolder i) _ _ = + void $ 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 -- s <- lift $ loadDefaultNode @@ -50,8 +79,8 @@ performAction (ToggleFolder i) _ _ = void $ modifyState $ toggleNode i toggleNode :: Int -> NTree LNode -> NTree LNode -toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) = - NTree (LNode {id,name, nodeType, open : nopen}) $ map (toggleNode sid) ary +toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = + NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue}) $ map (toggleNode sid) ary where nopen = if sid == id then not open else open @@ -59,7 +88,14 @@ toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) = -- Realistic Tree for the UI exampleTree :: NTree LNode -exampleTree = NTree (LNode {id : 1, name : "", nodeType : NodeUser, open : false}) [] +exampleTree = NTree (LNode { id : 1 + , name : "" + , nodeType : NodeUser + , open : false + , popOver : false + , renameNodeValue : "" + } + ) [] -- exampleTree :: NTree LNode -- exampleTree = @@ -101,16 +137,70 @@ nodeOptionsView activated = case activated of 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 = simpleSpec performAction render where render :: Render State {} Action 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 d (NTree (LNode {id, name, nodeType : Folder, open}) []) = +toHtml d (NTree (LNode {id, name, nodeType : Folder, open, popOver, renameNodeValue}) []) = ul [ ] [ li [] $ ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []] @@ -119,20 +209,24 @@ toHtml d (NTree (LNode {id, name, nodeType : Folder, open}) []) = ] <> nodeOptionsCorp false ) ] -toHtml d (NTree (LNode {id, name, nodeType : nodeType, open}) []) = +toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) []) = ul [] [ - li [] + li [ style {width:"100%"}] [ a [ href (toUrl Front nodeType id)] ( [ 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 [ ] - [ li [] $ + [ li [style {width : "100%"}] $ ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []] , a [ href (toUrl Front nodeType id )] [ text $ " " <> name <> " " ] @@ -140,14 +234,25 @@ toHtml d (NTree (LNode {id, name, nodeType, open}) ary) = if open then map (toHtml d) ary else [] + <> nodeOptionsView false + <> (nodeOptionsRename d true) + <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)] ) ] + + 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} +newtype LNode = LNode { id :: Int + , name :: String + , nodeType :: NodeType + , open :: Boolean + , popOver :: Boolean + , renameNodeValue :: String + } derive instance newtypeLNode :: Newtype LNode _ @@ -156,8 +261,14 @@ instance decodeJsonLNode :: DecodeJson LNode where obj <- decodeJson json id_ <- obj .? "id" name <- obj .? "name" - nodeType <- readNodeType <$> obj .? "type" - pure $ LNode {id : id_, name, nodeType, open : true} + nodeType <- obj .? "type" + pure $ LNode { id : id_ + , name + , nodeType + , open : true + , popOver : false + , renameNodeValue : "" + } instance decodeJsonFTree :: DecodeJson (NTree LNode) where decodeJson json = do @@ -189,13 +300,25 @@ loadDefaultNode = do ----- TREE CRUD Operations -renameNode :: Aff (Either String (Int)) --- need to change return type herre -renameNode = do +newtype RenameValue = RenameValue + { + 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 - { url = toUrl Back Tree 1 + { 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 @@ -277,3 +400,7 @@ createNode reqbody= do fnTransform :: LNode -> FTree fnTransform n = NTree n [] + + +unsafeEventValue :: forall event. event -> String +unsafeEventValue e = (unsafeCoerce e).target.value diff --git a/src/Gargantext/Config.purs b/src/Gargantext/Config.purs index 63d4661c2acf4e4ad9128367f3990556e9b05602..e397b856fa2c7f6f417f56f4efe27407578c7aba 100644 --- a/src/Gargantext/Config.purs +++ b/src/Gargantext/Config.purs @@ -9,9 +9,8 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1" -} module Gargantext.Config where -import Prelude ( class Eq, class Ord, class Show - , compare, eq, show, (<>), identity) - +import Prelude +import Data.Argonaut (class DecodeJson, decodeJson) import Data.Map (Map) import Data.Map as DM import Data.Maybe (maybe) @@ -180,3 +179,7 @@ instance ordNodeType :: Ord NodeType where 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