Tree.purs 17.5 KB
Newer Older
1
module Gargantext.Components.Tree where
2

3 4 5 6 7 8 9
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)
Sudhir Kumar's avatar
Sudhir Kumar committed
10
import Control.Monad.Cont.Trans (lift)
11
import Data.Array (filter)
12 13 14 15 16
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(..))
Sudhir Kumar's avatar
Sudhir Kumar committed
17
import Data.Newtype (class Newtype)
Sudhir Kumar's avatar
Sudhir Kumar committed
18 19
import Effect (Effect)
import Effect.Aff (Aff)
20 21
import Effect.Class (liftEffect)
import Effect.Console (log)
Sudhir Kumar's avatar
Sudhir Kumar committed
22
import Prelude (identity)
23 24
import React (ReactClass, ReactElement)
import React as React
25
import React.DOM (a, button, div, h5, i, input, li, span, text, ul, b, u)
26
import React.DOM.Props (_id, _type, className, href, title, onClick, onInput, placeholder, style, defaultValue, _data)
27
import React.DOM.Props as DOM
28
import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, defaultRender, modifyState_, simpleSpec, modifyState)
29

30
import Gargantext.Config (toUrl, End(..), NodeType(..))
31
import Gargantext.Config.REST (get, put, post, delete, deleteWithBody)
32
import Gargantext.Components.Loader as Loader
33

Abinaya Sudhir's avatar
Abinaya Sudhir committed
34 35 36 37 38
type Name = String
type Open = Boolean
type URL  = String
type ID   = Int

39 40
type Props = { root :: ID }

41
data NTree a = NTree a (Array (NTree a))
Abinaya Sudhir's avatar
Abinaya Sudhir committed
42

43 44 45
instance ntreeFunctor :: Functor NTree where
  map f (NTree x ary) = NTree (f x) (map (map f) ary)

46 47 48 49 50 51
-- Keep only the nodes matching the predicate.
-- The root of the tree is always kept.
filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a
filterNTree p (NTree x ary) =
  NTree x $ map (filterNTree p) $ filter (\(NTree a _) -> p a) ary

52
type FTree = NTree LNode
Abinaya Sudhir's avatar
Abinaya Sudhir committed
53

54
data Action =  ShowPopOver   ID
Sudhir Kumar's avatar
Sudhir Kumar committed
55
              | ToggleFolder ID
56 57 58 59
              | RenameNode   String ID
              | Submit       ID String
              | DeleteNode   ID
              | Create       ID
60 61
              | SetNodeValue String ID
              | ToggleCreateNode ID
62 63
              | ShowRenameBox    ID
              | CancelRename     ID
64
              | CurrentNode      ID
65

Abinaya Sudhir's avatar
Abinaya Sudhir committed
66

67 68 69
type State = { state       :: FTree 
             , currentNode :: Maybe Int
             }
Abinaya Sudhir's avatar
Abinaya Sudhir committed
70

71
-- TODO remove
Abinaya Sudhir's avatar
Abinaya Sudhir committed
72
initialState :: State
73
initialState = { state: NTree (LNode {id : 3, name : "hello", nodeType : Node, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "InitialNode", showRenameBox : false}) [] , currentNode : Nothing}
74

75
mapFTree :: (FTree -> FTree) -> State -> State
76
mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode}
77

78
-- TODO: make it a local function
79
performAction :: forall props. PerformAction State props Action
80

81 82
performAction (ToggleFolder i) _ _ =
  modifyState_ $ mapFTree $ toggleNode i
83

84
performAction (ShowPopOver id) _ _ =
85
  modifyState_ $ mapFTree $ map $ popOverNode id
86

87
performAction (ShowRenameBox id) _ _ =
88
  modifyState_ $ mapFTree $ map $ showPopOverNode id
89

90
performAction (CancelRename id) _ _ =
91
  modifyState_ $ mapFTree $ map $ showPopOverNode id
92

93 94
performAction (ToggleCreateNode id) _ _ =
  modifyState_ $ mapFTree $ showCreateNode id
95

96
performAction (DeleteNode nid) _ _ = do
97 98
  void $ lift $ deleteNode nid
  modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
99

100 101 102 103
performAction (Submit rid name) _  _  = do
  void $ lift $ renameNode rid $ RenameValue {name}
  modifyState_ $ mapFTree $ map $ popOverNode rid
                              <<< onNode rid (\(LNode node) -> LNode (node { name = name }))
104

105 106
performAction (RenameNode  r nid) _ _ =
  modifyState_ $ mapFTree $ rename nid r
107

108 109
performAction (Create  nid) _ _ =
  modifyState_ $ mapFTree $ showCreateNode nid
110

111 112
performAction (SetNodeValue v nid) _ _ =
  modifyState_ $ mapFTree $ setNodeValue nid v
113

114 115 116 117
performAction (CurrentNode nid) _ _ =
  modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid}


118 119 120
toggleIf :: Boolean -> Boolean -> Boolean
toggleIf true  = not
toggleIf false = const false
121

122 123 124 125
onNode :: Int -> (LNode -> LNode) -> LNode -> LNode
onNode id f l@(LNode node)
  | node.id == id = f l
  | otherwise     = l
126

127 128 129 130
popOverNode :: Int -> LNode -> LNode
popOverNode sid (LNode node) =
  LNode $ node { popOver = toggleIf (sid == node.id) node.popOver
               , showRenameBox = false }
131

132 133 134
showPopOverNode :: Int -> LNode -> LNode
showPopOverNode sid (LNode node) =
  LNode $ node {showRenameBox = toggleIf (sid == node.id) node.showRenameBox}
135

136
-- TODO: DRY, NTree.map
137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
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 ""

152
-- TODO: DRY, NTree.map
153 154 155 156 157 158
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 ""

159
-- TODO: DRY, NTree.map
160 161 162 163 164 165
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 ""

166
-- TODO: DRY, NTree.map
167
toggleNode :: Int -> NTree LNode -> NTree LNode
168 169
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
Abinaya Sudhir's avatar
Abinaya Sudhir committed
170
  where
171
    nopen = if sid == id then not open else open
Abinaya Sudhir's avatar
Abinaya Sudhir committed
172

173 174


Abinaya Sudhir's avatar
Abinaya Sudhir committed
175 176
------------------------------------------------------------------------
-- Realistic Tree for the UI
177

178
exampleTree :: NTree LNode
Nicolas Pouillard's avatar
Nicolas Pouillard committed
179
exampleTree = NTree (LNode {id : 1, name : "", nodeType : Node, open : false, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}) []
180 181 182 183 184 185 186

-- exampleTree :: NTree LNode
-- exampleTree =
--   NTree 1 true "françois.pineau"
--   [ --annuaire 2 "Annuaire"
--   --, corpus   3 "IMT publications"
--   ]
Abinaya Sudhir's avatar
Abinaya Sudhir committed
187

188 189 190 191
-- annuaire :: Int -> String -> NTree (Tuple String String)
-- annuaire n name = NTree n false name
--     [ NTree (Tuple "IMT community"    "#/docView")
--     ]
192

193 194
-- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
195
--     [ NTree (Tuple "Facets"    "#/corpus") []
196 197 198
--     , NTree (Tuple "Dashboard" "#/dashboard") []
--     , NTree (Tuple "Graph"     "#/graphExplorer") []
--     ]
199 200


Abinaya Sudhir's avatar
Abinaya Sudhir committed
201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
------------------------------------------------------------------------
-- TODO
-- alignment to the right
nodeOptionsCorp :: Boolean -> Array ReactElement
nodeOptionsCorp activated = case activated of
                         true  -> [ i [className "fab fa-whmcs" ] []]
                         false -> []

-- TODO
-- alignment to the right
-- on hover make other options available:
nodeOptionsView :: Boolean -> Array ReactElement
nodeOptionsView activated = case activated of
                         true -> [ i [className "fas fa-sync-alt" ] []
                                 , i [className "fas fa-upload"   ] []
                                 , i [className "fas fa-share-alt"] []
                                 ]
                         false -> []
219

Abinaya Sudhir's avatar
Abinaya Sudhir committed
220

221 222
nodeOptionsRename :: (Action -> Effect Unit) ->  Boolean ->  ID -> Array ReactElement
nodeOptionsRename d activated  id =  case activated of
Sudhir Kumar's avatar
Sudhir Kumar committed
223
                         true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"}
224

Sudhir Kumar's avatar
Sudhir Kumar committed
225 226 227 228
                                        ] []
                                 ]
                         false -> []

229
type LoadedTreeViewProps = Loader.InnerProps Int FTree ()
Sudhir Kumar's avatar
Sudhir Kumar committed
230

231 232
loadedTreeview :: Spec State LoadedTreeViewProps Action
loadedTreeview = simpleSpec performAction render
Abinaya Sudhir's avatar
Abinaya Sudhir committed
233
  where
234
    render :: Render State LoadedTreeViewProps Action
235
    render dispatch _ {state, currentNode} _ =
Sudhir Kumar's avatar
Sudhir Kumar committed
236
      [ div [className "tree"]
237
        [ toHtml dispatch state currentNode
Sudhir Kumar's avatar
Sudhir Kumar committed
238 239 240 241

        ]
      ]

242
treeViewClass :: ReactClass (Loader.InnerProps Int FTree (children :: React.Children))
243
treeViewClass = createClass "TreeView" loadedTreeview (\{loaded: t} -> {state: t, currentNode: Nothing})
244 245 246

treeLoaderClass :: Loader.LoaderClass Int FTree
treeLoaderClass = Loader.createLoaderClass "TreeLoader" loadNode
Sudhir Kumar's avatar
Sudhir Kumar committed
247

248 249 250 251 252 253 254 255 256 257 258
treeLoader :: Loader.Props' Int FTree -> ReactElement
treeLoader props = React.createElement treeLoaderClass props []

treeview :: Spec {} Props Void
treeview = simpleSpec defaultPerformAction render
  where
    render :: Render {} Props Void
    render _ {root} _ _ =
      [ treeLoader { path: root
                   , component: treeViewClass
                   } ]
Sudhir Kumar's avatar
Sudhir Kumar committed
259

260
renameTreeView :: (Action -> Effect Unit) -> FTree -> Int -> ReactElement
261 262 263 264 265 266 267
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%"}]
             [
268 269 270
               if (showRenameBox) then div [_id "afterClick"]
               [
                 div [className "col-md-12"]
271 272 273
               [
                 input [ _type "text"
                    , placeholder "Rename Node"
274
                    , defaultValue $ name
275 276 277 278 279
                    , style {float: "left"}
                    , className "col-md-2 form-control"
                    , onInput \e -> d (RenameNode (unsafeEventValue e) nid)
                    ]
               ]
280
              , div [className "col-md-12"]
281 282 283 284 285 286 287 288
              [ 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"]
                    ]
289
                , div [className "col-md-6"]
290 291 292 293 294 295 296 297
                  [a [className "btn btn-primary"
                     , _type "button"
                     , onClick \_ -> d $ (CancelRename nid)
                     , style {float:"left", backgroundColor: "white", color:"black"}
                     ] [text "cancel"]

                  ]
                ]
298

299
                ]
300

301
            ]
302 303
              else
                div [ _id "beforeClick", className "col-md-12"]
304
             [  div [className "row"]
305
                [ div [className "col-md-6"] [text name]
Sudhir Kumar's avatar
Sudhir Kumar committed
306
                , a [ style {color:"black"},className "glyphitem glyphicon glyphicon-pencil col-md-2", _id "rename1", title "Rename", onClick $ (\_-> d $ (ShowRenameBox id))] [ ]
307 308 309 310 311 312 313 314 315
                ]
             ]
             ]
           ,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))] [ ]]

           ]
316

317 318
          ]
        ]
319

320 321


322
createNodeView :: (Action -> Effect Unit) -> FTree -> Int -> ReactElement
323
createNodeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) nid  =
Sudhir Kumar's avatar
Sudhir Kumar committed
324 325 326 327 328
       div [className ""]
        [  div [className "panel panel-default"]
           [
             div [className "panel-heading"]
             [
329
               h5 [] [text "Create Node"]
Sudhir Kumar's avatar
Sudhir Kumar committed
330 331 332 333
             ]
           ,div [className "panel-body"]
            [
              input [ _type "text"
334
                    , placeholder "Create Node"
335
                    , defaultValue $ getCreateNodeValue s
Sudhir Kumar's avatar
Sudhir Kumar committed
336
                    , className "col-md-12 form-control"
337
                    , onInput \e -> d (SetNodeValue (unsafeEventValue e) nid)
Sudhir Kumar's avatar
Sudhir Kumar committed
338 339 340
                    ]
            ]
          , div [className "panel-footer"]
341
            [ button [className "btn btn-success"
Sudhir Kumar's avatar
Sudhir Kumar committed
342
                     , _type "button"
343 344
                     , onClick \_ -> d $ (Create nid )
                     ] [text "Create"]
Sudhir Kumar's avatar
Sudhir Kumar committed
345 346 347 348 349 350
            ]
          ]
        ]



351
renameTreeViewDummy :: (Action -> Effect Unit) -> FTree -> ReactElement
Sudhir Kumar's avatar
Sudhir Kumar committed
352 353
renameTreeViewDummy d s = div [] []

354
popOverValue :: FTree -> Boolean
355
popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) = popOver
Sudhir Kumar's avatar
Sudhir Kumar committed
356

357
getCreateNodeValue :: FTree -> String
358
getCreateNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, nodeValue, showRenameBox}) ary) = nodeValue
Abinaya Sudhir's avatar
Abinaya Sudhir committed
359 360


361 362
toHtml :: (Action -> Effect Unit) -> FTree -> Maybe Int -> ReactElement
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode,nodeValue, showRenameBox }) []) n =
363 364
  ul []
  [
Sudhir Kumar's avatar
Sudhir Kumar committed
365
    li [] $
366
    [ a [className "glyphicon glyphicon-cog", _id "rename-leaf",onClick $ (\_-> d $ (ShowPopOver id))] []
367 368 369
    , a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
        , onClick $ (\e -> d $ CurrentNode id)
        ]
370
      [ if n == (Just id) then u [] [b [] [text ("| " <> name <> " |    ")]] else text (name <> "    ") ]
371 372
     , if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s)
    , if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s)
373
    ]
374
  ]
Sudhir Kumar's avatar
Sudhir Kumar committed
375
--- need to add renameTreeview value to this function
376
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue,createNode, nodeValue, showRenameBox}) ary) n=
377 378
    ul []
  [ li [] $
Abinaya Sudhir's avatar
Abinaya Sudhir committed
379
    ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
380 381 382 383
       , a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
           , onClick $ (\e -> d $ CurrentNode id)
           ]
         --[ text name ]
384
         [ if n == (Just id) then u [] [b [] [text $ "| " <> name <> " |"]] else text name ]
Sudhir Kumar's avatar
Sudhir Kumar committed
385
,      a [className "glyphicon glyphicon-cog", _id "rename",onClick $ (\_-> d $ (ShowPopOver id))]
386
       [
Sudhir Kumar's avatar
Sudhir Kumar committed
387 388 389
       ]
     , if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s)
    , if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s)
390 391

      ] <>
Abinaya Sudhir's avatar
Abinaya Sudhir committed
392
      if open then
393
        map (\s -> toHtml d s n) ary
Abinaya Sudhir's avatar
Abinaya Sudhir committed
394 395
        else []
    )
396
  ]
Abinaya Sudhir's avatar
Abinaya Sudhir committed
397

Sudhir Kumar's avatar
Sudhir Kumar committed
398 399


400
fldr :: Boolean -> DOM.Props
Abinaya Sudhir's avatar
Abinaya Sudhir committed
401
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
Sudhir Kumar's avatar
Sudhir Kumar committed
402 403


Nicolas Pouillard's avatar
Nicolas Pouillard committed
404
newtype LNode = LNode {id :: Int, name :: String, nodeType :: NodeType, open :: Boolean, popOver :: Boolean, renameNodeValue :: String, nodeValue :: String, createNode :: Boolean, showRenameBox :: Boolean}
Sudhir Kumar's avatar
Sudhir Kumar committed
405

Sudhir Kumar's avatar
Sudhir Kumar committed
406
derive instance newtypeLNode :: Newtype LNode _
Sudhir Kumar's avatar
Sudhir Kumar committed
407 408 409 410 411 412

instance decodeJsonLNode :: DecodeJson LNode where
  decodeJson json = do
    obj <- decodeJson json
    id_ <- obj .? "id"
    name <- obj .? "name"
413
    nodeType <- obj .? "type"
414 415 416
    pure $ LNode {id : id_, name, nodeType, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}

instance decodeJsonFTree :: DecodeJson (NTree LNode) where
Sudhir Kumar's avatar
Sudhir Kumar committed
417 418 419 420 421 422 423 424
  decodeJson json = do
    obj <- decodeJson json
    node <- obj .? "node"
    nodes <- obj .? "children"
    node' <- decodeJson node
    nodes' <- decodeJson nodes
    pure $ NTree node' nodes'

425 426
loadNode :: Int -> Aff FTree
loadNode = get <<< toUrl Back Tree <<< Just
Sudhir Kumar's avatar
Sudhir Kumar committed
427

428 429
----- TREE CRUD Operations

Sudhir Kumar's avatar
Sudhir Kumar committed
430 431 432 433 434 435
newtype RenameValue = RenameValue
  {
    name :: String
  }

instance encodeJsonRenameValue :: EncodeJson RenameValue where
436 437
  encodeJson (RenameValue {name})
     = "r_name" := name
Sudhir Kumar's avatar
Sudhir Kumar committed
438 439
    ~> jsonEmptyObject

440 441
renameNode :: Int -> RenameValue -> Aff (Array Int)
renameNode renameNodeId = put $ toUrl Back Node (Just renameNodeId) <> "/rename"
Sudhir Kumar's avatar
Sudhir Kumar committed
442

443 444
deleteNode :: Int -> Aff Int
deleteNode = delete <<< toUrl Back Node <<< Just
445

446 447 448
-- UNUSED
-- deleteNodes :: TODO -> Aff Int
-- deleteNodes = deleteWithBody (toUrl Back Nodes Nothing)
449

450 451 452
-- UNUSED
-- createNode :: TODO -> Aff Int
-- createNode = post (toUrl Back Node Nothing)
Sudhir Kumar's avatar
Sudhir Kumar committed
453 454

fnTransform :: LNode -> FTree
455
fnTransform n = NTree n []
Sudhir Kumar's avatar
Sudhir Kumar committed
456 457 458

unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value