Tree.purs 16.9 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)
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)
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 60 61 62 63 64
              | RenameNode  String ID
              | Submit ID String
              | DeleteNode ID
              | Create  ID
              | SetNodeValue String ID
              | ToggleCreateNode ID
              | ShowRenameBox ID
              | CancelRename ID

Abinaya Sudhir's avatar
Abinaya Sudhir committed
65

66
type State = { state :: FTree }
Abinaya Sudhir's avatar
Abinaya Sudhir committed
67

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

72 73
mapFTree :: (FTree -> FTree) -> State -> State
mapFTree f {state} = {state: f state}
74

75
-- TODO: make it a local function
76
performAction :: forall props. PerformAction State props Action
77

78 79
performAction (ToggleFolder i) _ _ =
  modifyState_ $ mapFTree $ toggleNode i
80

81
performAction (ShowPopOver id) _ _ =
82
  modifyState_ $ mapFTree $ map $ popOverNode id
83

84
performAction (ShowRenameBox id) _ _ =
85
  modifyState_ $ mapFTree $ map $ showPopOverNode id
86

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

90 91
performAction (ToggleCreateNode id) _ _ =
  modifyState_ $ mapFTree $ showCreateNode id
92

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

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

102 103
performAction (RenameNode  r nid) _ _ =
  modifyState_ $ mapFTree $ rename nid r
104

105 106
performAction (Create  nid) _ _ =
  modifyState_ $ mapFTree $ showCreateNode nid
107

108 109
performAction (SetNodeValue v nid) _ _ =
  modifyState_ $ mapFTree $ setNodeValue nid v
110

111 112 113
toggleIf :: Boolean -> Boolean -> Boolean
toggleIf true  = not
toggleIf false = const false
114

115 116 117 118
onNode :: Int -> (LNode -> LNode) -> LNode -> LNode
onNode id f l@(LNode node)
  | node.id == id = f l
  | otherwise     = l
119

120 121 122 123
popOverNode :: Int -> LNode -> LNode
popOverNode sid (LNode node) =
  LNode $ node { popOver = toggleIf (sid == node.id) node.popOver
               , showRenameBox = false }
124

125 126 127
showPopOverNode :: Int -> LNode -> LNode
showPopOverNode sid (LNode node) =
  LNode $ node {showRenameBox = toggleIf (sid == node.id) node.showRenameBox}
128

129
-- TODO: DRY, NTree.map
130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
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 ""

145
-- TODO: DRY, NTree.map
146 147 148 149 150 151
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 ""

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

159
-- TODO: DRY, NTree.map
160
toggleNode :: Int -> NTree LNode -> NTree LNode
161 162
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
163
  where
164
    nopen = if sid == id then not open else open
Abinaya Sudhir's avatar
Abinaya Sudhir committed
165

166 167


Abinaya Sudhir's avatar
Abinaya Sudhir committed
168 169
------------------------------------------------------------------------
-- Realistic Tree for the UI
170

171
exampleTree :: NTree LNode
Nicolas Pouillard's avatar
Nicolas Pouillard committed
172
exampleTree = NTree (LNode {id : 1, name : "", nodeType : Node, open : false, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "", showRenameBox : false}) []
173 174 175 176 177 178 179

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

181 182 183 184
-- annuaire :: Int -> String -> NTree (Tuple String String)
-- annuaire n name = NTree n false name
--     [ NTree (Tuple "IMT community"    "#/docView")
--     ]
185

186 187
-- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
188
--     [ NTree (Tuple "Facets"    "#/corpus") []
189 190 191
--     , NTree (Tuple "Dashboard" "#/dashboard") []
--     , NTree (Tuple "Graph"     "#/graphExplorer") []
--     ]
192 193


Abinaya Sudhir's avatar
Abinaya Sudhir committed
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211
------------------------------------------------------------------------
-- 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 -> []
212

Abinaya Sudhir's avatar
Abinaya Sudhir committed
213

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

Sudhir Kumar's avatar
Sudhir Kumar committed
218 219 220 221
                                        ] []
                                 ]
                         false -> []

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

224 225
loadedTreeview :: Spec State LoadedTreeViewProps Action
loadedTreeview = simpleSpec performAction render
Abinaya Sudhir's avatar
Abinaya Sudhir committed
226
  where
227
    render :: Render State LoadedTreeViewProps Action
228
    render dispatch _ {state} _ =
Sudhir Kumar's avatar
Sudhir Kumar committed
229 230 231 232 233 234
      [ div [className "tree"]
        [ toHtml dispatch state

        ]
      ]

235 236 237 238 239
treeViewClass :: ReactClass (Loader.InnerProps Int FTree (children :: React.Children))
treeViewClass = createClass "TreeView" loadedTreeview (\{loaded: t} -> {state: t})

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

241 242 243 244 245 246 247 248 249 250 251
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
252

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

                  ]
                ]
291

292
                ]
293

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

           ]
309

310 311
          ]
        ]
312

313 314


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



344
renameTreeViewDummy :: (Action -> Effect Unit) -> FTree -> ReactElement
Sudhir Kumar's avatar
Sudhir Kumar committed
345 346
renameTreeViewDummy d s = div [] []

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

350
getCreateNodeValue :: FTree -> String
351
getCreateNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, nodeValue, showRenameBox}) ary) = nodeValue
Abinaya Sudhir's avatar
Abinaya Sudhir committed
352 353


Sudhir Kumar's avatar
Sudhir Kumar committed
354
toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
355
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode,nodeValue, showRenameBox }) []) =
356 357
  ul []
  [
Sudhir Kumar's avatar
Sudhir Kumar committed
358
    li [] $
359 360 361
    [ a [className "glyphicon glyphicon-cog", _id "rename-leaf",onClick $ (\_-> d $ (ShowPopOver id))] []
    , a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}]
      [ text (name <> "    ") ]
362 363
     , if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s)
    , if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s)
364
    ]
365
  ]
Sudhir Kumar's avatar
Sudhir Kumar committed
366
--- need to add renameTreeview value to this function
367 368 369
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue,createNode, nodeValue, showRenameBox}) ary) =
    ul []
  [ li [] $
Abinaya Sudhir's avatar
Abinaya Sudhir committed
370
    ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
371 372
       , a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}]
         [ text name ]
Sudhir Kumar's avatar
Sudhir Kumar committed
373
,      a [className "glyphicon glyphicon-cog", _id "rename",onClick $ (\_-> d $ (ShowPopOver id))]
374
       [
Sudhir Kumar's avatar
Sudhir Kumar committed
375 376 377
       ]
     , if (popOver == true) then (renameTreeView d s id) else (renameTreeViewDummy d s)
    , if (createNode == true) then (createNodeView d s id) else (renameTreeViewDummy d s)
378 379

      ] <>
Abinaya Sudhir's avatar
Abinaya Sudhir committed
380 381 382 383
      if open then
        map (toHtml d) ary
        else []
    )
384
  ]
Abinaya Sudhir's avatar
Abinaya Sudhir committed
385

Sudhir Kumar's avatar
Sudhir Kumar committed
386 387


388
fldr :: Boolean -> DOM.Props
Abinaya Sudhir's avatar
Abinaya Sudhir committed
389
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
Sudhir Kumar's avatar
Sudhir Kumar committed
390 391


Nicolas Pouillard's avatar
Nicolas Pouillard committed
392
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
393

Sudhir Kumar's avatar
Sudhir Kumar committed
394
derive instance newtypeLNode :: Newtype LNode _
Sudhir Kumar's avatar
Sudhir Kumar committed
395 396 397 398 399 400

instance decodeJsonLNode :: DecodeJson LNode where
  decodeJson json = do
    obj <- decodeJson json
    id_ <- obj .? "id"
    name <- obj .? "name"
401
    nodeType <- obj .? "type"
402 403 404
    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
405 406 407 408 409 410 411 412
  decodeJson json = do
    obj <- decodeJson json
    node <- obj .? "node"
    nodes <- obj .? "children"
    node' <- decodeJson node
    nodes' <- decodeJson nodes
    pure $ NTree node' nodes'

413 414
loadNode :: Int -> Aff FTree
loadNode = get <<< toUrl Back Tree <<< Just
Sudhir Kumar's avatar
Sudhir Kumar committed
415

416 417
----- TREE CRUD Operations

Sudhir Kumar's avatar
Sudhir Kumar committed
418 419 420 421 422 423
newtype RenameValue = RenameValue
  {
    name :: String
  }

instance encodeJsonRenameValue :: EncodeJson RenameValue where
424 425
  encodeJson (RenameValue {name})
     = "r_name" := name
Sudhir Kumar's avatar
Sudhir Kumar committed
426 427
    ~> jsonEmptyObject

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

431 432
deleteNode :: Int -> Aff Int
deleteNode = delete <<< toUrl Back Node <<< Just
433

434 435 436
-- UNUSED
-- deleteNodes :: TODO -> Aff Int
-- deleteNodes = deleteWithBody (toUrl Back Nodes Nothing)
437

438 439 440
-- UNUSED
-- createNode :: TODO -> Aff Int
-- createNode = post (toUrl Back Node Nothing)
Sudhir Kumar's avatar
Sudhir Kumar committed
441 442

fnTransform :: LNode -> FTree
443
fnTransform n = NTree n []
Sudhir Kumar's avatar
Sudhir Kumar committed
444 445 446

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