Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: ae159c3560
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 106 lines (90 sloc) 3.936 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
{-# LANGUAGE OverloadedStrings #-}

module JCU.Templates where

import Control.Monad
import Control.Monad.Reader
import Data.Text (Text)
import Text.Blaze.Html5 (Html, AttributeValue, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Internal (HtmlM(..))
import Text.Digestive.Blaze.Html5


-------------------------------------------------------------------------------
-- View

data AuthState = AuthState {
     loggedInST :: Bool
  , emailST :: Text
}


-- replaces the layout.tpl file
template :: Reader AuthState Html -> Reader AuthState Html
template content = do
  h <- header
  d <- doc content
  return $ H.docTypeHtml (h >> d)

doc :: Reader AuthState Html -> Reader AuthState Html
doc c = do
  content <- c
  loggedIn <- asks loggedInST
  return $
    H.body $
      H.div ! A.id "doc" $ do
        H.div ! A.id "hd" $ do
          H.span ! A.id "header" $ do
            H.img ! A.src jcuLogo64 ! A.alt "JCU logo"
            H.toHtml ("Module Functioneel en Logisch Programmeren" :: Text)
          if loggedIn
            then H.span ! A.id "logout" $ H.a ! A.href "/logout" $
                   H.toHtml ("Logout" :: Text)
            else H.span ! A.id "logout" $ H.a ! A.href "/signup" $
                   H.toHtml ("Create an account" :: Text)
        H.div ! A.id "bd" $ content
        H.div ! A.id "ft" $
          H.img ! A.src "/img/uulogo.png" ! A.id "uulogo" ! A.alt "UU Logo"
  where
    jcuLogo64 = "img/jculogo-64.png"

header :: Reader AuthState Html
header = do
  loggedIn <- asks loggedInST
  return $ H.head $ do
    H.title "JCU: Module Functioneel en Logische Programmeren"
    H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href cssBase
    H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href cssFonts
    H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href cssGrids
    H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.media "screen" ! A.href mainCss
    H.link ! A.rel "icon" ! A.type_ "image/png" ! A.href jcuLogo16
    when loggedIn $ do
      -- H.script ! A.src "brunch/build/web/js/app.js" $ H.toHtml ("" :: Text)
      H.script ! A.src "brunch/src/vendor/jquery-1.6.2.js" $ H.toHtml ("" :: Text)
      H.script ! A.src "brunch/src/vendor/jquery-ui-1.8.16.custom.min.js" $ H.toHtml ("" :: Text)
      H.script ! A.src "hjs/ajaxq.js" $ H.toHtml ("" :: Text)
      H.script ! A.src "hjs/jcu.js" $ H.toHtml ("" :: Text)
      -- H.script $ H.toHtml ("require('main');" :: Text)
  where
    cssBase = "http://yui.yahooapis.com/3.3.0/build/cssbase/base-min.css"
    cssFonts = "http://yui.yahooapis.com/3.3.0/build/cssfonts/fonts-min.css"
    cssGrids = "http://yui.yahooapis.com/3.3.0/build/cssgrids/grids-min.css"
    mainCss = "brunch/build/web/css/main.css"
    jcuLogo16 = "img/jculogo-16.png"


-- Replaces the signup.tpl file
signupHTML :: Bool -> FormHtml (HtmlM a) -> Reader AuthState Html
signupHTML exists frm = return $
  H.div ! A.id "home-view" $ do
    H.h1 $ H.toHtml ("Please sign up" :: Text)
    when exists $ H.h2 "Username is already taken"
    showForm "/signup" frm

-- Replaces the login.tpl file
loginHTML :: Bool -> FormHtml (HtmlM a) -> Reader AuthState Html
loginHTML loginFailed frm = return $
  H.div ! A.id "home-view" $ do
    H.h1 $ H.toHtml ("Please log in" :: Text)
    when loginFailed $ H.h2 "Incorrect login credentials"
    showForm "/login" frm

showForm :: AttributeValue -> FormHtml (HtmlM a) -> Html
showForm act frm =
  let (formHtml', enctype) = renderFormHtml frm
  in H.form ! A.enctype (H.toValue $ show enctype) ! A.method "post"
               ! A.action act $ do
         _ <- formHtml'
         return ()

index :: Reader AuthState Html
index = return $
  H.div $ H.toHtml ("JCU: Wiskunde D. The application is either loading, or something went wrong." :: Text)

Something went wrong with that request. Please try again.