Skip to content

P
purescript-gargantext
Commit 17f48ce1 authored by Abinaya Sudhir's avatar Abinaya Sudhir
Browse files
Options

Added routing and login page

parent 90132f1b
Hide whitespace changes
Inline Side-by-side
Showing with 506 additions and 192 deletions
bower.json
View file @ 17f48ce1
...@@ -9,8 +9,9 @@ ...@@ -9,8 +9,9 @@
"dependencies": { "dependencies": {
"purescript-prelude": "^3.1.0", "purescript-prelude": "^3.1.0",
"purescript-console": "^3.0.0", "purescript-console": "^3.0.0",
"purescript-thermite": "^4.1.1", "purescript-thermite": "^5.0.0",
"purescript-affjax": "^4.0.0" "purescript-affjax": "^5.0.0",
"purescript-routing": "^6.1.2"
}, },
"devDependencies": { "devDependencies": {
"purescript-psci-support": "^3.0.0" "purescript-psci-support": "^3.0.0"
......
dist/css/login.min.css 0 → 100644
View file @ 17f48ce1
This source diff could not be displayed because it is too large. You can view the blob instead.
index.html
View file @ 17f48ce1
...@@ -3,9 +3,11 @@ ...@@ -3,9 +3,11 @@
<head> <head>
<meta charset="utf-8"/> <meta charset="utf-8"/>
<title>CNRS GarganText</title> <title>CNRS GarganText</title>
<link href="https://fonts.googleapis.com/icon?family=Material+Icons" rel="stylesheet">
<link href="./dist/css/bootstrap.css" rel="stylesheet"> <link href="./dist/css/bootstrap.css" rel="stylesheet">
<link rel="stylesheet" type="text/css" href="./dist/css/menu.css"/> <link rel="stylesheet" type="text/css" href="./dist/css/menu.css"/>
<link href="./dist/css/Login.css" rel="stylesheet"> <link href="./dist/css/Login.css" rel="stylesheet">
<link href="./dist/css/login.min.css" rel="stylesheet">
</head> </head>
<body> <body>
<div id="app"></div> <div id="app"></div>
......
src/Landing.purs 0 → 100644
View file @ 17f48ce1
module Landing where
import Control.Monad.Cont.Trans (lift)
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Network.HTTP.Affjax (AJAX)
import Prelude hiding (div)
import React.DOM (a, button, div, footer, h1, h3, hr, i, img, li, p, span, text, ul)
import React.DOM.Props (_data, _id, aria, className, href, onClick, role, src, style, tabIndex, target, title)
import Routing.Hash.Aff (setHash)
import Thermite (PerformAction, Render, Spec, simpleSpec)
import Thermite as T
newtype State = State
{ userName :: String
, password :: String
}
initialState :: State
initialState = State
{userName : ""
, password : ""
}
data Action
= NoOp
| Documentation
| Submit
| SignUp
performAction :: forall eff props. PerformAction (console :: CONSOLE, ajax :: AJAX,dom::DOM | eff) State props Action
performAction NoOp _ _ = void do
T.modifyState \state -> state
performAction Documentation _ _ = void do
T.modifyState \state -> state
performAction Submit _ _ = void do
lift $ setHash "/login"
T.modifyState \state -> state
performAction SignUp _ _ = void do
T.modifyState \state -> state
loginSpec :: forall props eff . Spec (console::CONSOLE, ajax::AJAX, dom::DOM | eff) State props Action
loginSpec = simpleSpec performAction render
where
render :: Render State props Action
render dispatch _ state _ =
[
div [ _id "dafixedtop", className "navbar navbar-inverse navbar-fixed-top", role "navigation"]
[ div [className "container"]
[
div [ className "navbar-inner" ]
[ a [ className "navbar-brand logoSmall", href "/" ]
[ img [ src "dist/images/logoSmall.png", title "Back to home." ]
[]
]
]
, div [className "navbar-collapse collapse"]
[
ul [className "nav navbar-nav"]
[
li [className "dropdown"]
[
a [ className "dropdown-toggle navbar-text", _data {toggle: "dropdown"}, href "#", role "button", title "Informations about Gargantext" ]
[ span [ aria {hidden : true}, className "glyphicon glyphicon-info-sign" ]
[]
, text "Info"
, i [ className "caret" ]
[]
]
]
, ul [className "dropdown-menu"]
[ li []
[ a [tabIndex (-1), target "blank", title "Documentation and tutorials", href "https://iscpif.fr/gargantext/your-first-map/"]
[text "Documentation"]
]
, li [className "divider"] []
, li []
[
a [ tabIndex (-1), target "blank", title "About", href "/about/", title "More informations about the project, its sponsors and its authors"]
[ text "About"]
]
]
]
, ul [className "nav navbar-nav pull-right"]
[
li [className "dropdown"]
[
a [ className "dropdown-toggle navbar-text", _data {toggle : "dropdown"}, href "#", role "button", title "That is your username" ]
[ i [ className "" ]
[]
, span [ aria {hidden : true}, className "glyphicon glyphicon-user", style {color:"white"} ]
[]
, i [ className "caret" ]
[]
]
, ul [className "dropdown-menu"]
[
li []
[ a [tabIndex (-1), target "blank", title "Send us a message (bug, thanks, congrats...)", href "https://www.iscpif.fr/gargantext/feedback-and-bug-reports/"]
[
span [ className "glyphicon glyphicon-bullhorn" ,aria {hidden : true}] []
, text "Report Feedback"
]
]
, li [ className"divider"]
[]
, li []
[ a [tabIndex (-1), href "/auth/login" ]
[ span [className "glyphicon glyphicon-log-in",aria {hidden : true}] []
, text "login"
]
]
]
]
]
]
]
]
, div [className "container"]
[
div [className "jumbotron"]
[
div [className "row"]
[
div [className "col-md-8 content"]
[
h1 []
[ text "Gargantext" ]
, p []
[ text "A web platform to explore text-mining" ]
, p []
[ button [ className "btn btn-primary btn-lg",onClick \_ -> dispatch $ Submit , title "Click and test by yourself" ]
[ span [ className "glyphicon glyphicon-hand-right" ]
[]
, text "Login"
]
, a [ className "btn btn-warning btn-lg", href "https://iscpif.fr/services/applyforourservices/", target "blank", title "Fill the form to sign up" ]
[ span [ aria {hidden : true}, className "glyphicon glyphicon-hand-right" ]
[]
, text "Sign Up"
]
, a [ className "btn btn-success btn-lg", href "https://iscpif.fr/gargantext/your-first-map/", target "blank", title "Fill the form to sign up" ]
[ span [ aria {hidden : true}, className "glyphicon glyphicon-hand-right" ]
[]
, text "Documentation"
]
]
, span [ aria {hidden : true}, className "glyphicon glyphicon-warning-sign" ]
[]
, i []
[ text "Some features may not work without a javascript optimized browser (Chromium for instance). " ]
]
, div [className "col-md-2 content"]
[
p [ className "right" ]
[ div [_id "logo-designed" ]
[ img [ src "dist/images/logo.png", title "Logo designed by dacha and anoe" ]
[]
]
]
]
]
]
]
, div [className "container"]
[ div [className "row"]
[ div [className "col-md-offset-5 col-md-6 content"]
[ img [ src "dist/images/Gargantextuel-212x300.jpg", title "Gargantextuel drawn by Cecile Meadel", _id "funnyimg"] []
]
]
]
, div [ className "container" ]
[ div [ className "row" ]
[ div [ className "col-md-4 content" ]
[ h3 []
[ a [ href "#", title "Random sentences in Gargantua's Books chapters, historically true" ]
[ text "Historic" ]
]
, p []
[ text "Chapter 1.XV. How Gargantua was put under other schoolmasters. Chapter 2.XXII. How Panurge served a Parisian lady a trick that pleased her not very well. Chapter 3.XXXVII. How Pantagruel persuaded Panurge to take counsel of a fool. Chapter 4.LXI. How Gaster invented means to get and preserve corn. Chapter 5.XXXVIII. Of the temple's admirable pavement." ]
]
, div [ className "col-md-4 content" ]
[ h3 []
[ a [ href "#", title "Randomized words, semantically and syntaxically falses." ]
[ text "Presentation" ]
]
, p []
[ text "Autem nascetur iaculis, sedfusce enimsed cursus posuere consectetuer eu justo aliquammauris. Phasellus vero nisi porttitor elit quod, leo feliscras ultricies non tempor sagittis. Liberoduis facilisinam erat dapibusnam, lacus dui duis tristique volutpatut quis vestibulum magna. Nobis faucibusvestibulum dolores minim. Bibendumin malesuada adipiscing ante, mattis fames nequeetiam lorem. No diam id. Litora quisaenean commodo lobortisetiam neque, libero mollis scelerisque inceptos ullamcorper sea congue delenit possim. " ]
]
, div [ className "col-md-4 content" ]
[ h3 []
[ a [ href "#", title "Randomized letters, true or false ?" ]
[ text "Tutoreil" ]
]
, p []
[ text "Il paraît que l'rdore des lettres dans un mot n'a pas d'imtraopnce. La première et la dernière lettre doeivnt être à la bonne place. Le reste peut être dans un désordre total et on peut touojurs lire sans prolèbme. On ne lit donc pas chaque lettre en ellêem-me, mais le mot comme un tout. Un chaegmnent de référentiel et nous tranpossons ce résultat au texte luimê-me: l'rdore des mots est failbement important copamré au contexte du texte qui, lui, est copmté: comptexter avec Gargantext. "
, text " "
, text ""
]
]
]
]
, div [className "container"]
[
hr [] []
, footer []
[ p []
[ text "Gargantext"
, span [className "glyphicon glyphicon-registration-mark" ]
[]
, text ", version 3.0.6.9.4,"
, a [ href "http://www.cnrs.fr", target "blank", title "Institution that enables this project." ]
[ text "Copyrights"
, span [ className "glyphicon glyphicon-copyright-mark" ]
[]
, text "CNRS 2017"
]
, a [ href "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE", target "blank", title "Legal instructions of the project." ]
[ text ", Licences aGPLV3 and CECILL variant Affero compliant" ]
, text "."
]
]
]
]
src/Login.purs
View file @ 17f48ce1
...@@ -4,8 +4,8 @@ import Control.Monad.Eff.Console (CONSOLE) ...@@ -4,8 +4,8 @@ import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM) import DOM (DOM)
import Network.HTTP.Affjax (AJAX) import Network.HTTP.Affjax (AJAX)
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (a, div, footer, h1, h3, hr, i, img, li, p, span, text, ul) import React.DOM (a, button, div, footer, form, h1, h2, h3, h4, hr, i, img, input, li, p, span, text, ul)
import React.DOM.Props (_data, _id, aria, className, href, role, src, style, tabIndex, target, title) import React.DOM.Props (_data, _id, _type, aria, className, href, maxLength, name, placeholder, role, src, style, tabIndex, target, title, value)
import Thermite (PerformAction, Render, Spec, simpleSpec) import Thermite (PerformAction, Render, Spec, simpleSpec)
import Thermite as T import Thermite as T
...@@ -23,216 +23,80 @@ initialState = State ...@@ -23,216 +23,80 @@ initialState = State
data Action data Action
= NoOp = NoOp
| Documentation
| Login | Login
| SignUp
performAction :: forall eff props.PerformAction (console :: CONSOLE, ajax :: AJAX,dom::DOM | eff) State props Action performAction :: forall eff props.PerformAction (console :: CONSOLE, ajax :: AJAX,dom::DOM | eff) State props Action
performAction NoOp _ _ = void do performAction NoOp _ _ = void do
T.modifyState \state -> state T.modifyState \state -> state
performAction Documentation _ _ = void do
T.modifyState \state -> state
performAction Login _ _ = void do performAction Login _ _ = void do
T.modifyState \state -> state T.modifyState \state -> state
performAction SignUp _ _ = void do
T.modifyState \state -> state
renderSpec :: forall props eff . Spec (console::CONSOLE, ajax::AJAX, dom::DOM | eff) State props Action
loginSpec :: forall props eff . Spec (console::CONSOLE, ajax::AJAX, dom::DOM | eff) State props Action renderSpec = simpleSpec performAction render
loginSpec = simpleSpec performAction render
where where
render :: Render State props Action render :: Render State props Action
render dispatch _ state _ = render dispatch _ state _ =
[ [
div [ _id "dafixedtop", className "navbar navbar-inverse navbar-fixed-top", role "navigation"] div [className "row"]
[ div [className "container"]
[
div [ className "navbar-inner" ]
[ a [ className "navbar-brand logoSmall", href "/" ]
[ img [ src "dist/images/logoSmall.png", title "Back to home." ]
[]
]
]
, div [className "navbar-collapse collapse"]
[
ul [className "nav navbar-nav"]
[
li [className "dropdown"]
[
a [ className "dropdown-toggle navbar-text", _data {toggle: "dropdown"}, href "#", role "button", title "Informations about Gargantext" ]
[ span [ aria {hidden : true}, className "glyphicon glyphicon-info-sign" ]
[]
, text "Info"
, i [ className "caret" ]
[]
]
]
, ul [className "dropdown-menu"]
[ li []
[ a [tabIndex (-1), target "blank", title "Documentation and tutorials", href "https://iscpif.fr/gargantext/your-first-map/"]
[text "Documentation"]
]
, li [className "divider"] []
, li []
[
a [ tabIndex (-1), target "blank", title "About", href "/about/", title "More informations about the project, its sponsors and its authors"]
[ text "About"]
]
]
]
, ul [className "nav navbar-nav pull-right"]
[
li [className "dropdown"]
[
a [ className "dropdown-toggle navbar-text", _data {toggle : "dropdown"}, href "#", role "button", title "That is your username" ]
[ i [ className "" ]
[]
, span [ aria {hidden : true}, className "glyphicon glyphicon-user", style {color:"white"} ]
[]
, i [ className "caret" ]
[]
]
, ul [className "dropdown-menu"]
[
li []
[ a [tabIndex (-1), target "blank", title "Send us a message (bug, thanks, congrats...)", href "https://www.iscpif.fr/gargantext/feedback-and-bug-reports/"]
[
span [ className "glyphicon glyphicon-bullhorn" ,aria {hidden : true}] []
, text "Report Feedback"
]
]
, li [ className"divider"]
[]
, li []
[ a [tabIndex (-1), href "/auth/login" ]
[ span [className "glyphicon glyphicon-log-in",aria {hidden : true}] []
, text "login"
]
]
]
]
]
]
]
]
, div [className "container"]
[ [
div [className "jumbotron"] div [className "col-sm-10 col-sm-push-1 col-md-6 col-md-push-3 col-lg-6 col-lg-push-3"]
[ [
div [className "row"] h2 [className "text-primary center m-a-2"]
[ i [className "material-icons md-36"] [text "control_point"]
, span [className "icon-text"] [text "Gargantext"]
]
, div [className "card-group"]
[ [
div [className "col-md-8 content"] div [className "card"]
[ [
h1 [] div [className "card-block"]
[ text "Gargantext" ] [
, p []
[ text "A web platform to explore text-mining" ] div [className "center"]
, p [] [ h4 [className "m-b-0"]
[ a [ className "btn btn-primary btn-lg", href "/projects", title "Click and test by yourself" ] [ span [className "icon-text"] [ text "Connexion"]
[ span [ className "glyphicon glyphicon-hand-right" ] ]
[] , p [className "text-muted"]
, text "Log in" [ text $ "Login to your account or",
] a [ target "blank",href "https://iscpif.fr/services/applyforourservices/"] [text "ask to get an access"]
, a [ className "btn btn-warning btn-lg", href "https://iscpif.fr/services/applyforourservices/", target "blank", title "Fill the form to sign up" ] ]
[ span [ aria {hidden : true}, className "glyphicon glyphicon-hand-right" ]
[]
, text "Sign Up"
] ]
, a [ className "btn btn-success btn-lg", href "https://iscpif.fr/gargantext/your-first-map/", target "blank", title "Fill the form to sign up" ] , form []
[ span [ aria {hidden : true}, className "glyphicon glyphicon-hand-right" ] [ input [_type "hidden",
[] name "csrfmiddlewaretoken",
, text "Documentation" value "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM" ]
]
]
, span [ aria {hidden : true}, className "glyphicon glyphicon-warning-sign" ]
[]
, i []
[ text "Some features may not work without a javascript optimized browser (Chromium for instance). " ]
]
, div [className "col-md-2 content"]
[
p [ className "right" ]
[ div [_id "logo-designed" ]
[ img [ src "dist/images/logo.png", title "Logo designed by dacha and anoe" ]
[] []
, div [className "form-group"]
[
input [className "form-control", _id "id_username",maxLength "254", name "username", placeholder "username", _type "text"] []
]
, div [className "form-group"]
[ input [className "form-control", _id "id_password", name "password", placeholder "password", _type "password"] []
, div [className "clearfix"] []
]
, div [className "center"]
[
div [className "checkbox"]
[ input [_id "terms-accept", _type "checkbox", value "", className "checkbox"]
[
]
, text "I accept the terms of uses",
a [href "http://gitlab.iscpif.fr/humanities/tofu/tree/master"] [text "[Read the terms of use]"]
]
, button [_id "login-button",className "btn btn-primary btn-rounded", _type "submit"] [text "Login"]
]
] ]
] ]
] ]
] ]
]
]
, div [className "container"]
[ div [className "row"]
[ div [className "col-md-offset-5 col-md-6 content"]
[ img [ src "dist/images/Gargantextuel-212x300.jpg", title "Gargantextuel drawn by Cecile Meadel", _id "funnyimg"] []
]
] ]
]
, div [ className "container" ]
[ div [ className "row" ]
[ div [ className "col-md-4 content" ]
[ h3 []
[ a [ href "#", title "Random sentences in Gargantua's Books chapters, historically true" ]
[ text "Historic" ]
]
, p []
[ text "Chapter 1.XV. How Gargantua was put under other schoolmasters. Chapter 2.XXII. How Panurge served a Parisian lady a trick that pleased her not very well. Chapter 3.XXXVII. How Pantagruel persuaded Panurge to take counsel of a fool. Chapter 4.LXI. How Gaster invented means to get and preserve corn. Chapter 5.XXXVIII. Of the temple's admirable pavement." ]
]
, div [ className "col-md-4 content" ]
[ h3 []
[ a [ href "#", title "Randomized words, semantically and syntaxically falses." ]
[ text "Presentation" ]
]
, p []
[ text "Autem nascetur iaculis, sedfusce enimsed cursus posuere consectetuer eu justo aliquammauris. Phasellus vero nisi porttitor elit quod, leo feliscras ultricies non tempor sagittis. Liberoduis facilisinam erat dapibusnam, lacus dui duis tristique volutpatut quis vestibulum magna. Nobis faucibusvestibulum dolores minim. Bibendumin malesuada adipiscing ante, mattis fames nequeetiam lorem. No diam id. Litora quisaenean commodo lobortisetiam neque, libero mollis scelerisque inceptos ullamcorper sea congue delenit possim. " ]
]
, div [ className "col-md-4 content" ]
[ h3 []
[ a [ href "#", title "Randomized letters, true or false ?" ]
[ text "Tutoreil" ]
]
, p []
[ text "Il paraît que l'rdore des lettres dans un mot n'a pas d'imtraopnce. La première et la dernière lettre doeivnt être à la bonne place. Le reste peut être dans un désordre total et on peut touojurs lire sans prolèbme. On ne lit donc pas chaque lettre en ellêem-me, mais le mot comme un tout. Un chaegmnent de référentiel et nous tranpossons ce résultat au texte luimê-me: l'rdore des mots est failbement important copamré au contexte du texte qui, lui, est copmté: comptexter avec Gargantext. "
, text " "
, text ""
]
]
]
]
, div [className "container"]
[
hr [] []
, footer []
[ p []
[ text "Gargantext"
, span [className "glyphicon glyphicon-registration-mark" ]
[]
, text ", version 3.0.6.9.4,"
, a [ href "http://www.cnrs.fr", target "blank", title "Institution that enables this project." ]
[ text "Copyrights"
, span [ className "glyphicon glyphicon-copyright-mark" ]
[]
, text "CNRS 2017"
]
, a [ href "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE", target "blank", title "Legal instructions of the project." ]
[ text ", Licences aGPLV3 and CECILL variant Affero compliant" ]
, text "."
]
] ]
]
] ]
src/Main.purs
View file @ 17f48ce1
module Main where module Main where
import Login (initialState, loginSpec)
import Prelude import Prelude
import Control.Monad.Eff.Unsafe (unsafePerformEff) import Control.Monad.Eff (Eff)
import DOM (DOM)
import DOM.HTML (window) as DOM import DOM.HTML (window) as DOM
import DOM.HTML.Types (htmlDocumentToParentNode) as DOM import DOM.HTML.Types (htmlDocumentToParentNode) as DOM
import DOM.HTML.Window (document) as DOM import DOM.HTML.Window (document) as DOM
import DOM.Node.ParentNode (QuerySelector(..)) import DOM.Node.ParentNode (QuerySelector(..))
import DOM.Node.ParentNode (querySelector) as DOM import DOM.Node.ParentNode (querySelector) as DOM
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Navigation (dispatchAction, initAppState, layoutSpec)
import PageRouter (routeHandler, routing)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React as R import React as R
import ReactDOM as RDOM import ReactDOM as RDOM
import Routing (matches)
import Routing.Hash (getHash, setHash)
import Thermite as T import Thermite as T
main :: Unit main :: forall e. Eff (dom:: DOM | e) Unit
main = unsafePerformEff $ do main = do
case T.createReactSpec loginSpec initialState of case T.createReactSpec layoutSpec initAppState of
{ spec, dispatcher } -> void $ do { spec, dispatcher } -> void $ do
let spec' = spec let setRouting this = void $ do
matches routing (routeHandler (dispatchAction (dispatcher this)))
spec' = spec { componentWillMount = setRouting }
document <- DOM.window >>= DOM.document document <- DOM.window >>= DOM.document
container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document)) container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document))
h <- getHash
case h of
"" -> setHash "/"
_ -> do
setHash "/"
setHash h
RDOM.render (R.createFactory (R.createClass spec') {}) container RDOM.render (R.createFactory (R.createClass spec') {}) container
src/Navigation.purs 0 → 100644
View file @ 17f48ce1
module Navigation where
import Control.Monad.Eff.Console (CONSOLE)
import DOM (DOM)
import Data.Either (Either(..))
import Data.Foldable (fold)
import Data.Lens (Lens', Prism', lens, over, prism)
import Data.Maybe (Maybe(Nothing, Just))
import Thermite (PerformAction, Render, Spec, _render, defaultRender, focus, modifyState, simpleSpec, withState)
import Prelude hiding (div)
import Network.HTTP.Affjax (AJAX)
import PageRouter (Routes(..))
import React.DOM (div)
import React.DOM.Props (_id, className)
import Landing as L
import Login as LN
type E e = (dom :: DOM, ajax :: AJAX, console :: CONSOLE | e)
type AppState =
{ currentRoute :: Maybe Routes
, landingState :: L.State
, loginState :: LN.State
}
initAppState :: AppState
initAppState =
{ currentRoute : Nothing
, landingState : L.initialState
, loginState : LN.initialState
}
data Action
= Initialize
| LandingA L.Action
| LoginA LN.Action
| SetRoute Routes
performAction :: forall eff props. PerformAction (dom :: DOM |eff) AppState props Action
performAction (SetRoute route) _ _ = void do
modifyState $ _ {currentRoute = pure route}
performAction _ _ _ = void do
modifyState id
---- Lens and Prism
_landingState:: Lens' AppState L.State
_landingState = lens (\s -> s.landingState) (\s ss -> s{landingState = ss})
_landingAction :: Prism' Action L.Action
_landingAction = prism LandingA \action ->
case action of
LandingA caction -> Right caction
_-> Left action
_loginState:: Lens' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_loginAction :: Prism' Action LN.Action
_loginAction = prism LoginA \action ->
case action of
LoginA caction -> Right caction
_-> Left action
pagesComponent :: forall props eff. AppState -> Spec (E eff) AppState props Action
pagesComponent s =
case s.currentRoute of
Just route ->
selectSpec route
Nothing ->
selectSpec Home
where
selectSpec :: Routes -> Spec (ajax :: AJAX, console :: CONSOLE, dom :: DOM | eff) AppState props Action
selectSpec Home = focus _landingState _landingAction L.loginSpec
selectSpec Login = wrap $ focus _loginState _loginAction LN.renderSpec
routingSpec :: forall props eff. Spec (dom :: DOM |eff) AppState props Action
routingSpec = simpleSpec performAction defaultRender
wrap :: forall eff props. Spec (E eff) AppState props Action -> Spec (E eff) AppState props Action
wrap spec =
fold
[ sidebarnavSpec
, innerContainer $ spec
]
where
innerContainer :: Spec (E eff) AppState props Action -> Spec (E eff) AppState props Action
innerContainer = over _render \render d p s c ->
[ div [_id "page-wrapper"]
[
div[className "container-fluid"] (render d p s c)
]
]
sidebarnavSpec :: forall props eff. Spec (dom :: DOM |eff) AppState props Action
sidebarnavSpec = simpleSpec performAction render
where
render :: Render AppState props Action
render dispatch _ state _ =
[ ]
layoutSpec :: forall eff props. Spec (E eff) AppState props Action
layoutSpec =
fold
[ routingSpec
, container $
withState pagesComponent
]
where
container :: Spec (E eff) AppState props Action -> Spec (E eff) AppState props Action
container = over _render \render d p s c ->
(render d p s c)
dispatchAction :: forall t115 t445 t447. Bind t445 => Applicative t445 => (Action -> t445 t447) -> t115 -> Routes -> t445 Unit
dispatchAction dispatcher _ Home = do
_ <- dispatcher $ SetRoute $ Home
_ <- dispatcher $ LandingA $ L.NoOp
pure unit
dispatchAction dispatcher _ Login = do
_ <- dispatcher $ SetRoute $ Login
_ <- dispatcher $ LoginA $ LN.NoOp
pure unit
src/PageRouter.purs 0 → 100644
View file @ 17f48ce1
module PageRouter where
import Prelude
import Control.Alt ((<|>))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (CONSOLE, log)
import DOM (DOM)
import DOM.HTML (window)
import DOM.HTML.Window (localStorage)
import DOM.WebStorage.Storage (getItem)
import Data.Int (floor)
import Data.Maybe (Maybe(..))
import Routing.Match (Match)
import Routing.Match.Class (lit, num)
data Routes
= Home
| Login
instance showRoutes :: Show Routes where
show Home = "Home"
show Login = "Login"
int :: Match Int
int = floor <$> num
routing :: Match Routes
routing =
loginRoute
<|> home
where
loginRoute = Login <$ route "login"
home = Home <$ lit ""
route str = lit "" *> lit str
routeHandler :: forall e. (Maybe Routes -> Routes -> Eff ( dom :: DOM, console :: CONSOLE | e) Unit) -> Maybe Routes -> Routes -> Eff (dom :: DOM, console :: CONSOLE | e) Unit
routeHandler dispatchAction old new = do
liftEff $ log $ "change route : " <> show new
w <- window
ls <- localStorage w
token <- getItem "accessToken" ls
let tkn = token
liftEff $ log $ "JWToken : " <> show tkn
case tkn of
Nothing -> do
liftEff $ log $ "called SignIn Route :"
Just t -> do
dispatchAction old new
liftEff $ log $ "called Route : " <> show new
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