Skip to content

P
purescript-gargantext
Commit 4c51907c authored by James Laver's avatar James Laver
Browse files
Options

Refactor layout

parent 4f479973
Hide whitespace changes
Inline Side-by-side
Showing with 345 additions and 668 deletions
src/Gargantext/Components/Layout.purs 0 → 100644
View file @ 4c51907c
module Gargantext.Components.Layout where
import Data.Foldable (fold, intercalate)
import Data.Lens (over)
import Data.Maybe (Maybe(..), maybe')
import Data.Map as Map
import Data.Newtype (unwrap)
import Data.Tuple (fst, snd)
import Data.Tuple.Nested((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff)
import React.DOM (button, div, text)
import React.DOM.Props (_id, className, onClick, role, style)
import Reactix as R
import Reactix.DOM.HTML as H
-- import Unsafe.Coerce (unsafeCoerce)
import Gargantext.BootstrapNative (createDropdown)
import Gargantext.Prelude
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.EndsChooser as EndsChooser
import Gargantext.Components.EndsSummary (endsSummary)
import Gargantext.Components.Login.Types (AuthData(..))
import Gargantext.Components.Login (Auths, getCurrentAuth, setAuths, login)
import Gargantext.Components.Search.SearchBar as SB
import Gargantext.Components.Tree as Tree
import Gargantext.Config (Ends, defaultEnds, backendKey)
import Gargantext.Components.Folder (folder)
import Gargantext.Pages.Annuaire (annuaireLayout)
import Gargantext.Pages.Annuaire.User.Contacts (userLayout)
import Gargantext.Pages.Corpus (corpusLayout)
import Gargantext.Pages.Corpus.Document (documentLayout)
import Gargantext.Pages.Corpus.Dashboard (dashboardLayout)
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Lists (listsLayout)
import Gargantext.Pages.Texts (textsLayout)
import Gargantext.Pages.Home (layoutLanding)
import Gargantext.Router (Routes(..), routing, useHashRouter)
import Gargantext.Utils.Reactix as R2
import Gargantext.Global (Global, defaultGlobal)
-- TODO
-- rewrite layoutSpec to use state (with EndConfig)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
type State =
( ends :: R.State Ends
, auths :: R.State Auths
, route :: R.State Routes
, showLogin :: R.State Boolean
, showCorpus :: R.State Boolean
, showTree :: R.State Boolean
, graphExplorer :: R.State GE.State )
layout :: _ -> R.Element
layout _ = R.createElement layoutCpt {} []
layoutCpt :: R.Component ( )
layoutCpt = R.hooksComponent "Layout" cpt
where
cpt _ _ = do
state <- usePagesState
pure $ pages state
pages :: Record State -> R.Element
pages props = R.createElement pagesCpt props []
pagesCpt :: R.Component State
pagesCpt = R.staticComponent "Pages" cpt
where
cpt state@{ends, route, showLogin, showCorpus, graphExplorer, showTree} _ = do
case (fst route) of
Home -> tree $ layoutLanding EN
Login -> login { ends: (fst ends), setVisible: (snd showLogin) }
Folder _ -> tree $ folder {}
Corpus nodeId -> tree $ corpusLayout {nodeId, ends: fst ends}
CorpusDocument corpusId listId nodeId ->
tree $ documentLayout { nodeId, listId, corpusId: Just corpusId, ends: fst ends }
Document listId nodeId ->
tree $ documentLayout { nodeId, listId, corpusId: Nothing, ends: fst ends }
PGraphExplorer i -> R.fragment [] -- simpleLayout state $
Texts nodeId -> tree $ textsLayout {nodeId, ends: fst ends}
Lists nodeId -> tree $ listsLayout {nodeId, ends: fst ends}
Dashboard -> tree $ dashboardLayout {}
Annuaire annuaireId -> tree $ annuaireLayout { annuaireId, ends: fst ends }
UserPage nodeId -> tree $ userLayout { nodeId, ends: fst ends }
ContactPage nodeId -> tree $ userLayout { nodeId, ends: fst ends }
where
tree = treeLayout state
-- routePage (PGraphExplorer i)= layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld
usePagesState :: R.Hooks (Record State)
usePagesState = do
ends <- R.useState' defaultEnds
auths <- R.useState' Map.empty
route <- useHashRouter routing Home
showLogin <- R.useState' false
showCorpus <- R.useState' false
graphExplorer <- R.useState' GE.initialState
showTree <- R.useState' false
pure $ {ends, auths, route, showLogin, showCorpus, graphExplorer, showTree}
treeLayout :: Record State -> R.Element -> R.Element
treeLayout state@{ends, auths, route, showTree} child =
R.fragment [ searchBar state, row layout', footer {} ]
where
backendAuth = getCurrentAuth (fst ends) (fst auths)
layout' = maybe' (\_ -> mainPage false child) (withTree <<< unwrap) backendAuth
withTree {tree_id} =
R.fragment
[ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ Tree.treeView { root: tree_id, mCurrentRoute: Just (fst route), ends: (fst ends) } ]
, mainPage true child ]
row child' = H.div {className: "row"} [child']
-- Simple layout does not accommodate the tree
simpleLayout :: Record State -> R.Element -> R.Element
simpleLayout state child = R.fragment [ searchBar state, child, footer {}]
mainPage :: Boolean -> R.Element -> R.Element
mainPage showTree child =
H.div {className}
[ H.div {id: "page-wrapper"}
[ H.div {className: "container-fluid"} [ child ] ] ]
where
className
| showTree = "col-md-10"
| otherwise = "col-md-12"
searchBar :: Record State -> R.Element
searchBar state@{ends} =
H.div { id: "dafixedtop", role: "navigation"
, className: "navbar navbar-inverse navbar-fixed-top" }
[ H.div { className: "container-fluid" }
[ H.div { className: "navbar-inner" }
[ logo
, H.div { className: "collapse navbar-collapse" }
[ divDropdownLeft
, SB.searchBar (SB.defaultProps (fst ends))
, divDropdownRight state ] ] ] ]
logo :: R.Element
logo =
H.a { className, href: "#/" }
[ H.img { src, title, width: "30", height: "28" } ]
where
className = "navbar-brand logoSmall"
src = "images/logoSmall.png"
title = "Back to home."
divDropdownLeft :: R.Element
divDropdownLeft =
divDropdownLeft' $
LiNav { title : "About Gargantext"
, href : "#"
, icon : "glyphicon glyphicon-info-sign"
, text : "Info" }
divDropdownLeft' :: LiNav -> R.Element
divDropdownLeft' mb =
H.ul {className: "nav navbar-nav"}
[ H.ul {className: "nav navbar-nav pull-left"}
[ H.li {className: "dropdown"} [ menuButton mb, menuElements' ] ] ]
menuButton :: LiNav -> R.Element
menuButton (LiNav { title, href, icon, text } ) =
H.a { className: "dropdown-toggle navbar-text"
, data: {toggle: "dropdown"}
, href, title
, role: "button" }
[ H.span { aria: {hidden : true}, className: icon } []
, H.text (" " <> text) ]
menuElements' :: R.Element
menuElements' = menuElements-- title, icon, text
[ -- ===========================================================
[ LiNav { title : "Quick start, tutorials and methodology"
, href : "https://iscpif.fr/gargantext/your-first-map/"
, icon : "glyphicon glyphicon-book"
, text : "Documentation"
}
, LiNav { title : "Report bug here"
, href : "https://www.iscpif.fr/gargantext/feedback-and-bug-reports/"
, icon : "glyphicon glyphicon-bullhorn"
, text : "Feedback"
}
]
, -----------------------------------------------------------
[ LiNav { title : "Interactive chat"
, href : "https://chat.iscpif.fr/channel/gargantext"
, icon : "fab fa-rocketchat"
, text : "Chat"
}
, LiNav { title : "Asynchronous discussions"
, href : "https://discourse.iscpif.fr/c/gargantext"
, icon : "fab fa-discourse"
, text : "Forum"
}
]
,------------------------------------------------------------
[ LiNav { title : "More about us (you)"
, href : "https://iscpif.fr"
, icon : "glyphicon glyphicon-question-sign"
, text : "About"
}
]
] -- ===========================================================
-- | Menu in the sidebar, syntactic sugar
menuElements :: Array (Array LiNav) -> R.Element
menuElements ns = dropDown $ intercalate divider $ map (map liNav) ns
where
dropDown :: Array R.Element -> R.Element
dropDown = H.ul {className: "dropdown-menu"}
divider :: Array R.Element
divider = [H.li {className: "divider"} []]
-- | surgar for target : "blank"
--data LiNav_ = LiNav_ { title :: String
-- , href :: String
-- , icon :: String
-- , text :: String
-- , target :: String
-- }
data LiNav = LiNav { title :: String
, href :: String
, icon :: String
, text :: String
}
liNav :: LiNav -> R.Element
liNav (LiNav { title : title'
, href : href'
, icon : icon'
, text : text'
}
) = H.li {} [ H.a { tabIndex: (-1)
, target: "blank"
, title: title'
, href: href'
} [ H.span { className: icon' } []
, H.text $ " " <> text'
]
]
loginLinks :: Record State -> R.Element
loginLinks state@{ends, auths, showLogin} =
case getCurrentAuth (fst ends) (fst auths) of
Nothing -> loginLink
Just _ -> logoutLink
where
loginLink =
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-in"
, on: {click: \e -> (snd showLogin) (const true)}
, style: {color:"white"}
, title: "Log in and save your time"
-- TODO hover: bold
}
[H.text " Login / Signup"]
-- TODO dropdown to logout
logoutLink =
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-out"
, on: {click: \e -> logout state}
, style: {color:"white"}
, title: "Log out" -- TODO
-- TODO hover: bold
}
[H.text " Logout"]
logout :: Record State -> Effect Unit
logout {ends, auths} = (snd auths) (const auths2) *> setAuths auths2
where
key = backendKey (fst ends).backend
auths2 = Map.delete key (fst auths)
divDropdownRight :: Record State -> R.Element
divDropdownRight props = R.createElement divDropdownRightCpt props []
divDropdownRightCpt :: R.Component State
divDropdownRightCpt = R.staticComponent "G.C.Layout.divDropdownRight" cpt
where
cpt state@{ends} _ =
H.ul {className: "nav navbar-nav pull-right"}
[ endsSummary (fst ends), loginLinks state ]
footer :: {} -> R.Element
footer props = R.createElement footerCpt props []
footerCpt :: R.Component ()
footerCpt = R.staticComponent "G.C.Layout.footer" cpt
where
cpt _ _ =
H.div { className: "container" }
[ H.hr {}
, H.footer {}
[ H.p {}
[ H.text "Gargantext "
, H.span {className: "glyphicon glyphicon-registration-mark"} []
, H.text ", version 4.0"
, H.a { href: "http://www.cnrs.fr"
, target: "blank"
, title: "Project hosted by CNRS."
}
[ H.text ", Copyrights "
, H.span { className: "glyphicon glyphicon-copyright-mark" } []
, H.text " CNRS 2017-Present"
]
, H.a { href: "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE"
, target: "blank"
, title: "Legal instructions of the project."
}
[ H.text ", Licences aGPLV3 and CECILL variant Affero compliant" ]
, H.text "."
]]
]
src/Gargantext/Pages/Layout/Specs/SearchBar.purs → src/Gargantext/Components/Search/SearchBar.purs
View file @ 4c51907c
module Gargantext.Pages.Layout.Specs.SearchBar
( Props, defaultProps, searchBar, searchBarComponent
module Gargantext.Components.Search.SearchBar
( Props, defaultProps, searchBar, searchBarCpt
) where
import Prelude
import Control.Monad.Cont.Trans (lift)
import Prelude (Unit, bind, const, discard, not, pure, show, ($), (<>))
import Data.Maybe (Maybe(..))
import Data.Newtype (over)
import Data.Traversable (traverse_)
import Data.Tuple (fst)
import Data.Tuple.Nested ( (/\) )
import Effect.Class (liftEffect)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import Reactix as R
import DOM.Simple.Console
import Effect.Aff (launchAff)
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff)
import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types
import Gargantext.Components.Search.Ajax as Ajax
import Gargantext.Config (Ends)
import Gargantext.Components.Search.Types (Database, SearchQuery(..), allDatabases, defaultSearchQuery, performSearch)
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Utils (id)
type Props = ( open :: Boolean, databases :: Array Database )
type Props = ( ends :: Ends, open :: Boolean, databases :: Array Database )
defaultProps :: Record Props
defaultProps = { open: false, databases: allDatabases }
defaultProps :: Ends -> Record Props
defaultProps ends = { open: false, databases: allDatabases, ends }
searchBar :: Record Props -> R.Element
searchBar p = R.createElement searchBarComponent p []
searchBar p = R.createElement searchBarCpt p []
searchBarComponent :: R.Component Props
searchBarComponent = R.hooksComponent "SearchBar" cpt
searchBarCpt :: R.Component Props
searchBarCpt = R.hooksComponent "SearchBar" cpt
where
cpt props _ = do
open <- R.useState $ const props.open
cpt {ends, databases, open} _ = do
open' <- R.useState $ const open
search <- R.useState $ const Nothing
onSearchChange search
onSearchChange ends search
pure $ H.div { className: "search-bar-container" }
[ toggleButton open
, searchFieldContainer open props.databases search ]
[ toggleButton open'
, searchFieldContainer open' databases search ]
searchFieldContainer :: R.State Boolean -> Array Database -> R.State (Maybe Search) -> R.Element
searchFieldContainer (open /\ _) databases search =
......@@ -46,15 +43,15 @@ searchFieldContainer (open /\ _) databases search =
where
openClass = if open then "open" else "closed"
onSearchChange :: R.State (Maybe Search) -> R.Hooks Unit
onSearchChange (search /\ setSearch) =
onSearchChange :: Ends -> R.State (Maybe Search) -> R.Hooks Unit
onSearchChange ends (search /\ setSearch) =
R.useLayoutEffect1' search $ traverse_ triggerSearch search
where
triggerSearch q = do
launchAff $ do
liftEffect $ log2 "Searching db: " $ show q.database
liftEffect $ log2 "Searching term: " q.term
(r :: Unit) <- Ajax.search (searchQuery q)
r <- (performSearch ends $ searchQuery q) :: Aff Unit
liftEffect $ log2 "Return:" r
liftEffect $ modalShow "addCorpus"
searchQuery {database: Nothing, term} = over SearchQuery (_ {query=term}) defaultSearchQuery
......@@ -63,9 +60,8 @@ onSearchChange (search /\ setSearch) =
toggleButton :: R.State Boolean -> R.Element
toggleButton open =
H.button { onClick: onToggleExpanded open, className: "search-bar-toggle" }
[ H.i { className: "material-icons md-24"
, style: { marginTop: "-2px", color: "#000" } }
[ H.text "control_point" ] ]
[ H.i { className: "material-icons md-24", style } [ H.text "control_point" ] ]
where style = { marginTop: "-2px", color: "#000" }
onToggleExpanded :: forall e. R.State Boolean -> EffectFn1 e Unit
onToggleExpanded (_open /\ setOpen) = mkEffectFn1 $ \_ -> setOpen not
src/Gargantext/Pages/Layout.purs deleted 100644 → 0
View file @ 4f479973
module Gargantext.Pages.Layout where
import Prelude hiding (div)
import Gargantext.Pages.Layout.Actions (Action(..))
import Gargantext.Router (Routes(..))
dispatchAction :: forall ignored m.
Monad m =>
(Action -> m Unit) -> ignored -> Routes -> m Unit
dispatchAction dispatcher _ Home = do
dispatcher $ SetRoute Home
-- dispatcher $ LandingA TODO
dispatchAction dispatcher _ Login = do
dispatcher $ SetRoute Login
-- dispatcher $ LoginA TODO
dispatchAction dispatcher _ (Corpus n) = do
dispatcher $ SetRoute $ Corpus n
dispatchAction dispatcher _ (UserPage id) = do
dispatcher $ SetRoute $ UserPage id
dispatchAction dispatcher _ (ContactPage id) = do
dispatcher $ SetRoute $ ContactPage id
dispatchAction dispatcher _ (Annuaire id) = do
dispatcher $ SetRoute $ Annuaire id
dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id
dispatchAction dispatcher _ (CorpusDocument c i n) = do
dispatcher $ SetRoute $ CorpusDocument c i n
dispatchAction dispatcher _ (Document i n) = do
dispatcher $ SetRoute $ Document i n
dispatchAction dispatcher _ (PGraphExplorer nid) = do
dispatcher $ SetRoute $ PGraphExplorer nid
-- dispatcher $ GraphExplorerA $ GE.LoadGraph nid
--dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
dispatchAction dispatcher _ (Texts nid) = do
dispatcher $ SetRoute $ Texts nid
dispatchAction dispatcher _ (Lists nid) = do
dispatcher $ SetRoute $ Lists nid
dispatchAction dispatcher _ Dashboard = do
dispatcher $ SetRoute Dashboard
src/Gargantext/Pages/Layout/Actions.purs deleted 100644 → 0
View file @ 4f479973
-- | Module Description
module Gargantext.Pages.Layout.Actions where
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Lens (Prism', prism)
import Effect.Class (liftEffect)
import Thermite (PerformAction, modifyState, modifyState_)
import Routing.Hash (setHash)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Config as C
import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Prelude
import Gargantext.Router (Routes)
------------------------------------------------------------------------
data Action
= LoginA LN.Action
| SetRoute Routes
| GraphExplorerA GET.Action
| AnnuaireAction Annuaire.Action
| ShowLogin
| Logout
| ShowAddCorpus
| ToggleTree
| ConfigStateA C.StateAction
performAction :: PerformAction AppState {} Action
performAction (SetRoute route) _ _ = void do
modifyState $ _ {currentRoute = pure route}
performAction (ToggleTree) _ (state) = void do -- TODO
modifyState $ _ {showTree = not (state.showTree)}
performAction ShowLogin _ _ = void do
liftEffect $ modalShow "loginModal"
modifyState $ _ {showLogin = true}
performAction Logout _ _ = do
loginState <- liftEffect do
LN.setAuthData Nothing
setHash "/"
LN.initialState
modifyState_ $ _ {currentRoute = Nothing, loginState = loginState}
---------------------------------------------------------
-- TODO chose one of them
performAction ShowAddCorpus _ _ = void do
liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true}
---------------------------------------------------------
performAction (LoginA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit
-- liftEffect $ modalShow "addCorpus"
-- modifyState $ _ {showCorpus = true}
performAction (ConfigStateA _) _ _ = pure unit
----------------------------------------------------------
_loginAction :: Prism' Action LN.Action
_loginAction = prism LoginA \action ->
case action of
LoginA caction -> Right caction
_-> Left action
_configStateAction :: Prism' Action C.StateAction
_configStateAction = prism ConfigStateA \action ->
case action of
ConfigStateA caction -> Right caction
_-> Left action
_annuaireAction :: Prism' Action Annuaire.Action
_annuaireAction = prism AnnuaireAction \action ->
case action of
AnnuaireAction a -> Right a
_ -> Left action
_graphExplorerAction :: Prism' Action GET.Action
_graphExplorerAction = prism GraphExplorerA \action ->
case action of
GraphExplorerA caction -> Right caction
_-> Left action
src/Gargantext/Pages/Layout/Specs.purs deleted 100644 → 0
View file @ 4f479973
module Gargantext.Pages.Layout.Specs where
import Data.Foldable (fold, intercalate)
import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just))
import Data.Tuple.Nested((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff)
import React.DOM (button, div, text)
import React.DOM.Props (_id, className, onClick, role, style)
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState, cmapProps)
-- import Unsafe.Coerce (unsafeCoerce)
import Gargantext.BootstrapNative (createDropdown)
import Gargantext.Prelude
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.GraphExplorer as GE
import Gargantext.Components.Login.Types (AuthData(..))
import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
import Gargantext.Config as C
import Gargantext.Folder as F
import Gargantext.Pages.Annuaire as A
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Document as Annotation
import Gargantext.Pages.Corpus.Dashboard as Dsh
import Gargantext.Pages.Lists as Lists
import Gargantext.Pages.Texts as Texts
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _graphExplorerAction, _loginAction, performAction, _configStateAction)
import Gargantext.Pages.Layout.Specs.SearchBar as SB
import Gargantext.Pages.Layout.States (AppState, _graphExplorerState, _loginState, _configState)
import Gargantext.Router (Routes(..))
import Gargantext.Utils.Reactix as R2
-- TODO
-- rewrite layoutSpec to use state (with EndConfig)
-- tree changes endConfig state => trigger endConfig change in outerLayout, layoutFooter etc
layoutSpec :: Spec AppState {} Action
layoutSpec =
fold
[ routingSpec
, container $ withState pagesComponent
, withState \st ->
fold [ focus _loginState _loginAction (LN.modalSpec st.showLogin "Login" LN.renderSpec)
]
]
where
-- NP: what is it for ?
container :: Spec AppState {} Action -> Spec AppState {} Action
container = over _render \render d p s c ->
(render d p s c)
pagesComponent :: AppState -> Spec AppState {} Action
pagesComponent s = case s.currentRoute of
Just route -> selectSpec route
Nothing -> selectSpec Home -- TODO add Error page here: url requested does not exist (with funny Garg image)
where
selectSpec :: Routes -> Spec AppState {} Action
selectSpec Home = layout0 $ noState $ L.layoutLanding EN
selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec (Folder i) = layout0 $ noState F.layoutFolder
selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
selectSpec (CorpusDocument c l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Just c}) $ noState Annotation.layout
selectSpec (Document l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Nothing}) $ noState Annotation.layout
selectSpec (PGraphExplorer i) = graphSpec i
selectSpec (Texts i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Texts.layout
selectSpec (Lists i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Lists.layout
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout
selectSpec (UserPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser
selectSpec (ContactPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser
graphSpec i = layout1 $ withState \st ->
cmapProps (const {
graphId: i
, graph: Nothing
, mCurrentRoute: st.currentRoute
, treeId: case st.loginState.authData of
Nothing -> Nothing
Just (AuthData ad) -> Just ad.tree_id
}) $ focus _graphExplorerState _graphExplorerAction $ GE.spec
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender
routingSpec :: Spec AppState {} Action
routingSpec = simpleSpec performAction defaultRender
layout0 :: Spec AppState {} Action
-> Spec AppState {} Action
layout0 layout =
fold
[ searchBar
, outerLayout
, noState layoutFooter
]
where
outerLayout1 = simpleSpec defaultPerformAction defaultRender
outerLayout :: Spec AppState {} Action
outerLayout =
cont $ fold
[ -- over _render \render d p s c -> [logLinks d s] ,
withState \st ->
case st.loginState.authData of
Just (AuthData {tree_id}) ->
ls $ cmapProps (const {root: tree_id, mCurrentRoute: st.currentRoute}) $ noState $ Tree.treeview
ls $ cmapProps (const {root: tree_id, mCurrentRoute: st.currentRoute}) $ Tree.treeview
Nothing ->
outerLayout1
, rs bs
]
ls = over _render \render d p s c -> [
div [ className "col-md-2", style {paddingTop: "60px"} ] $ render d p s c
]
rs = over _render \render d p s c -> [
div [ case (s.loginState.authData) of
Just a ->
className "col-md-10"
Nothing ->
className "col-md-12"
] (render d p s c) ]
cont = over _render \render d p s c -> [ div [className "row" ] (render d p s c) ]
--as = noState Tree.treeview
bs = innerLayout $ layout
innerLayout :: Spec AppState {} Action
-> Spec AppState {} Action
innerLayout = over _render \render d p s c ->
[ div [_id "page-wrapper"]
[
div [className "container-fluid"] (render d p s c)
]
]
-- TODO avoid code duplication with layout0
layout1 :: Spec AppState {} Action
-> Spec AppState {} Action
layout1 layout =
fold
[ searchBar
, layout
-- , outerLayout
, noState layoutFooter
]
where
outerLayout1 = simpleSpec defaultPerformAction defaultRender
outerLayout :: Spec AppState {} Action
outerLayout =
cont $ fold
[ withState \st ->
case st.loginState.authData of
Just (AuthData {tree_id}) ->
ls $ cmapProps (const {root: tree_id, mCurrentRoute: st.currentRoute, endConfig: st.configState.endConfig}) $ noState $ Tree.treeview
Nothing ->
outerLayout1
, rs bs
]
ls = over _render \render d p s c -> [
button [onClick $ \e -> d ToggleTree, className "btn btn-primary",style {position:"relative", top: "99px",left:"-264px",zIndex : "1000"}] [text "ShowTree"]
, div [if (s.showTree) then className "col-md-2" else className "col-md-2"] if (s.showTree) then (render d p s c) else []
]
rs = over _render \render d p s c -> [ div [if (s.showTree) then className "col-md-10" else className "col-md-12"] (render d p s c) ]
cont = over _render \render d p s c -> [ div [className "row" ] (render d p s c) ]
bs = innerLayout $ layout
innerLayout :: Spec AppState {} Action
-> Spec AppState {} Action
innerLayout = over _render \render d p s c ->
[ div [_id "page-wrapper"]
[
div [className "container-fluid"] (render d p s c)
]
]
searchBar :: Spec AppState {} Action
searchBar = simpleSpec defaultPerformAction render
where
render d p s c =
[ div [ _id "dafixedtop"
, className "navbar navbar-inverse navbar-fixed-top"
, role "navigation"
] [ div [className "container-fluid"
]
[ div [ className "navbar-inner" ]
[ R2.scuff divLogo
, div [ className "collapse navbar-collapse"
]
$ [ R2.scuff divDropdownLeft ]
<> [ R2.scuff (SB.searchBar SB.defaultProps) ]
<> [ R2.scuff $ divDropdownRight d s ]
]
]
]
]
divLogo :: R.Element
divLogo = H.a { className: "navbar-brand logoSmall"
, href: "#/"
} [ H.img { src: "images/logoSmall.png"
, title: "Back to home."
, width: "30"
, height: "28"
}
]
divDropdownLeft :: R.Element
divDropdownLeft = divDropdownLeft' (LiNav { title : "About Gargantext"
, href : "#"
, icon : "glyphicon glyphicon-info-sign"
, text : "Info"
}
)
divDropdownLeft' :: LiNav -> R.Element
divDropdownLeft' mb = H.ul {className: "nav navbar-nav"}
[ H.ul {className: "nav navbar-nav pull-left"}
[ H.li {className: "dropdown"}
[ menuButton mb
, menuElements'
]
]
]
menuButton :: LiNav -> R.Element
menuButton (LiNav { title : title'
, href : href'
, icon : icon'
, text : text'
}) = H.a { className: "dropdown-toggle navbar-text"
, data: {toggle: "dropdown"}
, href: href'
, role: "button"
, title: title'
} [ H.span { aria: {hidden : true}
, className: icon'
} []
, H.text (" " <> text')
]
menuElements' :: R.Element
menuElements' = menuElements-- title, icon, text
[ -- ===========================================================
[ LiNav { title : "Quick start, tutorials and methodology"
, href : "https://iscpif.fr/gargantext/your-first-map/"
, icon : "glyphicon glyphicon-book"
, text : "Documentation"
}
, LiNav { title : "Report bug here"
, href : "https://www.iscpif.fr/gargantext/feedback-and-bug-reports/"
, icon : "glyphicon glyphicon-bullhorn"
, text : "Feedback"
}
]
, -----------------------------------------------------------
[ LiNav { title : "Interactive chat"
, href : "https://chat.iscpif.fr/channel/gargantext"
, icon : "fab fa-rocketchat"
, text : "Chat"
}
, LiNav { title : "Asynchronous discussions"
, href : "https://discourse.iscpif.fr/c/gargantext"
, icon : "fab fa-discourse"
, text : "Forum"
}
]
,------------------------------------------------------------
[ LiNav { title : "More about us (you)"
, href : "https://iscpif.fr"
, icon : "glyphicon glyphicon-question-sign"
, text : "About"
}
]
] -- ===========================================================
-- | Menu in the sidebar, syntactic sugar
menuElements :: Array (Array LiNav) -> R.Element
menuElements ns = dropDown $ intercalate divider $ map (map liNav) ns
where
dropDown :: Array R.Element -> R.Element
dropDown = H.ul {className: "dropdown-menu"}
divider :: Array R.Element
divider = [H.li {className: "divider"} []]
-- | surgar for target : "blank"
--data LiNav_ = LiNav_ { title :: String
-- , href :: String
-- , icon :: String
-- , text :: String
-- , target :: String
-- }
data LiNav = LiNav { title :: String
, href :: String
, icon :: String
, text :: String
}
liNav :: LiNav -> R.Element
liNav (LiNav { title : title'
, href : href'
, icon : icon'
, text : text'
}
) = H.li {} [ H.a { tabIndex: (-1)
, target: "blank"
, title: title'
, href: href'
} [ H.span { className: icon' } []
, H.text $ " " <> text'
]
]
logLinks :: (Action -> Effect Unit) -> AppState -> R.Element
logLinks d s = case s.loginState.authData of
Nothing -> loginLink
Just _ -> logoutLink
where
loginLink =
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-in"
, on: {click: \e -> d ShowLogin}
, style: {color:"white"}
, title: "Log in and save your time"
-- TODO hover: bold
}
[H.text " Login / Signup"]
-- TODO dropdown to logout
logoutLink =
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-out"
, on: {click: \e -> d Logout}
, style: {color:"white"}
, title: "Log out" -- TODO
-- TODO hover: bold
}
[H.text " Logout"]
divDropdownRight :: (Action -> Effect Unit) -> AppState -> R.Element
divDropdownRight d s = R.createElement el {state: s} []
where
el = R.hooksComponent "DivDropdownRight" cpt
cpt {state} _children = do
(configState /\ setConfigState) <- R.useState' state.configState
pure $ H.ul {className: "nav navbar-nav pull-right"}
[ endConfigChooserCpt d state.configState (configState /\ setConfigState)
, logLinks d state
]
endConfigChooserCpt d s (configState /\ setConfigState) = R.createElement el {state: s} []
where
el = R.hooksComponent "EndConfigChooserCpt" cpt
cpt {state} _children = do
R.useEffect $ pure $
if (configState /= state) then do
_ <- log2 "update state: " configState
_ <- d $ ConfigStateA $ C.UpdateState configState
_ <- log2 "logout" ""
d $ Logout
else
pure $ unit
pure $ H.span {}
[ endConfigChooser (configState /\ setConfigState)
, H.span {className: "text-info"}
[ H.text $ C.endConfigDisplayName configState.endConfig ]
, H.span {className: "text-danger"}
[ H.text $ C.endConfigDisplayName state.endConfig ]
]
endConfigChooser :: R.State C.State -> R.Element
endConfigChooser (configState /\ setConfigState) = R.createElement el {} []
where
el = R.hooksComponent "EndConfigChooser" cpt
cpt {} _ = do
-- NOTE Need to rebind the component after rerender
R.useEffect do
_ <- pure $ createDropdown "end-config-chooser"
pure $ pure unit
pure $ H.li {className: "dropdown"}
[ H.a { className: "navbar-text dropdown-toggle"
, href: "#"
, role: "button"
, data: {toggle: "dropdown"}
, id: "end-config-chooser"
}
[ H.text $ C.endConfigDisplayName configState.endConfig ]
, H.ul { className: "dropdown-menu"
} (liItem <$> C.endConfigOptions)
]
liItem :: C.EndConfigOption -> R.Element
liItem {endConfig, displayName} =
H.li {on: {click: onClick endConfig}}
[ H.a {href: "#"} [H.text displayName] ]
onClick endConfig = \_ -> do
log2 "set end config" endConfig
setConfigState $ \st -> st {endConfig = endConfig}
layoutFooter :: Spec {} {} Void
layoutFooter = R2.elSpec $ R.hooksComponent "LayoutFooter" cpt
where
cpt {} _children = do
pure $ H.div { className: "container" } [ H.hr {}, footerLegalInfo']
footerLegalInfo' = H.footer {}
[ H.p {} [ H.text "Gargantext "
, H.span {className: "glyphicon glyphicon-registration-mark"} []
, H.text ", version 4.0"
, H.a { href: "http://www.cnrs.fr"
, target: "blank"
, title: "Project hosted by CNRS."
}
[ H.text ", Copyrights "
, H.span { className: "glyphicon glyphicon-copyright-mark" } []
, H.text " CNRS 2017-Present"
]
, H.a { href: "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE"
, target: "blank"
, title: "Legal instructions of the project."
}
[ H.text ", Licences aGPLV3 and CECILL variant Affero compliant" ]
, H.text "."
]
]
src/Gargantext/Pages/Layout/States.purs deleted 100644 → 0
View file @ 4f479973
module Gargantext.Pages.Layout.States where
import Prelude hiding (div)
import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Gargantext.Config as C
import Gargantext.Components.Login as LN
import Gargantext.Components.Login as LN
--import Gargantext.Components.Login.Types as LNT
--import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Router (Routes(..))
type AppState =
{ currentRoute :: Maybe Routes
, loginState :: LN.State
, showLogin :: Boolean
, showCorpus :: Boolean
--, graphExplorerState :: Record GET.StateGlue
, showTree :: Boolean
, configState :: C.State
}
initAppState :: Effect AppState
initAppState = do
loginState <- LN.initialState
pure
{ currentRoute : Just Home
, loginState
, showLogin : false
, showCorpus : false
--, graphExplorerState : GET.initialStateGlue
, showTree : false
, configState : C.initialState
}
---------------------------------------------------------
_loginState :: Lens' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_configState :: Lens' AppState C.State
_configState = lens (\s -> s.configState) (\s ss -> s{configState = ss})
_graphExplorerState :: Lens' AppState GE.State
_graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment