Tree.purs 5.07 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
module Gargantext.Components.Forest.Tree where

import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter, null)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
17 18 19 20 21 22
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Components.Forest.Tree.Node.Action.Add
import Gargantext.Components.Forest.Tree.Node.Action.Rename
import Gargantext.Components.Forest.Tree.Node.Action.Upload
import Gargantext.Components.Forest.Tree.Node
import Gargantext.Components.Forest.Tree.Node.Box
23
import Gargantext.Ends (Frontends)
24
import Gargantext.Components.Loader (loader)
25 26 27
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session)
import Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>))
28 29 30
import Reactix as R
import Reactix.DOM.HTML as H

31
------------------------------------------------------------------------
32
type Props = ( root          :: ID
33
             , mCurrentRoute :: Maybe AppRoute
34 35
             , session       :: Session
             , frontends     :: Frontends
36
             )
37

38 39 40 41 42 43 44 45 46 47 48 49 50 51
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []

treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
  where
    cpt props _children = do
      -- NOTE: this is a hack to reload the tree view on demand
      reload <- R.useState' (0 :: Reload)
      pure $ treeLoadView reload props

treeLoadView :: R.State Reload -> Record Props -> R.Element
treeLoadView reload p = R.createElement el p []
  where
52
    el = R.staticComponent "TreeLoadView" cpt
53
    cpt {root, mCurrentRoute, session, frontends} _ = do
54
      loader root (loadNode session) $ \loaded ->
55 56
        loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends}

57 58 59 60 61 62
type TreeViewProps = ( tree          :: FTree
                     , mCurrentRoute :: Maybe AppRoute
                     , frontends     :: Frontends
                     , session       :: Session 
                     )

63 64 65 66 67 68 69 70 71 72
loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p []
  where
    el = R.hooksComponent "LoadedTreeView" cpt
    cpt {tree, mCurrentRoute, session, frontends} _ = do
      treeState <- R.useState' {tree}

      pure $ H.div {className: "tree"}
        [ toHtml reload treeState session frontends mCurrentRoute ]

73
------------------------------------------------------------------------
74 75 76 77 78 79
toHtml :: R.State Reload
       -> R.State Tree
       -> Session
       -> Frontends
       -> Maybe AppRoute
       -> R.Element
80 81 82 83
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) session frontends mCurrentRoute = R.createElement el {} []
  where
    el = R.hooksComponent "NodeView" cpt
    pAction = performAction session reload treeState
84

85 86 87 88 89 90 91 92 93 94 95 96
    cpt props _ = do
      folderOpen <- R.useState' true

      let withId (NTree (LNode {id: id'}) _) = id'

      pure $ H.ul {}
        [ H.li {}
          ( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen session frontends ]
            <> childNodes session frontends reload folderOpen mCurrentRoute ary
          )
        ]

97

98 99 100 101 102 103 104
childNodes :: Session
           -> Frontends
           -> R.State Reload
           -> R.State Boolean
           -> Maybe AppRoute
           -> Array FTree
           -> Array R.Element
105 106 107 108 109 110 111 112 113 114 115 116 117
childNodes _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ = []
childNodes session frontends reload (true /\ _) mCurrentRoute ary =
  map (\ctree -> childNode {tree: ctree}) ary
    where
      childNode :: Tree -> R.Element
      childNode props = R.createElement el props []
      el = R.hooksComponent "ChildNodeView" cpt
      cpt {tree} _ = do
        treeState <- R.useState' {tree}
        pure $ toHtml reload treeState session frontends mCurrentRoute


118 119 120 121 122
performAction :: Session
              -> R.State Int
              -> R.State Tree
              -> Action
              -> Aff Unit
123 124 125
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
  void $ deleteNode session id
  liftEffect $ setReload (_ + 1)
126

127 128 129
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name)  = do
  void $ renameNode session id $ RenameValue {name}
  liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
130

131 132 133
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
  void $ createNode session id $ CreateValue {name, nodeType}
  liftEffect $ setReload (_ + 1)
134

135 136 137
performAction session _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
  hashes <- uploadFile session id fileType contents
  liftEffect $ log2 "uploaded:" hashes
138