Commit 17f48ce1 authored by Abinaya Sudhir's avatar Abinaya Sudhir

Added routing and login page

parent 90132f1b
...@@ -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"
......
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -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>
......
This diff is collapsed.
This diff is collapsed.
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
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
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