ListSelection.purs 7.05 KB
Newer Older
1 2 3 4 5
module Gargantext.Components.ListSelection where

import Gargantext.Prelude

import Data.Array as A
6
import Data.Either (Either)
7
import Data.Maybe (Maybe(..))
arturo's avatar
arturo committed
8
import Gargantext.Components.Bootstrap as B
9
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe)
10
import Gargantext.Components.ListSelection.Types (NodeSimple(..), Selection(..), selectedListIds)
11 12 13 14
import Gargantext.Config.REST (RESTError(..), AffRESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session(..), get)
15
import Gargantext.Types (ID, NodeType(..), fldr)
16 17 18 19 20 21 22 23 24
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T

here :: R2.Here
here = R2.here "Gargantext.Components.ListSelection"

type Props =
25 26 27
  ( selection :: T.Box Selection
  , session   :: Session
  )
28 29 30 31 32

selection :: R2.Component Props
selection = R.createElement selectionCpt
selectionCpt :: R.Component Props
selectionCpt = here.component "selection" cpt where
33
  cpt { selection, session } _ = do
arturo's avatar
arturo committed
34
    selection' <- R2.useLive' selection
35
    pure $ H.div { className: "list-selection p-1" }
arturo's avatar
arturo committed
36 37 38 39 40 41 42
      [
        B.formSelect'
        { callback: flip T.write_ selection
        , value: selection'
        , list: [ MyListsFirst
                , OtherListsFirst
                , SelectedLists []
43
                , NoList
arturo's avatar
arturo committed
44 45 46
                ]
        }
        []
47
      , selectedIds { selection, session } []
48 49 50 51 52 53
      ]

selectedIds :: R2.Component Props
selectedIds = R.createElement selectedIdsCpt
selectedIdsCpt :: R.Component Props
selectedIdsCpt = here.component "selectedIds" cpt where
54
  cpt { selection, session } _ = do
55 56 57
    selection' <- T.useLive T.unequal selection

    pure $ case selection' of
58
      SelectedLists ids -> H.div {} [ idsSelector { selection, session } [] ]
59 60 61
      _ -> H.div {} []

type IdsSelectorProps =
62 63
  ( selection :: T.Box Selection
  , session   :: Session )
64 65 66 67 68

idsSelector :: R2.Component IdsSelectorProps
idsSelector = R.createElement idsSelectorCpt
idsSelectorCpt :: R.Component IdsSelectorProps
idsSelectorCpt = here.component "idsSelector" cpt where
69 70
  cpt { selection, session } _ = do
    pure $ H.div { className: "ids-selector" }
71
      [ listTree { name: "", nodeType: NodeUser, root, selection, session } ] -- $ map checkbox [1, 2, 3, 4]
72
    where
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
      Session { treeId: root } = session

listIdsRoute :: ID -> SessionRoute
listIdsRoute = Children NodeList 0 1 Nothing <<< Just

treeFirstLevelRoute :: ID -> SessionRoute
treeFirstLevelRoute id = TreeFirstLevel (Just id) ""

loadTreeChildren :: { root :: ID, session :: Session } -> AffRESTError (Array NodeSimple)
loadTreeChildren { root, session } = do
  eResult :: (Either RESTError { children :: Array NodeSimple }) <- get session $ treeFirstLevelRoute root
  pure $ (\{ children } -> children) <$> eResult

type ListTreeProps =
  ( name      :: String
88
  , nodeType  :: NodeType
89 90
  , root      :: ID
  , selection :: T.Box Selection
91 92
  , session   :: Session
  )
93 94 95 96

listTree :: R2.Leaf ListTreeProps
listTree props = R.createElement listTreeCpt props []
listTreeCpt :: R.Component ListTreeProps
97
listTreeCpt = here.component "listTree" cpt where
98
  cpt { name, nodeType, root, selection, session } _ = do
99 100
    pure $ H.div { className: "tree" }
      [ H.div { className: "root" }
101
        [ H.i { className: fldr nodeType true } []
102 103 104 105 106 107 108 109 110 111 112 113
        , H.text $ "[" <> show root <> "] " <> name ]
      , listTreeChildren { render: listTree
                         , root
                         , selection
                         , session } []
      ]

type Render = Record ListTreeProps -> R.Element
type ListTreeChildrenProps =
  ( render    :: Render
  , root      :: ID
  , selection :: T.Box Selection
114 115
  , session   :: Session
  )
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132

listTreeChildren :: R2.Component ListTreeChildrenProps
listTreeChildren = R.createElement listTreeChildrenCpt
listTreeChildrenCpt :: R.Component ListTreeChildrenProps
listTreeChildrenCpt = here.component "listTreeChildren" cpt where
  cpt { render, root, selection, session } _ = do
    useLoader { errorHandler
              , loader: loadTreeChildren
              , path: { root, session }
              , render: \loaded ->
                  listTreeChildrenLoaded { loaded
                                         , render
                                         , root
                                         , selection
                                         , session } [] }
    where
      errorHandler err = case err of
arturo's avatar
arturo committed
133 134
        ReadJSONError err' -> here.warn2 "[listTreeChildren] ReadJSONError" $ show err'
        _                  -> here.warn2 "[listTreeChildren] RESTError" err
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149

type ListTreeChildrenLoadedProps =
  ( loaded    :: Array NodeSimple
  , render    :: Render
  , root      :: ID
  , selection :: T.Box Selection
  , session   :: Session )

listTreeChildrenLoaded :: R2.Component ListTreeChildrenLoadedProps
listTreeChildrenLoaded = R.createElement listTreeChildrenLoadedCpt
listTreeChildrenLoadedCpt :: R.Component ListTreeChildrenLoadedProps
listTreeChildrenLoadedCpt = here.component "listTreeChildrenLoaded" cpt where
  cpt { loaded, render, root, selection, session } _  = do
    pure $ H.div { className: "children" } (element <$> loaded)
    where
150 151
      element (NodeSimple { id, name, nodeType: nodeType@Corpus }) =
        render { root: id, name, nodeType, selection, session }
152 153 154 155 156 157 158 159
      element (NodeSimple { id, name, nodeType: nodeType@Folder }) =
        render { root: id, name, nodeType, selection, session }
      element (NodeSimple { id, name, nodeType: nodeType@FolderPrivate }) =
        render { root: id, name, nodeType, selection, session }
      element (NodeSimple { id, name, nodeType: nodeType@FolderPublic }) =
        render { root: id, name, nodeType, selection, session }
      element (NodeSimple { id, name, nodeType: nodeType@FolderShared }) =
        render { root: id, name, nodeType, selection, session }
160 161
      element (NodeSimple { id, name, nodeType: NodeList}) =
        renderListElement { id, name, selection }
162 163
      element (NodeSimple { id, name, nodeType: nodeType@Team }) =
        render { root: id, name, nodeType, selection, session }
164 165 166 167 168 169 170 171
      element _ = H.div {} []

type RenderListElementProps =
  ( id        :: ID
  , name      :: String
  , selection :: T.Box Selection )

renderListElement :: R2.Leaf RenderListElementProps
172
renderListElement = R2.leaf renderListElementCpt
173 174 175 176 177 178 179 180
renderListElementCpt :: R.Component RenderListElementProps
renderListElementCpt = here.component "renderListElement" cpt where
  cpt { id, name, selection } _ = do
    selection' <- T.useLive T.unequal selection

    let ids = selectedListIds selection'

    pure $ H.div { className: "leaf" }
181
      [ H.input { defaultChecked: A.elem id ids
182 183 184 185 186 187 188 189 190 191 192 193 194
                , on: { click: click ids }
                , type: "checkbox" }
      , H.i { className: fldr NodeList true } []
      , H.text $ "[" <> show id <> "] " <> name
      ]
      where
        click ids _ = do
          let f (SelectedLists lst) =
                if A.elem id ids
                then SelectedLists (A.delete id lst)
                else SelectedLists (A.cons id lst)
              f x = x
          T.modify_ f selection