Forest.purs 6.79 KB
Newer Older
1 2
module Gargantext.Components.Forest where

3
import Data.Array as A
4
import Data.Tuple (fst)
5
import Data.Maybe (Maybe(..), fromMaybe)
6
import Data.Set as Set
7
import Data.Tuple (fst, snd)
8
import Data.Tuple.Nested ((/\))
9
import DOM.Simple.Console (log, log2)
10 11 12
import Reactix as R
import Reactix.DOM.HTML as H

13
import Gargantext.AsyncTasks as GAT
14
import Gargantext.Components.Forest.Tree (treeView)
15
import Gargantext.Components.TopBar (topBar)
16 17
import Gargantext.Ends (Frontends, Backend(..))
import Gargantext.Prelude
18
import Gargantext.Routes (AppRoute)
19
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
20
import Gargantext.Types (Handed(..))
21
import Gargantext.Utils.Reactix as R2
22
import Gargantext.Utils.Reload as GUR
23

24
thisModule :: String
25 26
thisModule = "Gargantext.Components.Forest"

27
type Props = (
28
    appReload     :: GUR.ReloadS
29
  , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
30
  , backend       :: R.State (Maybe Backend)
31
  , currentRoute  :: AppRoute
32 33 34 35
  , frontends     :: Frontends
  , handed        :: Handed
  , sessions      :: Sessions
  , showLogin     :: R.Setter Boolean
36
  , treeReloadRef :: GUR.ReloadWithInitializeRef
37
  )
38

39 40
forest :: R2.Component Props
forest = R.createElement forestCpt
41

42 43 44
forestCpt :: R.Component Props
forestCpt = R.hooksComponentWithModule thisModule "forest" cpt
  where
45 46 47
    cpt { appReload
        , asyncTasksRef
        , backend
48
        , currentRoute
49 50 51 52 53 54
        , frontends
        , handed
        , sessions
        , showLogin
        , treeReloadRef } _ = do
      -- NOTE: this is a hack to reload the tree view on demand
55
      reload     <- GUR.new
56 57 58 59 60 61
      asyncTasks <- GAT.useTasks appReload reload
      openNodes  <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)

      -- TODO If `treeReloadRef` is set, `reload` state should be updated
      R.useEffect' $ do
        R.setRef asyncTasksRef $ Just asyncTasks
62
        GUR.initializeI treeReloadRef reload
63 64 65

      R2.useCache (
          frontends
66
        /\ currentRoute
67 68 69 70 71 72 73 74
        /\ sessions
        /\ fst openNodes
        /\ fst appReload
        /\ fst reload
        /\ (fst asyncTasks).storage
        /\ handed
        )
        (cpt' openNodes asyncTasks appReload reload showLogin backend)
75
    cpt' openNodes asyncTasks appReload reload showLogin backend (frontends /\ currentRoute /\ sessions /\ _ /\ _ /\ _ /\ _ /\ handed) = do
76
      pure $ H.div { className: "forest" } $ [plus handed showLogin backend] <> trees
77 78 79 80
      where
        trees = tree <$> unSessions sessions
        tree s@(Session {treeId}) =
          treeView { appReload
81 82 83 84 85 86 87 88 89
                  , asyncTasks
                    , currentRoute
                  , frontends
                  , handed
                  , openNodes
                  , reload
                  , root: treeId
                  , session: s
                  } []
90

91
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
92
plus handed showLogin backend = H.div { className: "row" } [
93
  H.button { className: "btn btn-primary col-5 " <> if handed == RightHanded then "ml-1 mr-auto" else "ml-auto mr-1"
94
           , on: {click}
95
           , title: "Add or remove connections to the server(s)."
96 97
           }
          [ H.div { "type": ""
98
                  , className: "fa fa-universal-access"  -- fa-lg
Alexandre Delanoë's avatar
Alexandre Delanoë committed
99
                  } [H.text " Log in/out "]
100
          , H.div {} [H.text "    "]
101 102
  --, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
  --, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
103
          ]
104
  ]
105 106
  -- TODO same as the one in the Login Modal (same CSS)
  -- [ H.i { className: "material-icons md-36"} [] ]
107
  where
108 109
    click _ = (snd backend) (const Nothing)
            *> showLogin (const true)
110 111 112


-------------------------
113
type ForestLayoutProps = (
114
    appReload     :: GUR.ReloadS
115 116
  , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
  , backend       :: R.State (Maybe Backend)
117
  , currentRoute  :: AppRoute
118 119 120 121
  , frontends     :: Frontends
  , handed        :: R.State Handed
  , sessions      :: Sessions
  , showLogin     :: R.Setter Boolean
122
  , treeReloadRef :: GUR.ReloadWithInitializeRef
123 124
  )

125
forestLayout :: R2.Component ForestLayoutProps
126
forestLayout props = R.createElement forestLayoutCpt props
127

128 129 130
forestLayoutCpt :: R.Component ForestLayoutProps
forestLayoutCpt = R.hooksComponentWithModule thisModule "forestLayout" cpt
  where
131
    cpt props@{ handed } children = do
132
      pure $ R.fragment [ topBar { handed } [], forestLayoutMain props children ]
133 134 135 136 137

-- a component, for which first child element is placed inside the top bar
-- while the remaining ones are put into the main view
forestLayoutWithTopBar :: R2.Component ForestLayoutProps
forestLayoutWithTopBar props = R.createElement forestLayoutWithTopBarCpt props
138

139 140 141
forestLayoutWithTopBarCpt :: R.Component ForestLayoutProps
forestLayoutWithTopBarCpt = R.hooksComponentWithModule thisModule "forestLayoutWithTopBar" cpt
  where
142 143 144
    cpt props@{ handed } children = do
      let { head: topBarChild, tail: mainChildren } =
            fromMaybe { head: H.div {} [], tail: [] } $ A.uncons children
145 146 147 148
      pure $ R.fragment [
          topBar { handed } [ topBarChild ]
        , forestLayoutMain props mainChildren
      ]
149

150 151
forestLayoutMain :: R2.Component ForestLayoutProps
forestLayoutMain props = R.createElement forestLayoutMainCpt props
152

153 154 155
forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
  where
156 157 158 159 160 161 162
    cpt props children = do
      pure $ forestLayoutRaw props [
          mainPage {} children
        ]

forestLayoutRaw :: R2.Component ForestLayoutProps
forestLayoutRaw props = R.createElement forestLayoutRawCpt props
163

164 165 166
forestLayoutRawCpt :: R.Component ForestLayoutProps
forestLayoutRawCpt = R.hooksComponentWithModule thisModule "forestLayoutRaw" cpt
  where
167 168 169
    cpt { appReload
        , asyncTasksRef
        , backend
170
        , currentRoute
171 172 173 174
        , frontends
        , handed
        , sessions
        , showLogin
175
        , treeReloadRef } children = do
176 177
      let ordering =
            case fst handed of
178
              LeftHanded  -> A.reverse
179 180
              RightHanded -> identity

181
      pure $ R2.row $ ordering ([
182 183 184 185
        H.div { className: "col-md-2", style: { paddingTop: "60px" } } [
          forest { appReload
                 , asyncTasksRef
                 , backend
186
                 , currentRoute
187 188 189 190
                 , frontends
                 , handed: fst handed
                 , sessions
                 , showLogin
191 192 193
                 , treeReloadRef } []
          ]
        ] <> children)
194

195 196
mainPage :: R2.Component ()
mainPage = R.createElement mainPageCpt
197

198 199 200
mainPageCpt :: R.Component ()
mainPageCpt = R.hooksComponentWithModule thisModule "mainPage" cpt
  where
201 202 203 204 205 206
    cpt {} children = do
      pure $ H.div {className: "col-md-10"} [
        H.div {id: "page-wrapper"} [
          H.div {className: "container-fluid"} children
          ]
        ]