Permalink
Browse files

Cleanup and refactoring

  • Loading branch information...
1 parent 87dc952 commit 59efaff4c9f9ddc27d24f249ce11c6675820969f @norm2782 norm2782 committed Oct 20, 2011
Showing with 21 additions and 37 deletions.
  1. +0 −13 JCU.cabal
  2. +1 −1 Makefile
  3. +20 −23 src/JCU/Templates.hs
View
@@ -88,16 +88,3 @@ Executable jcu
else
ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
-fno-warn-orphans
-
-Library
- Extensions:
- TypeSynonymInstances
- , OverloadedStrings
- , MultiParamTypeClasses
- , FunctionalDependencies
- , DeriveDataTypeable
- , FlexibleInstances
-
- Build-Depends: base >= 4.0 && < 5.0
- Hs-Source-Dirs: src
- Exposed-modules: JCU.Prolog
View
@@ -10,7 +10,7 @@ dist:
cabal configure
cabal sdist
-install:
+dev:
cabal install -fdevelopment --disable-documentation
clean:
View
@@ -5,15 +5,11 @@ module JCU.Templates where
import Control.Monad
import Control.Monad.Reader
import Data.Text (Text)
-import Snap.Types
import Text.Blaze.Html5 hiding (header,footer)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Internal (HtmlM(..))
-import Text.Blaze.Renderer.Utf8
-import Text.Digestive
import Text.Digestive.Blaze.Html5
-import Text.Digestive.Forms.Snap
-------------------------------------------------------------------------------
@@ -42,9 +38,10 @@ doc c = do
H.div ! A.id "hd" $ do
H.span ! A.id "header" $ do
H.img ! A.src jcuLogo64 ! A.alt "JCU logo"
- H.text "Module Functioneel en Logisch Programmeren"
+ H.toHtml ("Module Functioneel en Logisch Programmeren" :: Text)
when loggedIn $
- H.span ! A.id "logout" $ H.a ! A.href "/logout" $ H.text "Logout"
+ H.span ! A.id "logout" $ H.a ! A.href "/logout" $
+ H.toHtml ("Logout" :: 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"
@@ -62,8 +59,8 @@ header = do
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.text ""
- H.script $ H.text "require('main');"
+ H.script ! A.src "brunch/build/web/js/app.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"
@@ -74,28 +71,28 @@ header = do
-- Replaces the signup.tpl file
signupHTML :: FormHtml (HtmlM a) -> Reader AuthState Html
-signupHTML form = return $
+signupHTML frm = return $
H.div ! A.id "home-view" $ do
- H.h1 $ H.text "Please sign up"
- let (formHtml', enctype) = renderFormHtml form
- H.form ! A.enctype (toValue $ show enctype) ! A.method "post"
- ! A.action "/signup" $ do
- _ <- formHtml'
- H.input ! A.type_ "submit" ! A.value "Signup"
+ H.h1 $ H.toHtml ("Please sign up" :: Text)
+ showForm "/signup" frm (H.input ! A.type_ "submit" ! A.value "Signup")
-- Replaces the login.tpl file
loginHTML :: Bool -> FormHtml (HtmlM a) -> Reader AuthState Html
-loginHTML loginFailed form = return $
+loginHTML loginFailed frm = return $
H.div ! A.id "home-view" $ do
- H.h1 $ H.text "Please log in"
+ H.h1 $ H.toHtml ("Please log in" :: Text)
when loginFailed $ H.h2 "Incorrect login credentials"
- let (formHtml', enctype) = renderFormHtml form
- H.form ! A.enctype (toValue $ show enctype) ! A.method "post"
- ! A.action "/login" $ do
- _ <- formHtml'
- H.input ! A.type_ "submit" ! A.value "Login"
+ showForm "/login" frm (H.input ! A.type_ "submit" ! A.value "Login")
+
+showForm :: AttributeValue -> FormHtml (HtmlM a) -> Html -> Html
+showForm act frm btn =
+ let (formHtml', enctype) = renderFormHtml frm
+ in H.form ! A.enctype (toValue $ show enctype) ! A.method "post"
+ ! A.action act $ do
+ _ <- formHtml'
+ btn
index :: Reader AuthState Html
index = return $
- H.div $ H.text "JCU: Wiskunde D. The application is either loading, or something went wrong."
+ H.div $ H.toHtml ("JCU: Wiskunde D. The application is either loading, or something went wrong." :: Text)

0 comments on commit 59efaff

Please sign in to comment.