Added routing and login page

17f48ce1 · Abinaya Sudhir · 90132f1b · 17f48ce1 · 17f48ce1 · 17f48ce1
Commit 17f48ce1 authored Nov 24, 2017 by Abinaya Sudhir
8 changed files
--- a/bower.json
+++ b/bower.json
@@ -9,8 +9,9 @@
  "dependencies": {
    "purescript-prelude": "^3.1.0",
    "purescript-console": "^3.0.0",
-    "purescript-thermite": "^4.1.1",
-    "purescript-affjax": "^4.0.0"
+    "purescript-thermite": "^5.0.0",
+    "purescript-affjax": "^5.0.0",
+    "purescript-routing": "^6.1.2"
  },
  "devDependencies": {
    "purescript-psci-support": "^3.0.0"

--- a/dist/css/login.min.css
+++ b/dist/css/login.min.css
--- a/index.html
+++ b/index.html
@@ -3,9 +3,11 @@
    <head>
        <meta charset="utf-8"/>
        <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 rel="stylesheet" type="text/css" href="./dist/css/menu.css"/>
        <link href="./dist/css/Login.css" rel="stylesheet">
+        <link href="./dist/css/login.min.css" rel="stylesheet">
    </head>
    <body>
        <div id="app"></div>

--- a/src/Landing.purs
+++ b/src/Landing.purs
--- a/src/Login.purs
+++ b/src/Login.purs
--- a/src/Main.purs
+++ b/src/Main.purs
 module Main where

-import Login (initialState, loginSpec)
 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.Types (htmlDocumentToParentNode) as DOM
 import DOM.HTML.Window (document) as DOM
 import DOM.Node.ParentNode (QuerySelector(..))
 import DOM.Node.ParentNode (querySelector) as DOM
 import Data.Maybe (fromJust)
+import Navigation (dispatchAction, initAppState, layoutSpec)
+import PageRouter (routeHandler, routing)
 import Partial.Unsafe (unsafePartial)
 import React as R
 import ReactDOM as RDOM
+import Routing (matches)
+import Routing.Hash (getHash, setHash)
 import Thermite as T

-main :: Unit
-main = unsafePerformEff $ do
-  case T.createReactSpec loginSpec initialState  of
+main :: forall e. Eff (dom:: DOM | e) Unit
+main = do
+  case T.createReactSpec layoutSpec initAppState of
    { 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
      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
--- a/src/Navigation.purs
+++ b/src/Navigation.purs
+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
--- a/src/PageRouter.purs
+++ b/src/PageRouter.purs
+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