Forest.purs 4.28 KB
Newer Older
James Laver's avatar
James Laver committed
1
module Gargantext.Components.Forest
2 3 4
  ( forest
  , forestLayout
  , Common
5
  , Props
James Laver's avatar
James Laver committed
6
  ) where
7

8 9
import Gargantext.Prelude

10
import Data.Array as A
11
import Data.Maybe (Maybe)
12
import Gargantext.AsyncTasks as GAT
13
import Gargantext.Components.Forest.Tree (treeLoader)
James Laver's avatar
James Laver committed
14
import Gargantext.Ends (Frontends, Backend)
15
import Gargantext.Routes (AppRoute)
16
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
17
import Gargantext.Types (Handed, switchHanded)
18
import Gargantext.Utils.Reactix as R2
James Laver's avatar
James Laver committed
19
import Gargantext.Utils.Toestand as T2
20 21 22 23
import Reactix as R
import Reactix.DOM.HTML as H
import Record.Extra as RX
import Toestand as T
James Laver's avatar
James Laver committed
24 25 26 27

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

28 29
-- Shared by components here with Tree
type Common = 
30 31 32 33 34
  ( frontends      :: Frontends
  , handed         :: T.Box Handed
  , reloadMainPage :: T2.ReloadS
  , reloadRoot     :: T2.ReloadS
  , route          :: T.Box AppRoute
35 36
  )

37
type Props =
38 39 40 41 42 43 44
  ( backend            :: T.Box (Maybe Backend)
  , forestOpen         :: T.Box OpenNodes
  , reloadForest       :: T2.ReloadS
  , sessions           :: T.Box Sessions
  , showLogin          :: T.Box Boolean
  , showTree           :: T.Box Boolean
  , tasks              :: T.Box GAT.Storage
45
  | Common 
46
  )
47

48
type TreeExtra = (
49
    forestOpen :: T.Box OpenNodes
50
  )
51

52 53
forest :: R2.Component Props
forest = R.createElement forestCpt
54
forestCpt :: R.Component Props
James Laver's avatar
James Laver committed
55
forestCpt = here.component "forest" cpt where
56 57 58 59 60
  cpt props@{ backend
            , forestOpen
            , frontends
            , handed
            , reloadForest
61
            , reloadMainPage
62 63 64 65
            , reloadRoot
            , route
            , sessions
            , showLogin
66
            , showTree
67
            , tasks } _ = do
68 69 70 71
    -- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
    -- tasks'        <- GAT.useTasks reloadRoot reloadForest
    -- R.useEffect' $ do
    --   T.write_ (Just tasks') tasks
James Laver's avatar
James Laver committed
72
    handed'       <- T.useLive T.unequal handed
73 74
    sessions'     <- T.useLive T.unequal sessions
    -- forestOpen'   <- T.useLive T.unequal forestOpen
75
    -- reloadRoot'   <- T.useLive T.unequal reloadRoot
76
    -- route'        <- T.useLive T.unequal route
77

78 79
    showTree' <- T.useLive T.unequal showTree

James Laver's avatar
James Laver committed
80
    -- TODO If `reloadForest` is set, `reload` state should be updated
81
    -- TODO fix tasks ref
82
    pure $ H.div { className: "forest " <> if showTree' then "" else "d-none" }
83
      (A.cons (plus { handed, showLogin }) (trees handed' sessions'))
84 85 86 87 88 89 90 91 92 93 94 95 96 97
    where
      common = RX.pick props :: Record Common
      trees handed' sessions' = (tree handed') <$> unSessions sessions'
      tree handed' s@(Session {treeId}) =
        treeLoader { forestOpen
                   , frontends
                   , handed: handed'
                   , reload: reloadForest
                   , reloadMainPage
                   , reloadRoot
                   , root: treeId
                   , route
                   , session: s
                   , tasks } []
98

99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
type Plus =
  ( handed    :: T.Box Handed
  , showLogin :: T.Box Boolean )

plus :: R2.Leaf Plus
plus p = R.createElement plusCpt p []
plusCpt :: R.Component Plus
plusCpt = here.component "plus" cpt where
  cpt { handed, showLogin } _ = do
    handed' <- T.useLive T.unequal handed

    pure $ H.div { className: "row" }
      [ H.button { className: buttonClass handed'
                , on: { click }
                , title }
          [ H.div { className: divClass } [ H.text " Log in/out " ] -- fa-lg
          , H.div {} [ H.text "    " ] ]
      ]
117 118
  --, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
  --, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
119 120
  -- TODO same as the one in the Login Modal (same CSS)
  -- [ H.i { className: "material-icons md-36"} [] ]
121 122 123 124 125 126 127 128
    where
      click _ = do
        -- _ <- T.write Nothing backend
        T.write_ true showLogin
      title = "Add or remove connections to the server(s)."
      divClass = "fa fa-universal-access"
      buttonClass handed' =
        "btn btn-primary col-5 " <> switchHanded "mr-1 ml-auto" "ml-1 mr-auto" handed'
129

130
forestLayout :: R2.Component Props
131
forestLayout = R.createElement forestLayoutCpt
132
forestLayoutCpt :: R.Component Props
James Laver's avatar
James Laver committed
133
forestLayoutCpt = here.component "forestLayout" cpt where
134 135 136
  cpt p _ = do
    pure $ H.div { className: "forest-layout" }
      [ forest p [] ]