Forest.purs 5.75 KB
Newer Older
James Laver's avatar
James Laver committed
1 2 3 4
module Gargantext.Components.Forest
  ( forest, forestLayout, forestLayoutWithTopBar
  , forestLayoutMain, forestLayoutRaw, mainLayout
  ) where
5

6 7
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe)
8
import Data.Set as Set
9
import Data.Tuple (fst, snd)
10
import Data.Tuple.Nested ((/\))
11 12
import Reactix as R
import Reactix.DOM.HTML as H
James Laver's avatar
James Laver committed
13
import Toestand as T
14

15
import Gargantext.AsyncTasks as GAT
16
import Gargantext.Components.Forest.Tree (treeView)
17
import Gargantext.Components.TopBar (topBar)
James Laver's avatar
James Laver committed
18
import Gargantext.Ends (Frontends, Backend)
19
import Gargantext.Prelude
20
import Gargantext.Routes (AppRoute)
21
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
James Laver's avatar
James Laver committed
22
import Gargantext.Types (Handed(..), reverseHanded)
23
import Gargantext.Utils.Reactix as R2
24
import Gargantext.Utils.Reload as GUR
James Laver's avatar
James Laver committed
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
import Gargantext.Utils.Toestand as T2

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

type Props =
  ( tasks        :: R.Ref (Maybe GAT.Reductor)
  , route        :: AppRoute
  , frontends    :: Frontends
  , backend      :: T.Cursor Backend
  , handed       :: T.Cursor Handed
  , sessions     :: T.Cursor Session
  , showLogin    :: T.Cursor Boolean
  , forestOpen   :: T.Cursor OpenNodes
  , reloadForest :: T.Cursor T2.Reload
  , reloadRoot   :: T.Cursor T2.Reload
41
  )
42

43 44
forest :: R2.Component Props
forest = R.createElement forestCpt
45

46
forestCpt :: R.Component Props
James Laver's avatar
James Laver committed
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
forestCpt = here.component "forest" cpt where
  cpt { reloadRoot, tasks, backend, route, frontends, handed
      , sessions, showLogin, reloadForest } _ = do
    -- NOTE: this is a hack to reload the forest on demand
    tasks'        <- GAT.useTasks reloadRoot reload
    handed'       <- T.useLive T.unequal handed
    reloadForest' <- T.useLive T.unequal reloadForest
    reloadRoot'   <- T.useLive T.unequal reloadRoot
    -- TODO If `reloadForest` is set, `reload` state should be updated
    R.useEffect' $ do
      R.setRef tasks $ Just tasks'
      GUR.initializeI reloadForest reload
    R2.useCache
      ( frontends /\ route /\ sessions /\ handed' /\ fst forestOpen 
        /\ reloadForest /\ reloadRoot /\ (fst tasks).storage )
      cp where
        cp _ =
          pure $ H.div { className: "forest" }
            (A.cons (plus handed' showLogin backend) trees)
66 67
        trees = tree <$> unSessions sessions
        tree s@(Session {treeId}) =
James Laver's avatar
James Laver committed
68 69
          treeView { reloadRoot, tasks, route, frontends, handed
                   , forestOpen, reload, root: treeId, session: s } []
70

71
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
James Laver's avatar
James Laver committed
72 73 74 75
plus handed showLogin backend = H.div { className: "row" }
  H.button { title, className: buttonClass, on: { click } }
  [ H.div { className: divClass } [ H.text " Log in/out " ] -- fa-lg
  , H.div {} [ H.text "    " ] ]
76 77
  --, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
  --, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
78 79
  -- TODO same as the one in the Login Modal (same CSS)
  -- [ H.i { className: "material-icons md-36"} [] ]
80
  where
James Laver's avatar
James Laver committed
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
    click _ = (snd backend) (const Nothing) *> showLogin (const true)
    title = "Add or remove connections to the server(s)."
    divClass = "fa fa-universal-access"
    buttonClass =
      "btn btn-primary col-5 " <> switchHanded "ml-1 mr-auto" "mr-1 ml-auto"

type LayoutProps =
  ( tasks        :: R.Ref (Maybe GAT.Reductor)
  , route        :: AppRoute
  , frontends    :: Frontends
  , backend      :: T.Cursor Backend
  , sessions     :: T.Cursor Session
  , handed       :: T.Cursor Handed
  , showLogin    :: T.Cursor Boolean
  , reloadForest :: T.Cursor T2.Reload
  , reloadRoot   :: T.Cursor T2.Reload
97 98
  )

James Laver's avatar
James Laver committed
99
forestLayout :: R2.Component LayoutProps
100
forestLayout props = R.createElement forestLayoutCpt props
101

James Laver's avatar
James Laver committed
102 103 104
forestLayoutCpt :: R.Component LayoutProps
forestLayoutCpt = here.component "forestLayout" cpt where
  cpt props@{ handed } children =
105
      pure $ R.fragment [ topBar { handed } [], forestLayoutMain props children ]
106

James Laver's avatar
James Laver committed
107 108 109
-- Renders its first child component in the top bar and the rest in
-- the main view.
forestLayoutWithTopBar :: R2.Component LayoutProps
110
forestLayoutWithTopBar props = R.createElement forestLayoutWithTopBarCpt props
111

James Laver's avatar
James Laver committed
112 113 114 115 116 117 118 119 120 121
forestLayoutWithTopBarCpt :: R.Component LayoutProps
forestLayoutWithTopBarCpt = here.component "forestLayoutWithTopBar" cpt where
  cpt props@{ handed } children = do
    let { head: topBarChild, tail: mainChildren } =
          fromMaybe { head: H.div {} [], tail: [] } $ A.uncons children
    pure $ R.fragment
      [ topBar { handed } [ topBarChild ]
      , forestLayoutMain props mainChildren ]

forestLayoutMain :: R2.Component LayoutProps
122
forestLayoutMain props = R.createElement forestLayoutMainCpt props
123

James Laver's avatar
James Laver committed
124 125 126
forestLayoutMainCpt :: R.Component LayoutProps
forestLayoutMainCpt = here.component "forestLayoutMain" cpt where
  cpt props children = pure $ forestLayoutRaw props [ mainPage {} children ]
127

James Laver's avatar
James Laver committed
128
forestLayoutRaw :: R2.Component LayoutProps
129
forestLayoutRaw props = R.createElement forestLayoutRawCpt props
130

James Laver's avatar
James Laver committed
131 132 133 134 135 136 137 138 139 140 141 142
forestLayoutRawCpt :: R.Component LayoutProps
forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
  cpt p@{ reloadRoot, tasks, backend, route, frontends
        , sessions, showLogin, reloadForest } children = do
    handed <- T.useLive T.unequal p.handed
    pure $ R2.row $ reverseHanded
      [ H.div { className: "col-md-2", style: { paddingTop: "60px" } }
        (A.cons forest' children) ] where
        forest' =
          forest
          { reloadRoot, tasks, backend, route, frontends
          , handed, sessions, showLogin, reloadForest } []
143

144 145
mainPage :: R2.Component ()
mainPage = R.createElement mainPageCpt
146

James Laver's avatar
James Laver committed
147 148 149 150 151 152
mainPageCpt :: R.Memo ()
mainPageCpt = R.memo (here.component "mainPage" cpt) where
  cpt _ children =
    pure $ H.div { className: "col-md-10" }
      [ H.div {id: "page-wrapper"}
        [ H.div { className: "container-fluid" } children ]]