Tree.purs 23.9 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, launchAff, launchAff_, killFiber, runAff)
18
import Effect.Class (liftEffect)
19
import Effect.Exception (error)
20
import Effect.Uncurried (mkEffectFn1)
21
import FFI.Simple ((..))
22
import Partial.Unsafe (unsafePartial)
23
import React as React
24 25
import React.DOM (a, div, i)
import React.DOM.Props (className, style)
26
import React.SyntheticEvent as E
27 28
import Reactix as R
import Reactix.DOM.HTML as H
29
import Thermite (Spec)
30 31
import URI.Extra.QueryPairs as QP
import URI.Query as Q
32
import Unsafe.Coerce (unsafeCoerce)
33 34
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
35
import Web.File.FileReader.Aff (readAsText)
36

37 38 39 40 41 42 43 44
import Gargantext.Components.Loader2 (useLoader)
import Gargantext.Config (toUrl, End(..), NodeType(..), readNodeType)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Router as Router
import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2

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

50 51
data NodePopup = CreatePopup | NodePopup

52
type Props = { root :: ID, mCurrentRoute :: Maybe Router.Routes }
53

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

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

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

65 66

newtype LNode = LNode { id :: ID
67
                      , name :: Name
68
                      , nodeType :: NodeType}
69 70 71 72 73 74 75 76 77 78 79

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
80
                 , nodeType}
81 82 83 84 85 86 87 88 89 90

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'

91
type FTree = NTree LNode
92 93

-- file upload types
94
data FileType = CSV | PresseRIS
95 96 97 98 99
derive instance genericFileType :: Generic FileType _
instance eqFileType :: Eq FileType where
    eq = genericEq
instance showFileType :: Show FileType where
    show = genericShow
100 101 102 103
readFileType :: String -> Maybe FileType
readFileType "CSV" = Just CSV
readFileType "PresseRIS" = Just PresseRIS
readFileType _ = Nothing
104

105 106 107 108 109
newtype UploadFileContents = UploadFileContents String
data DroppedFile = DroppedFile {
    contents :: UploadFileContents
  , fileType :: Maybe FileType
    }
110
type FileHash = String
Abinaya Sudhir's avatar
Abinaya Sudhir committed
111

112

113 114 115 116
data Action =   Submit       String
              | DeleteNode
              | CreateSubmit String NodeType
              | UploadFile   FileType UploadFileContents
117

Abinaya Sudhir's avatar
Abinaya Sudhir committed
118

119
type State = { tree         :: FTree
120
             }
Abinaya Sudhir's avatar
Abinaya Sudhir committed
121

122
mapFTree :: (FTree -> FTree) -> State -> State
123
mapFTree f s@{tree} = s {tree = f tree}
124

125
-- TODO: make it a local function
126 127
--performAction :: forall props. PerformAction State props Action

128
performAction :: R.State Int -> R.State State -> Action -> Aff Unit
129

130
performAction (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setState) DeleteNode = do
131 132
  void $ deleteNode id
  --modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
133 134
  --liftEffect $ setState $ mapFTree $ filterNTree $ \(LNode {id: nid}) -> nid /= id
  liftEffect $ setReload $ \r -> r + 1
135

136
performAction _ ({tree: NTree (LNode {id}) _} /\ setState) (Submit name)  = do
137 138
  void $ renameNode id $ RenameValue {name}
  --modifyState_ $ mapFTree $ setNodeName rid name
139
  liftEffect $ setState $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
140

141
performAction (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setState) (CreateSubmit name nodeType) = do
142
  void $ createNode id $ CreateValue {name, nodeType}
143
  --modifyState_ $ mapFTree $ map $ hidePopOverNode nid
144
  liftEffect $ setReload $ \r -> r + 1
145

146
performAction _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
147
  hashes <- uploadFile id fileType contents
148 149
  liftEffect $ log2 "uploaded:" hashes

150 151


Abinaya Sudhir's avatar
Abinaya Sudhir committed
152
------------------------------------------------------------------------
153 154 155 156 157 158

mCorpusId :: Maybe Router.Routes -> Maybe Int
mCorpusId (Just (Router.Corpus id)) = Just id
mCorpusId (Just (Router.CorpusDocument id _ _)) = Just id
mCorpusId _ = Nothing

159 160 161
type TreeViewProps = { tree :: FTree
                     , mCurrentRoute :: Maybe Router.Routes
                     }
Sudhir Kumar's avatar
Sudhir Kumar committed
162

163 164
loadedTreeView :: R.State Int -> TreeViewProps -> R.Element
loadedTreeView setReload p = R.createElement el p []
165
  where
166 167
    el = R.hooksComponent "LoadedTreeView" cpt
    cpt {tree, mCurrentRoute} _ = do
168
      setState <- R.useState' {tree}
Sudhir Kumar's avatar
Sudhir Kumar committed
169

170
      pure $ H.div {className: "tree"}
171
        [ toHtml setReload setState mCurrentRoute ]
172

173 174 175 176 177
treeLoadView :: R.State Int -> Props -> R.Element
treeLoadView setReload p = R.createElement el p []
  where
    el = R.hooksComponent "TreeLoadView" cpt
    cpt {root, mCurrentRoute} _ = do
178
      useLoader root loadNode $ \{loaded} ->
179 180
        loadedTreeView setReload {tree: loaded, mCurrentRoute}

181
treeview :: Spec {} Props Void
182
treeview = R2.elSpec $ R.hooksComponent "TreeView" cpt
183
  where
184 185 186 187 188 189 190 191 192
    cpt {root, mCurrentRoute} _children = do
      -- NOTE: this is a hack to reload the tree view on demand
      setReload <- R.useState' 0

      pure $ treeLoadView setReload {root, mCurrentRoute}


-- START toHtml

193
toHtml :: R.State Int -> R.State State -> Maybe Router.Routes -> R.Element
194
--toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
195
toHtml setReload setState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) mCurrentRoute = R.createElement el {} []
196 197 198 199 200 201 202 203
  where
    el = R.hooksComponent "NodeView" cpt
    pAction = performAction setReload setState
    cpt props _ = do
      folderOpen <- R.useState' true

      pure $ H.ul {}
        [ H.li {}
204 205
          ( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen ]
            <> childNodes setReload folderOpen mCurrentRoute ary
206 207 208 209 210 211 212
          )
        ]

type NodeMainSpanProps =
  ( id :: ID
  , name :: Name
  , nodeType :: NodeType
213
  , mCurrentRoute :: Maybe Router.Routes)
214 215 216 217 218 219 220 221

nodeMainSpan :: (Action -> Aff Unit)
             -> Record NodeMainSpanProps
             -> R.State Boolean
             -> R.Element
nodeMainSpan d p folderOpen = R.createElement el p []
  where
    el = R.hooksComponent "NodeMainSpan" cpt
222
    cpt {id, name, nodeType, mCurrentRoute} _ = do
223 224 225 226 227 228 229 230 231 232
      -- only 1 popup at a time is allowed to be opened
      popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
      droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
      isDragOver <- R.useState' false

      pure $ H.span (dropProps droppedFile isDragOver)
        [ folderIcon folderOpen
        , H.a { href: (toUrl Front nodeType (Just id))
              , style: {"margin-left": "22px"}
              }
233
          [ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name} ]
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281
        , popOverIcon popupOpen
        , nodePopupView d {id, name} popupOpen
        , createNodeView d {id, name} popupOpen
        , fileTypeView d {id} droppedFile isDragOver
        ]
    folderIcon folderOpen@(open /\ _) =
      H.a {onClick: R2.effToggler folderOpen}
      [ H.i {className: fldr open} [] ]
    popOverIcon (popOver /\ setPopOver) =
      H.a { className: "glyphicon glyphicon-cog"
          , id: "rename-leaf"
          , onClick: mkEffectFn1 $ \_ -> setPopOver $ toggle
          } []
      where
        toggle Nothing = Just NodePopup
        toggle _       = Nothing
    dropProps droppedFile isDragOver = {
        className: dropClass droppedFile isDragOver
      , onDrop: dropHandler droppedFile
      , onDragOver: onDragOverHandler isDragOver
      , onDragLeave: onDragLeave isDragOver
      }
    dropClass (Just _ /\ _)  _           = "file-dropped"
    dropClass _              (true /\ _) = "file-dropped"
    dropClass (Nothing /\ _) _           = ""
    dropHandler (_ /\ setDroppedFile) = mkEffectFn1 $ \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
        liftEffect $ setDroppedFile $ const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
    onDragOverHandler (_ /\ setIsDragOver) = mkEffectFn1 $ \e -> do
      -- prevent redirection when file is dropped
      -- https://stackoverflow.com/a/6756680/941471
      E.preventDefault e
      E.stopPropagation e
      setIsDragOver $ const true
    onDragLeave (_ /\ setIsDragOver) = mkEffectFn1 $ \_ -> setIsDragOver $ const false


fldr :: Boolean -> String
fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close"


282
childNodes :: R.State Int -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element
283
childNodes _ _ _ [] = []
284 285
childNodes _ (false /\ _) _ _ = []
childNodes setReload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
286 287 288 289
  where
    childNode :: State -> R.Element
    childNode props = R.createElement el props []
    el = R.hooksComponent "ChildNodeView" cpt
290 291
    cpt {tree} _ = do
      setState <- R.useState' {tree}
292

293
      pure $ toHtml setReload setState mCurrentRoute
Nicolas Pouillard's avatar
Nicolas Pouillard committed
294

295
-- END toHtml
Sudhir Kumar's avatar
Sudhir Kumar committed
296

297

298 299 300 301
-- START Popup View

type NodePopupProps =
  ( id :: ID
302
  , name :: Name)
303

304
nodePopupView ::   (Action -> Aff Unit)
305
                 -> Record NodePopupProps
306
                 -> R.State (Maybe NodePopup)
307
                 -> R.Element
308
nodePopupView d p (Just NodePopup /\ setPopupOpen) = R.createElement el p []
309 310
  where
    el = R.hooksComponent "NodePopupView" cpt
311
    cpt {id, name} _ = do
James Laver's avatar
James Laver committed
312
      renameBoxOpen <- R.useState' false
313 314 315 316 317 318
      pure $ H.div tooltipProps $
        [ H.div {id: "arrow"} []
        , H.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)"}
                }
319
          [ panelHeading renameBoxOpen
320
          , panelBody
321 322
          ]
        ]
323
      where
324 325 326 327 328
        tooltipProps = { className: ""
                       , id: "node-popup-tooltip"
                       , title: "Node settings"
                       , data: {toggle: "tooltip", placement: "right"}
                       }
329
        iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
James Laver's avatar
James Laver committed
330 331
        rowClass true = "col-md-10"
        rowClass false = "col-md-8"
332
        panelHeading renameBoxOpen@(open /\ _) =
333 334
          H.div {className: "panel-heading"}
          [ H.div {className: "row" }
335
            [ H.div {className: rowClass open} [ renameBox d {id, name} renameBoxOpen ]
James Laver's avatar
James Laver committed
336 337 338
            , editIcon renameBoxOpen
            , H.div {className: "col-md-2"}
              [ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
339
                    , onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
340 341 342 343
                    , title: "Close"} []
              ]
            ]
          ]
344
        glyphicon t = "glyphitem glyphicon glyphicon-" <> t
345 346 347 348 349 350
        editIcon (false /\ setRenameBoxOpen) =
          H.div {className: "col-md-2"}
          [ H.a {style: {color: "black"}
                , className: "btn glyphitem glyphicon glyphicon-pencil"
                , id: "rename1"
                , title: "Rename"
351
                , onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const true
352 353 354 355
                }
            []
          ]
        editIcon (true /\ _) = H.div {} []
356 357 358 359 360 361
        panelBody =
          H.div {className: "panel-body"
                , style: { display:"flex"
                         , justifyContent : "center"
                         , backgroundColor: "white"
                         , border: "none"}}
362
          [ createButton
363 364
          , H.div {className: "col-md-4"}
            [ H.a {style: iconAStyle
Alexandre Delanoë's avatar
Alexandre Delanoë committed
365
                  , className: (glyphicon "download")
366 367 368 369 370 371
                  , id: "download"
                  , title: "Download [WIP]"}
              []
            ]
          , H.div {className: "col-md-4"}
            [ H.a {style: iconAStyle
Alexandre Delanoë's avatar
Alexandre Delanoë committed
372 373 374
                  , className: (glyphicon "upload")
                  , id: "upload"
                  , title: "Upload [WIP]"}
375 376
              []
            ]
377

Alexandre Delanoë's avatar
Alexandre Delanoë committed
378 379 380 381 382 383 384 385
          , H.div {className: "col-md-4"}
            [ H.a {style: iconAStyle
                  , className: (glyphicon "refresh")
                  , id: "refresh"
                  , title: "Refresh [WIP]"}
              []
            ]

386 387 388 389 390
          , H.div {className: "col-md-4"}
            [ H.a {style: iconAStyle
                  , className: (glyphicon "trash")
                  , id: "rename2"
                  , title: "Delete"
391
                  , onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
392 393 394
              []
            ]
          ]
395 396 397 398 399 400 401
          where
            createButton =
              H.div {className: "col-md-4"}
              [ H.a {style: iconAStyle
                    , className: (glyphicon "plus")
                    , id: "create"
                    , title: "Create"
402
                    , onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const $ Just CreatePopup
403 404 405
                    }
                []
              ]
406
nodePopupView _ p _ = R.createElement el p []
407 408
  where
    el = R.hooksComponent "CreateNodeView" cpt
409 410 411 412 413 414
    cpt _ _ = pure $ H.div {} []

-- END Popup View


-- START Rename Box
415

416 417
type RenameBoxProps =
  ( id :: ID
418
  , name :: Name)
419

420
renameBox :: (Action -> Aff Unit) -> Record RenameBoxProps -> R.State Boolean -> R.Element
421
renameBox d p (true /\ setRenameBoxOpen) = R.createElement el p []
422 423
  where
    el = R.hooksComponent "RenameBox" cpt
424
    cpt {id, name} _ = do
James Laver's avatar
James Laver committed
425
      renameNodeName <- R.useState' name
426 427 428 429
      pure $ H.div {className: "from-group row-no-padding"}
        [ renameInput renameNodeName
        , renameBtn renameNodeName
        , cancelBtn
430
        ]
431 432 433
      where
        renameInput (_ /\ setRenameNodeName) =
          H.div {className: "col-md-8"}
434
          [ H.input { type: "text"
435 436 437
                    , placeholder: "Rename Node"
                    , defaultValue: name
                    , className: "form-control"
438
                    , onInput: mkEffectFn1 $ \e -> setRenameNodeName $ const $ e .. "target" .. "value"
439 440 441 442
                    }
          ]
        renameBtn (newName /\ _) =
          H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
443
              , type: "button"
444
              , onClick: mkEffectFn1 $ \_ -> do
445
                    setRenameBoxOpen $ const false
446
                    launchAff $ d $ Submit newName
447 448 449 450
              , title: "Rename"
              } []
        cancelBtn =
          H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
451
              , type: "button"
452
              , onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
453 454
              , title: "Cancel"
              } []
455
renameBox _ p (false /\ _) = R.createElement el p []
456
  where
457
    el = R.hooksComponent "RenameBox" cpt
458
    cpt {name} _ = pure $ H.div {} [ H.text name ]
459

460
-- END Rename Box
461

462 463 464

-- START Create Node

465 466 467 468 469
type CreateNodeProps =
  ( id :: ID
  , name :: Name)

createNodeView :: (Action -> Aff Unit) -> Record CreateNodeProps -> R.State (Maybe NodePopup) -> R.Element
470
createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
471 472
  where
    el = R.hooksComponent "CreateNodeView" cpt
473
    cpt {id, name} _ = do
James Laver's avatar
James Laver committed
474 475
      nodeName <- R.useState' ""
      nodeType <- R.useState' Corpus
476 477 478 479 480
      pure $ H.div tooltipProps $
        [ H.div {className: "panel panel-default"}
          [ panelHeading
          , panelBody nodeName nodeType
          , panelFooter nodeName nodeType
Sudhir Kumar's avatar
Sudhir Kumar committed
481 482
          ]
        ]
483
      where
484 485 486 487 488
        tooltipProps = { className: ""
                       , id: "create-node-tooltip"
                       , title: "Create new node"
                       , data: {toggle: "tooltip", placement: "right"}
                       }
489 490 491 492 493 494
        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"}
495
              [ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
496
                    , onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
497 498 499 500
                    , title: "Close"} []
              ]
            ]
          ]
James Laver's avatar
James Laver committed
501
        panelBody :: R.State String -> R.State NodeType -> R.Element
502 503
        panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
          H.div {className: "panel-body"}
504
          [ H.div {className: "row"}
505
            [ H.div {className: "col-md-12"}
506 507 508 509
              [ H.form {className: "form-horizontal"}
                [ H.div {className: "form-group"}
                  [ H.input { type: "text"
                            , placeholder: "Node name"
510
                            , defaultValue: name
511
                            , className: "form-control"
512
                            , onInput: mkEffectFn1 $ \e -> setNodeName $ const $ e .. "target" .. "value"
513
                            }
514 515 516
                  ]
                , H.div {className: "form-group"}
                  [ R2.select { className: "form-control"
517
                              , onChange: mkEffectFn1 $ \e -> setNodeType $ const $ readNodeType $ e .. "target" .. "value"
518 519 520
                              }
                    (map renderOption [Corpus, Folder])
                  ]
521 522 523 524 525
                ]
              ]
            ]
          ]
        renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
James Laver's avatar
James Laver committed
526
        panelFooter :: R.State String  -> R.State NodeType -> R.Element
527 528 529
        panelFooter (name /\ _) (nt /\ _) =
          H.div {className: "panel-footer"}
          [ H.button {className: "btn btn-success"
530
                     , type: "button"
531
                     , onClick: mkEffectFn1 $ \_ -> do
532
                         setPopupOpen $ const Nothing
533
                         launchAff $ d $ CreateSubmit name nt
534 535
                     } [H.text "Create"]
          ]
536
createNodeView _ _ _ = R.createElement el {} []
537 538 539
  where
    el = R.hooksComponent "CreateNodeView" cpt
    cpt props _ = pure $ H.div {} []
Sudhir Kumar's avatar
Sudhir Kumar committed
540

541 542 543 544

-- END Create Node


545 546 547 548 549
-- START File Type View

type FileTypeProps =
  ( id :: ID )

550
fileTypeView :: (Action -> Aff Unit) -> Record FileTypeProps -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element
551
fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el p []
552 553
  where
    el = R.hooksComponent "FileTypeView" cpt
554
    cpt {id} _ = do
555 556 557
      pure $ H.div tooltipProps $
        [ H.div {className: "panel panel-default"}
          [ panelHeading
558 559
          , panelBody
          , panelFooter
560 561
          ]
        ]
562
      where
563 564 565 566 567
        tooltipProps = { className: ""
                       , id: "file-type-tooltip"
                       , title: "Choose file type"
                       , data: {toggle: "tooltip", placement: "right"}
                       }
568 569 570 571 572 573
        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"}
574
              [ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
575
                    , onClick: mkEffectFn1 $ \_ -> do
576 577
                        setDroppedFile $ const Nothing
                        setIsDragOver $ const false
578
                    , title: "Close"} []
579
              ]
580 581
            ]
          ]
582
        panelBody =
583 584 585 586 587 588
          H.div {className: "panel-body"}
          [ R2.select {className: "col-md-12 form-control"
                      , onChange: onChange}
            (map renderOption [CSV, PresseRIS])
          ]
          where
589
            onChange = mkEffectFn1 $ \e ->
590
              setDroppedFile $ const $ Just $ DroppedFile $ {contents, fileType: readFileType $ e .. "target" .. "value"}
591
        renderOption opt = H.option {} [ H.text $ show opt ]
592
        panelFooter =
593
          H.div {className: "panel-footer"}
594 595 596 597
          [
            case fileType of
              Just ft ->
                H.button {className: "btn btn-success"
598
                         , type: "button"
599
                         , onClick: mkEffectFn1 $ \_ -> do
600
                             setDroppedFile $ const Nothing
601
                             launchAff $ d $ UploadFile ft contents
602 603 604
                         } [H.text "Upload"]
              Nothing ->
                H.button {className: "btn btn-success disabled"
605
                         , type: "button"
606
                         } [H.text "Upload"]
607
          ]
608
fileTypeView _ _ (Nothing /\ _) _ = R.createElement el {} []
609
  where
610 611
    el = R.hooksComponent "FileTypeView" cpt
    cpt props _ = pure $ H.div {} []
Sudhir Kumar's avatar
Sudhir Kumar committed
612

613
-- END File Type View
Abinaya Sudhir's avatar
Abinaya Sudhir committed
614 615


616 617 618 619
-- START node text

type NodeTextProps =
  ( isSelected :: Boolean
620
  , name :: Name )
621 622 623 624 625 626 627 628 629 630 631

nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement el p []
  where
    el = R.hooksComponent "NodeText" cpt
    cpt {isSelected: true, name} _ = do
      pure $ H.u {} [H.b {} [H.text ("| " <> name <> " |    ")]]
    cpt {isSelected: false, name} _ = do
      pure $ H.text (name <> "    ")

-- END node text
632

633
loadNode :: ID -> Aff FTree
Nicolas Pouillard's avatar
Nicolas Pouillard committed
634
-- loadNode a = lift ((get <<< toUrl Back Tree <<< Just) a)
635
loadNode = get <<< toUrl Back Tree <<< Just
Sudhir Kumar's avatar
Sudhir Kumar committed
636

637 638
----- TREE CRUD Operations

Sudhir Kumar's avatar
Sudhir Kumar committed
639 640
newtype RenameValue = RenameValue
  {
641
    name :: Name
Sudhir Kumar's avatar
Sudhir Kumar committed
642 643 644
  }

instance encodeJsonRenameValue :: EncodeJson RenameValue where
645 646
  encodeJson (RenameValue {name})
     = "r_name" := name
Sudhir Kumar's avatar
Sudhir Kumar committed
647 648
    ~> jsonEmptyObject

649 650
newtype CreateValue = CreateValue
  {
651
    name :: Name
652
  , nodeType :: NodeType
653 654 655
  }

instance encodeJsonCreateValue :: EncodeJson CreateValue where
656 657 658
  encodeJson (CreateValue {name, nodeType})
     = "pn_name" := name
    ~> "pn_typename" := nodeType
659 660
    ~> jsonEmptyObject

661 662 663
createNode :: ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new"
createNode parentId = post $ toUrl Back Node (Just parentId)
664

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

668
deleteNode :: ID -> Aff ID
669
deleteNode = delete <<< toUrl Back Node <<< Just
670

671 672 673 674 675 676 677 678 679 680 681
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) ]

682
uploadFile :: ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
683
uploadFile id fileType (UploadFileContents fileContents) = postWwwUrlencoded url fileContents
684
  where
685 686
    q = FileUploadQuery { fileType: fileType }
    url = toUrl Back Node (Just id) <> "/upload" <> Q.print (toQuery q)
687

688
-- UNUSED
689
-- deleteNodes :: TODO -> Aff ID
690
-- deleteNodes = deleteWithBody (toUrl Back Nodes Nothing)
691

692
-- UNUSED
693
-- createNode :: TODO -> Aff ID
694
-- createNode = post (toUrl Back Node Nothing)
Sudhir Kumar's avatar
Sudhir Kumar committed
695 696

fnTransform :: LNode -> FTree
697
fnTransform n = NTree n []