SubTree.purs 6.13 KB
Newer Older
1
module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where
2

3 4
import Gargantext.Prelude

5
import Data.Array (length)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
6
import Data.Array as A
7
import Data.Foldable (intercalate)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
8
import Data.Maybe (Maybe(..))
9
import Data.Tuple.Nested ((/\))
arturo's avatar
arturo committed
10
import Gargantext.Components.App.Store (Boxes)
11 12
import Gargantext.Components.Forest.Tree.Node.Action (Props, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action)
13 14
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
15
import Gargantext.Config.REST (AffRESTError, logRESTError)
16 17
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
Alexandre Delanoë's avatar
Alexandre Delanoë committed
18
import Gargantext.Sessions (Session(..), get)
19
import Gargantext.Types as GT
arturo's avatar
arturo committed
20
import Gargantext.Utils (textEllipsisBreak, (?))
21
import Gargantext.Utils.Reactix as R2
22 23 24 25
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
26

27 28
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
29

30
type SubTreeParamsIn =
31
  ( boxes         :: Boxes
32
  , subTreeParams :: SubTreeParams
33 34
  | Props
  )
35

36
------------------------------------------------------------------------
37
type SubTreeParamsProps =
38
  ( action    :: T.Box Action
39
  | SubTreeParamsIn
40 41
  )

42
subTreeView :: R2.Component SubTreeParamsProps
43
subTreeView = R.createElement $ R.memo' subTreeViewCpt
44
subTreeViewCpt :: R.Component SubTreeParamsProps
45
subTreeViewCpt = here.component "subTreeView" cpt
46
  where
47
    cpt { action
48
        , boxes
49 50 51 52 53 54
        , dispatch
        , id
        , nodeType
        , session
        , subTreeParams
        } _ = do
55 56 57 58 59
      let
        SubTreeParams {showtypes} = subTreeParams
      --  (valAction /\ setAction)  = action
      -- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)

60 61 62 63 64
      useLoader { errorHandler
                , loader: loadSubTree showtypes
                , path: session
                , render: \tree ->
                    subTreeViewLoaded { action
65
                                      , boxes
66 67 68 69 70 71 72 73
                                      , dispatch
                                      , id
                                      , nodeType
                                      , session
                                      , subTreeParams
                                      , tree
                                      } []  }
      where
74
        errorHandler = logRESTError here "[subTreeView]"
75

76
loadSubTree :: Array GT.NodeType -> Session -> AffRESTError FTree
77 78 79
loadSubTree nodetypes session = getSubTree session treeId nodetypes
  where
    Session { treeId } = session
80

81
getSubTree :: Session -> Int -> Array GT.NodeType -> AffRESTError FTree
82 83 84 85 86
getSubTree session treeId showtypes = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
  where
    nodeTypes     = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" showtypes

------------------------------------------------------------------------
87
type CorpusTreeProps =
88
  ( tree         :: FTree
89
  | SubTreeParamsProps
90 91
  )

92 93
subTreeViewLoaded :: R2.Component CorpusTreeProps
subTreeViewLoaded = R.createElement subTreeViewLoadedCpt
94
subTreeViewLoadedCpt :: R.Component CorpusTreeProps
95 96 97 98 99 100 101 102 103
subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt where
  cpt props _ = do

    let pRender = Record.merge { render: subTreeTreeView } props

    pure $

      H.div { className: "subtree" }
      [ subTreeTreeView (CorpusTreeRenderProps pRender) [] ]
104

105
newtype CorpusTreeRenderProps = CorpusTreeRenderProps
106
  { render :: CorpusTreeRenderProps -> Array R.Element -> R.Element
107 108
  | CorpusTreeProps
  }
109

110
subTreeTreeView :: CorpusTreeRenderProps -> Array R.Element -> R.Element
111 112 113
subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt
subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps
subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
114
  cpt (CorpusTreeRenderProps p@{ id
115 116 117
                               , render
                               , subTreeParams
                               , tree: NTree (LNode { id: targetId, name, nodeType }) ary }) _ = do
118
    -- Hooks
arturo's avatar
arturo committed
119 120
    action <- R2.useLive' p.action
    isExpanded /\ isExpandedBox <- R2.useBox' false
121 122 123 124 125 126 127 128 129 130
    -- Computed
    let
        expandCbk _ = T.modify_ not isExpandedBox

        selectCbk _ = do
          params <- pure $
            if validNodeType
            then Just $ SubTreeOut { in: id, out: targetId }
            else Nothing
          T.modify_ (\a -> setTreeOut a params) p.action
131

132
        children = (map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry) :: Array R.Element
133

134 135 136 137 138 139 140 141 142
        hasChild = length children > 0

    -- Render
    pure $

      H.div
      { className: intercalate " "
          [ "subtree__node"
          , validNodeType ? "subtree__node--can-be-selected" $ ""
arturo's avatar
arturo committed
143
          , (isSelected targetId action) ? "subtree__node--is-selected" $ ""
144 145 146 147
          ]
      }
      [
          H.div
arturo's avatar
arturo committed
148
          { className: "subtree__node__inner" }
149 150 151 152 153 154 155 156
          [
            H.div
            { className: "subtree__node__icons"
            , on: { click: expandCbk }
            }
            [
              H.span { className: GT.fldr nodeType true } []
            ,
arturo's avatar
arturo committed
157
              R2.when hasChild $
158 159 160 161 162 163 164

                if isExpanded then
                  H.span { className: "fa fa-chevron-down" } []
                else
                  H.span { className: "fa fa-chevron-right" } []
            ]
          ,
arturo's avatar
arturo committed
165 166 167 168
            H.span
            { on: { click: selectCbk }
            , className: "subtree__node__text"
            }
169
            [
arturo's avatar
arturo committed
170
              H.text $ textEllipsisBreak 15 name
171
            ]
172
          ]
173
      ,
arturo's avatar
arturo committed
174
        R2.when (hasChild && isExpanded) $
175 176
          H.div { className: "subtree__node__children" }
          children
177
      ]
178 179 180 181 182
    where
      SubTreeParams { valitypes } = subTreeParams
      sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id')
        $ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary
      validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
183
      isSelected n action = case (subTreeOut action) of
184 185
        Nothing                   -> false
        (Just (SubTreeOut {out})) -> n == out