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

3 4
import Prelude hiding (div)

Sudhir Kumar's avatar
Sudhir Kumar committed
5
import Control.Monad.Cont.Trans (lift)
6
import DOM.Simple.Console (log2)
7
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
8
import Data.Array (filter)
9 10 11
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
12
import Data.Maybe (Maybe(..), fromJust)
13
import Data.Newtype (class Newtype)
14 15
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
Sudhir Kumar's avatar
Sudhir Kumar committed
16
import Effect (Effect)
17
import Effect.Aff (Aff, runAff)
18
import Effect.Class (liftEffect)
19 20 21 22 23 24 25 26 27 28
import Effect.Exception (error, throwException)
import Effect.Uncurried (mkEffectFn1)
import Effect.Unsafe (unsafePerformEffect)
import FFI.Simple ((..), (.=))
import Gargantext.Components.Loader as Loader
import Gargantext.Config (toUrl, End(..), NodeType(..), readNodeType)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
29
import Partial.Unsafe (unsafePartial)
30 31
import React (ReactClass, ReactElement)
import React as React
32
import React.DOM (a, div, i, input, li, span, text, ul, b, u)
33
import React.DOM.Props (_id, _type, className, href, title, onClick, onDrop, onDragOver, onInput, placeholder, style, defaultValue, _data)
34
import React.DOM.Props as DOM
35
import React.SyntheticEvent as E
36 37
import Reactix as R
import Reactix.DOM.HTML as H
38
import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, simpleSpec, modifyState_)
39 40
import URI.Extra.QueryPairs as QP
import URI.Query as Q
41
import Unsafe.Coerce (unsafeCoerce)
42 43
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
44
import Web.File.FileReader.Aff (readAsText)
45

Abinaya Sudhir's avatar
Abinaya Sudhir committed
46 47 48 49 50
type Name = String
type Open = Boolean
type URL  = String
type ID   = Int

51 52
type Props = { root :: ID }

53
data NTree a = NTree a (Array (NTree a))
Abinaya Sudhir's avatar
Abinaya Sudhir committed
54

55 56 57
instance ntreeFunctor :: Functor NTree where
  map f (NTree x ary) = NTree (f x) (map (map f) ary)

58 59 60 61 62 63
-- 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

64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103

newtype LNode = LNode { id :: ID
                      , name :: String
                      , nodeType :: NodeType
                      , open :: Boolean
                      , popOver :: Boolean
                      , renameNodeValue :: String
                      , nodeValue :: String
                      , createNode :: Boolean
                      , droppedFile :: Maybe DroppedFile
                      , showRenameBox :: Boolean}

derive instance newtypeLNode :: Newtype LNode _

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

instance decodeJsonFTree :: DecodeJson (NTree LNode) where
  decodeJson json = do
    obj <- decodeJson json
    node <- obj .: "node"
    nodes <- obj .: "children"
    node' <- decodeJson node
    nodes' <- decodeJson nodes
    pure $ NTree node' nodes'

104
type FTree = NTree LNode
105 106

-- file upload types
107
data FileType = CSV | PresseRIS
108 109 110 111 112
derive instance genericFileType :: Generic FileType _
instance eqFileType :: Eq FileType where
    eq = genericEq
instance showFileType :: Show FileType where
    show = genericShow
113 114 115 116 117
readFileType :: String -> FileType
readFileType "CSV" = CSV
readFileType "PresseRIS" = PresseRIS
readFileType ft = unsafePerformEffect $ throwException $ error $ "File type unknown: " <> ft

118 119 120 121 122
newtype UploadFileContents = UploadFileContents String
data DroppedFile = DroppedFile {
    contents :: UploadFileContents
  , fileType :: Maybe FileType
    }
123
type FileHash = String
Abinaya Sudhir's avatar
Abinaya Sudhir committed
124

125

126
data Action =   ShowPopOver  ID
Sudhir Kumar's avatar
Sudhir Kumar committed
127
              | ToggleFolder ID
128 129 130 131
              | RenameNode   String ID
              | Submit       ID String
              | DeleteNode   ID
              | Create       ID
132
              | CreateSubmit       ID String NodeType
133 134
              | SetNodeValue String ID
              | ToggleCreateNode ID
135 136
              | ShowRenameBox    ID
              | CancelRename     ID
137
              | CurrentNode      ID
138 139
              | PrepareUploadFile ID UploadFileContents
              | UploadFile ID FileType UploadFileContents
140

Abinaya Sudhir's avatar
Abinaya Sudhir committed
141

142
type State = { state       :: FTree
143
             , currentNode :: Maybe ID
144
             }
Abinaya Sudhir's avatar
Abinaya Sudhir committed
145

146
mapFTree :: (FTree -> FTree) -> State -> State
147
mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode}
148

149
-- TODO: make it a local function
150
performAction :: forall props. PerformAction State props Action
151

152 153
performAction (ToggleFolder i) _ _ =
  modifyState_ $ mapFTree $ toggleNode i
154

155
performAction (ShowPopOver id) _ _ =
156
  modifyState_ $ mapFTree $ map $ popOverNode id
157

158
performAction (ShowRenameBox id) _ _ =
159
  modifyState_ $ mapFTree $ map $ showPopOverNode id
160

161
performAction (CancelRename id) _ _ =
162
  modifyState_ $ mapFTree $ map $ showPopOverNode id
163

164 165
performAction (ToggleCreateNode id) _ _ = do
  modifyState_ $ mapFTree $ map $ hidePopOverNode id
166
  modifyState_ $ mapFTree $ showCreateNode id
167

168
performAction (DeleteNode nid) _ _ = do
169 170
  void $ lift $ deleteNode nid
  modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
171

172 173 174 175
performAction (Submit rid name) _  _  = do
  void $ lift $ renameNode rid $ RenameValue {name}
  modifyState_ $ mapFTree $ map $ popOverNode rid
                              <<< onNode rid (\(LNode node) -> LNode (node { name = name }))
176

177 178
performAction (RenameNode  r nid) _ _ =
  modifyState_ $ mapFTree $ rename nid r
179

180 181
performAction (CreateSubmit nid name nodeType) _ _ = do
  void $ lift $ createNode nid $ CreateValue {name, nodeType}
182 183 184
  modifyState_ $ mapFTree $ map $ hidePopOverNode nid

performAction (Create  nid) _ _ = do
185
  modifyState_ $ mapFTree $ showCreateNode nid
186

187 188
performAction (SetNodeValue v nid) _ _ =
  modifyState_ $ mapFTree $ setNodeValue nid v
189

190 191 192
performAction (CurrentNode nid) _ _ =
  modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid}

193 194 195 196 197
performAction (PrepareUploadFile nid contents) _ _ = do
  modifyState_ $ mapFTree $ map $ toggleFileTypeBox nid contents

performAction (UploadFile nid fileType contents) _ _ = do
  hashes <- lift $ uploadFile nid fileType contents
198 199
  liftEffect $ log2 "uploaded:" hashes

200

201 202 203
toggleIf :: Boolean -> Boolean -> Boolean
toggleIf true  = not
toggleIf false = const false
204

205
onNode :: ID -> (LNode -> LNode) -> LNode -> LNode
206 207 208
onNode id f l@(LNode node)
  | node.id == id = f l
  | otherwise     = l
209

210
popOverNode :: ID -> LNode -> LNode
211 212 213
popOverNode sid (LNode node) =
  LNode $ node { popOver = toggleIf (sid == node.id) node.popOver
               , showRenameBox = false }
214

215
hidePopOverNode :: ID -> LNode -> LNode
216 217 218
hidePopOverNode sid (LNode node) =
  LNode $ node { popOver = false }

219
showPopOverNode :: ID -> LNode -> LNode
220 221
showPopOverNode sid (LNode node) =
  LNode $ node {showRenameBox = toggleIf (sid == node.id) node.showRenameBox}
222

223
toggleFileTypeBox :: ID -> UploadFileContents -> LNode -> LNode
224 225 226 227
toggleFileTypeBox sid contents (LNode node@{id, droppedFile: Nothing}) | sid == id = LNode $ node {droppedFile = droppedFile}
  where
    droppedFile = Just $ DroppedFile {contents: contents, fileType: Nothing}
toggleFileTypeBox sid _ (LNode node) = LNode $ node {droppedFile = Nothing}
228

229
-- TODO: DRY, NTree.map
230
showCreateNode :: ID -> NTree LNode -> NTree LNode
231 232
showCreateNode sid (NTree (LNode node@{id, createNode}) ary) =
  NTree (LNode $ node {createNode = createNode'}) $ map (showCreateNode sid) ary
233 234 235
  where
    createNode' = if sid == id then not createNode else createNode

236
-- TODO: DRY, NTree.map
237
rename :: ID ->  String -> NTree LNode  -> NTree LNode
238 239
rename sid v (NTree (LNode node@{id}) ary)  =
  NTree (LNode $ node {renameNodeValue = rvalue}) $ map (rename sid  v) ary
240 241 242
  where
    rvalue = if sid == id then  v   else ""

243
-- TODO: DRY, NTree.map
244
setNodeValue :: ID ->  String -> NTree LNode  -> NTree LNode
245 246
setNodeValue sid v (NTree (LNode node@{id}) ary)  =
  NTree (LNode $ node {nodeValue = nvalue}) $ map (setNodeValue sid  v) ary
247 248 249
  where
    nvalue = if sid == id then  v   else ""

250
-- TODO: DRY, NTree.map
251
toggleNode :: ID -> NTree LNode -> NTree LNode
252 253
toggleNode sid (NTree (LNode node@{id, open}) ary) =
  NTree (LNode $ node {open = nopen}) $ map (toggleNode sid) ary
Abinaya Sudhir's avatar
Abinaya Sudhir committed
254
  where
255
    nopen = if sid == id then not open else open
Abinaya Sudhir's avatar
Abinaya Sudhir committed
256

257 258


Abinaya Sudhir's avatar
Abinaya Sudhir committed
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
------------------------------------------------------------------------
-- 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 -> []
277

Abinaya Sudhir's avatar
Abinaya Sudhir committed
278

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

Sudhir Kumar's avatar
Sudhir Kumar committed
283 284 285 286
                                        ] []
                                 ]
                         false -> []

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

289 290
loadedTreeview :: Spec State LoadedTreeViewProps Action
loadedTreeview = simpleSpec performAction render
Abinaya Sudhir's avatar
Abinaya Sudhir committed
291
  where
292
    render :: Render State LoadedTreeViewProps Action
293
    render dispatch _ {state, currentNode} _ =
Sudhir Kumar's avatar
Sudhir Kumar committed
294
      [ div [className "tree"]
295
        [ toHtml dispatch state currentNode
Sudhir Kumar's avatar
Sudhir Kumar committed
296 297 298 299

        ]
      ]

300
treeViewClass :: ReactClass (Loader.InnerProps Int FTree (children :: React.Children))
301
treeViewClass = createClass "TreeView" loadedTreeview (\{loaded: t} -> {state: t, currentNode: Nothing})
302 303 304

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

306 307 308 309 310 311 312 313 314 315 316
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
317

318
renameTreeView :: (Action -> Effect Unit) -> FTree -> ID -> ReactElement
319
renameTreeView d s@(NTree (LNode {id, name, renameNodeValue, popOver: true, showRenameBox }) ary) nid  =
320 321
  div [ className ""
      , _id "rename-tooltip"
322
      , _data {toggle: "tooltip", placement: "right"}
323 324 325 326 327 328 329
      , 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"]
      [ div [ className "row" ] $
        [ div [className (if (showRenameBox) then "col-md-10" else "col-md-8")]
330 331
          [ renameBox showRenameBox ]
        ] <> [ editIcon showRenameBox ] <> [
332
          div [ className "col-md-2" ]
333 334 335
          [ a [className "btn text-danger glyphitem glyphicon glyphicon-remove"
              , onClick $ \_ -> d $ ShowPopOver nid
              , title "Close"] []
336 337 338 339 340 341 342 343
          ]
        ]
      ]
    , div [ className "panel-body"
          , style {display:"flex", justifyContent : "center", backgroundColor: "white", border: "none"}]
      [ div [className "col-md-4"]
        [a [ style iconAStyle
           , className (glyphicon "plus")
344
           , _id "create"
345 346 347 348 349 350 351
           , title "Create"
           , onClick $ (\_ -> d $ (ToggleCreateNode id))]
         []
        ]
      , div [className "col-md-4"]
        [a [ style iconAStyle
           , className (glyphicon "download-alt")
352
           , _id "download"
353 354 355 356 357 358
           , title "Download [WIP]"]
         []
        ]
      , div [className "col-md-4"]
        [a [ style iconAStyle
           , className (glyphicon "duplicate")
359
           , _id "duplicate"
360 361 362 363 364 365 366 367 368 369 370 371 372 373
           , title "Duplicate [WIP]"]
         []
        ]
      , div [className "col-md-4"]
        [ a [ style iconAStyle
            , className (glyphicon "trash")
            , _id "rename2"
            , title "Delete"
            , onClick $ (\_-> d $ (DeleteNode id))]
          []
        ]
      ]
    ]
  ]
374 375 376
  where
    iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
    glyphicon t = "glyphitem glyphicon glyphicon-" <> t
377
    editIcon false = div [ className "col-md-2" ]
378 379 380 381 382 383 384
                [ a [ style {color:"black"}
                    , className "btn glyphitem glyphicon glyphicon-pencil"
                    , _id "rename1"
                    , title "Rename"
                    , onClick $ (\_-> d $ (ShowRenameBox id))]
                  []
                ]
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406
    editIcon true = div [] []
    renameBox true = div [ className "from-group row-no-padding" ]
                     [ div [className "col-md-8"]
                       [ input [ _type "text"
                               , placeholder "Rename Node"
                               , defaultValue $ name
                               , className "form-control"
                               , onInput \e -> d (RenameNode (unsafeEventValue e) nid)
                               ]
                       ]
                     , a [className "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
                         , _type "button"
                         , onClick \_ -> d $ (Submit nid renameNodeValue)
                         , title "Rename"
                         ] []
                     , a [className "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
                         , _type "button"
                         , onClick \_ -> d $ (CancelRename nid)
                         , title "Cancel"
                         ] []
                     ]
    renameBox false = div [] [ text name ]
407
renameTreeView _ _ _ = div [] []
408

409 410 411 412 413 414 415 416 417 418 419 420
createNodeView :: (Action -> Effect Unit) -> FTree -> R.Element
createNodeView d s@(NTree (LNode {id, createNode: true, nodeValue}) _) = R.createElement el {} []
  where
    el = R.hooksComponent "CreateNodeView" cpt
    cpt props _ = do
      nodeName <- R.useState $ \_ -> pure ""
      nodeType <- R.useState $ \_ -> pure Corpus
      pure $ H.div tooltipProps $
        [ H.div {className: "panel panel-default"}
          [ panelHeading
          , panelBody nodeName nodeType
          , panelFooter nodeName nodeType
Sudhir Kumar's avatar
Sudhir Kumar committed
421 422
          ]
        ]
423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471
      where
        tooltipProps = ({ className: ""
                        , id: "create-node-tooltip"
                        , title: "Create new node"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
        panelHeading =
          H.div {className: "panel-heading"}
          [ H.div {className: "row"}
            [ H.div {className: "col-md-10"}
              [ H.h5 {} [H.text "Create Node"] ]
            , H.div {className: "col-md-2"}
              [ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove"
                    , onClick: mkEffectFn1 $ \_ -> d $ ToggleCreateNode id
                    , title: "Close"} []
              ]
            ]
          ]
        panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
          H.div {className: "panel-body"}
          [ H.div {className: "row form-group"}
            [ H.div {className: "col-md-12"}
              [ H.div {className: "row"}
                [ H.input { _type: "text"
                          , placeholder: "Create Node"
                          , defaultValue: getCreateNodeValue s
                          , className: "col-md-12 form-control"
                          , onInput: mkEffectFn1 $ \e -> setNodeName $ e .. "target" .. "value"
                          }
                ]
              , H.div {className: "row"}
                [ R2.select { className: "col-md-12 form-control"
                             , onChange: mkEffectFn1 $ \e -> setNodeType $ readNodeType $ e .. "target" .. "value"
                            }
                  (map renderOption [Corpus, Folder])
                ]
              ]
            ]
          ]
        renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
        panelFooter (name /\ _) (nt /\ _) =
          H.div {className: "panel-footer"}
          [ H.button {className: "btn btn-success"
                     , _type: "button"
                     , onClick: mkEffectFn1 $ \_ -> d $ (CreateSubmit id name nt)
                     } [H.text "Create"]
          ]
createNodeView _ _ = R.createElement el {} []
  where
    el = R.hooksComponent "CreateNodeView" cpt
    cpt props _ = pure $ H.div {} []
Sudhir Kumar's avatar
Sudhir Kumar committed
472 473


474 475 476 477 478 479 480 481 482 483 484 485

fileTypeView :: (Action -> Effect Unit) -> FTree -> R.Element
fileTypeView d s@(NTree (LNode {id, droppedFile: Just (DroppedFile {contents, fileType: Nothing})}) _) = R.createElement el {} []
  where
    el = R.hooksComponent "FileTypeView" cpt
    cpt props _ = do
      fileType <- R.useState $ \_ -> pure CSV
      pure $ H.div tooltipProps $
        [ H.div {className: "panel panel-default"}
          [ panelHeading
          , panelBody fileType
          , panelFooter fileType
486 487
          ]
        ]
488 489 490 491 492 493 494 495 496 497 498 499 500
      where
        tooltipProps = ({ className: ""
                        , id: "file-type-tooltip"
                        , title: "Choose file type"} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
        panelHeading =
          H.div {className: "panel-heading"}
          [ H.div {className: "row"}
            [ H.div {className: "col-md-10"}
              [ H.h5 {} [H.text "Choose file type"] ]
            , H.div {className: "col-md-2"}
              [ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove"
                    --, onClick $ \_ -> d $ PrepareUploadFile nid contents
                    , title: "Close"} []
501
              ]
502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520
            ]
          ]
        panelBody (_ /\ setFileType) =
          H.div {className: "panel-body"}
          [ R2.select {className: "col-md-12 form-control"
                      , onChange: onChange}
            (map renderOption [CSV, PresseRIS])
          ]
          where
            onChange = mkEffectFn1 $ \e -> setFileType $ readFileType $ e .. "target" .. "value"
        renderOption opt = H.option {} [ H.text $ show opt ]
        panelFooter (ft /\ _) =
          H.div {className: "panel-footer"}
          [ H.button {className: "btn btn-success"
                     , _type: "button"
                     , onClick: mkEffectFn1 $ \_ -> d $ (UploadFile id ft contents)
                    } [H.text "Upload"]
          ]
fileTypeView _ _ = R.createElement el {} []
521
  where
522 523
    el = R.hooksComponent "FileTypeView" cpt
    cpt props _ = pure $ H.div {} []
Sudhir Kumar's avatar
Sudhir Kumar committed
524

525
popOverValue :: FTree -> Boolean
526
popOverValue (NTree (LNode {popOver}) ary) = popOver
Sudhir Kumar's avatar
Sudhir Kumar committed
527

528
getCreateNodeValue :: FTree -> String
529
getCreateNodeValue (NTree (LNode {nodeValue}) ary) = nodeValue
Abinaya Sudhir's avatar
Abinaya Sudhir committed
530 531


532
toHtml :: (Action -> Effect Unit) -> FTree -> Maybe ID -> ReactElement
533
toHtml d s@(NTree (LNode {id, name, nodeType}) []) n =
534 535
  ul []
  [
536
    li [] $ [span []
537
    [ a [className "glyphicon glyphicon-cog", _id "rename-leaf",onClick $ (\_-> d $ (ShowPopOver id))] []
538 539 540
    , a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
        , onClick $ (\e -> d $ CurrentNode id)
        ]
541
      [ if n == (Just id) then u [] [b [] [text ("| " <> name <> " |    ")]] else text (name <> "    ") ]
542
    , renameTreeView d s id
543 544
    , (R2.scuff $ createNodeView d s)
    , (R2.scuff $ fileTypeView d s)
545
    ]
546
  ]]
Sudhir Kumar's avatar
Sudhir Kumar committed
547
--- need to add renameTreeview value to this function
548
toHtml d s@(NTree (LNode {id, name, nodeType, open}) ary) n =
549 550
    ul []
  [ li [] $
551 552
    ( [span [onDrop dropHandler, onDragOver onDragOverHandler] [
         a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
553 554 555 556
       , a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
           , onClick $ (\e -> d $ CurrentNode id)
           ]
         --[ text name ]
557
         [ if n == (Just id) then u [] [b [] [text $ "| " <> name <> " |"]] else text name ]
558 559 560 561
       , a [ className "glyphicon glyphicon-cog"
         , _id "rename"
         , onClick $ (\_-> d $ (ShowPopOver id))
         ] []
562
       , renameTreeView d s id
563 564
       , (R2.scuff $ createNodeView d s)
       , (R2.scuff $ fileTypeView d s)
565 566
       ]
      ] <> if open then
567
        map (\cs -> toHtml d cs n) ary
568
      else []
Abinaya Sudhir's avatar
Abinaya Sudhir committed
569
    )
570
  ]
571 572 573 574 575 576 577 578 579 580
  where
    dropHandler = \e -> unsafePartial $ do
      let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
      liftEffect $ log2 "drop:" ff
      -- prevent redirection when file is dropped
      E.preventDefault e
      E.stopPropagation e
      let blob = toBlob $ ff
      void $ runAff (\_ -> pure unit) do
        contents <- readAsText blob
581
        liftEffect $ d $ PrepareUploadFile id (UploadFileContents contents)
582 583 584 585 586
    onDragOverHandler = \e -> do
      -- prevent redirection when file is dropped
      -- https://stackoverflow.com/a/6756680/941471
      E.preventDefault e
      E.stopPropagation e
Sudhir Kumar's avatar
Sudhir Kumar committed
587 588


589
fldr :: Boolean -> DOM.Props
Abinaya Sudhir's avatar
Abinaya Sudhir committed
590
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
Sudhir Kumar's avatar
Sudhir Kumar committed
591 592


593
loadNode :: ID -> Aff FTree
594
loadNode = get <<< toUrl Back Tree <<< Just
Sudhir Kumar's avatar
Sudhir Kumar committed
595

596 597
----- TREE CRUD Operations

Sudhir Kumar's avatar
Sudhir Kumar committed
598 599 600 601 602 603
newtype RenameValue = RenameValue
  {
    name :: String
  }

instance encodeJsonRenameValue :: EncodeJson RenameValue where
604 605
  encodeJson (RenameValue {name})
     = "r_name" := name
Sudhir Kumar's avatar
Sudhir Kumar committed
606 607
    ~> jsonEmptyObject

608 609 610
newtype CreateValue = CreateValue
  {
    name :: String
611
  , nodeType :: NodeType
612 613 614
  }

instance encodeJsonCreateValue :: EncodeJson CreateValue where
615 616 617
  encodeJson (CreateValue {name, nodeType})
     = "pn_name" := name
    ~> "pn_typename" := nodeType
618 619
    ~> jsonEmptyObject

620 621 622
createNode :: ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new"
createNode parentId = post $ toUrl Back Node (Just parentId)
623

624
renameNode :: ID -> RenameValue -> Aff (Array ID)
625
renameNode renameNodeId = put $ toUrl Back Node (Just renameNodeId) <> "/rename"
Sudhir Kumar's avatar
Sudhir Kumar committed
626

627
deleteNode :: ID -> Aff ID
628
deleteNode = delete <<< toUrl Back Node <<< Just
629

630 631 632 633 634 635 636 637 638 639 640
newtype FileUploadQuery = FileUploadQuery {
    fileType :: FileType
  }
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
  toQuery (FileUploadQuery {fileType}) =
    QP.print id id $ QP.QueryPairs $
         pair "fileType" fileType
    where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
          pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]

641
uploadFile :: ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
642
uploadFile id fileType (UploadFileContents fileContents) = postWwwUrlencoded url fileContents
643
  where
644 645
    q = FileUploadQuery { fileType: fileType }
    url = toUrl Back Node (Just id) <> "/upload" <> Q.print (toQuery q)
646

647
-- UNUSED
648
-- deleteNodes :: TODO -> Aff ID
649
-- deleteNodes = deleteWithBody (toUrl Back Nodes Nothing)
650

651
-- UNUSED
652
-- createNode :: TODO -> Aff ID
653
-- createNode = post (toUrl Back Node Nothing)
Sudhir Kumar's avatar
Sudhir Kumar committed
654 655

fnTransform :: LNode -> FTree
656
fnTransform n = NTree n []
Sudhir Kumar's avatar
Sudhir Kumar committed
657 658 659

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