Forest.purs 6.84 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 (Reload, ReloadS, Handed(..))
21 22
import Gargantext.Utils.Reactix as R2

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

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

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

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

57
    -- TODO If `treeReloadRef` is set, `reload` state should be updated
58 59
    R.useEffect' $ do
      R.setRef asyncTasksRef $ Just asyncTasks
60 61 62
      case R.readRef treeReloadRef of
        Nothing -> R.setRef treeReloadRef $ Just reload
        Just _  -> pure unit
63 64 65

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

91
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
92
plus handed showLogin backend = H.div { className: handedClass } [
93 94
  H.button { title: "Add or remove connections to the server(s)."
           , on: {click}
95
           , className: "btn btn-default"
96 97 98
           }
          [ H.div { "type": ""
                  , 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 110 111 112
    handedClass = if handed == RightHanded then
                        "flex-start"  -- TODO we should use lefthanded SASS class here
                  else
                        "flex-end"

113 114
    click _ = (snd backend) (const Nothing)
            *> showLogin (const true)
115 116 117


-------------------------
118
type ForestLayoutProps = (
119
    appReload     :: ReloadS
120 121 122 123 124 125 126
  , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
  , backend       :: R.State (Maybe Backend)
  , frontends     :: Frontends
  , handed        :: R.State Handed
  , route         :: AppRoute
  , sessions      :: Sessions
  , showLogin     :: R.Setter Boolean
127
  , treeReloadRef :: R.Ref (Maybe ReloadS)
128 129
  )

130
forestLayout :: R2.Component ForestLayoutProps
131
forestLayout props = R.createElement forestLayoutCpt props
132 133 134 135

forestLayoutCpt :: R.Component ForestLayoutProps
forestLayoutCpt = R.hooksComponentWithModule thisModule "forestLayout" cpt
  where
136
    cpt props@{ handed } children = do
137
      pure $ R.fragment [ topBar { handed } [], forestLayoutMain props children ]
138 139 140 141 142 143 144 145 146 147 148 149

-- 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

forestLayoutWithTopBarCpt :: R.Component ForestLayoutProps
forestLayoutWithTopBarCpt = R.hooksComponentWithModule thisModule "forestLayoutWithTopBar" cpt
  where
    cpt props@{ handed } children = do
      let { head: topBarChild, tail: mainChildren } =
            fromMaybe { head: H.div {} [], tail: [] } $ A.uncons children
150 151 152 153
      pure $ R.fragment [
          topBar { handed } [ topBarChild ]
        , forestLayoutMain props mainChildren
      ]
154

155 156
forestLayoutMain :: R2.Component ForestLayoutProps
forestLayoutMain props = R.createElement forestLayoutMainCpt props
157 158 159

forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
160 161 162 163 164 165 166 167 168 169 170
  where
    cpt props children = do
      pure $ forestLayoutRaw props [
          mainPage {} children
        ]

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

forestLayoutRawCpt :: R.Component ForestLayoutProps
forestLayoutRawCpt = R.hooksComponentWithModule thisModule "forestLayoutRaw" cpt
171
  where
172 173 174 175 176 177 178 179
    cpt { appReload
        , asyncTasksRef
        , backend
        , frontends
        , handed
        , route
        , sessions
        , showLogin
180
        , treeReloadRef } children = do
181 182
      let ordering =
            case fst handed of
183
              LeftHanded  -> A.reverse
184 185
              RightHanded -> identity

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

200 201
mainPage :: R2.Component ()
mainPage = R.createElement mainPageCpt
202

203 204 205 206 207 208 209 210 211
mainPageCpt :: R.Component ()
mainPageCpt = R.hooksComponentWithModule thisModule "mainPage" cpt
  where
    cpt {} children = do
      pure $ H.div {className: "col-md-10"} [
        H.div {id: "page-wrapper"} [
          H.div {className: "container-fluid"} children
          ]
        ]