{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Clckwrks.Authenticate.Page.Login where import Control.Applicative ((<$>)) import Clckwrks.Monad (ClckT, ThemeStyleId(..), plugins, themeTemplate) import Clckwrks.Authenticate.URL import Clckwrks.URL (ClckURL) import Control.Monad.State (get) import Happstack.Server (Response, ServerPartT) import HSP import Language.Haskell.HSX.QQ (hsx) loginPage :: ClckT ClckURL (ServerPartT IO) Response loginPage :: ClckT ClckURL (ServerPartT IO) Response loginPage = do ClckPlugins plugins <- ClckState -> ClckPlugins plugins (ClckState -> ClckPlugins) -> ClckT ClckURL (ServerPartT IO) ClckState -> ClckT ClckURL (ServerPartT IO) ClckPlugins forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ClckT ClckURL (ServerPartT IO) ClckState forall s (m :: * -> *). MonadState s m => m s get ClckPlugins -> ThemeStyleId -> Text -> () -> XMLGenT (ClckT ClckURL (ServerPartT IO)) XML -> ClckT ClckURL (ServerPartT IO) Response forall headers body. (EmbedAsChild (ClckT ClckURL (ServerPartT IO)) headers, EmbedAsChild (ClckT ClckURL (ServerPartT IO)) body) => ClckPlugins -> ThemeStyleId -> Text -> headers -> body -> ClckT ClckURL (ServerPartT IO) Response themeTemplate ClckPlugins plugins (Int -> ThemeStyleId ThemeStyleId Int 0) Text "Login" () [hsx| <div ng-controller="UsernamePasswordCtrl"> <div up-authenticated=False> <h2>Login</h2> <up-login /> <h2>Forgotten Password?</h2> <p>Forgot your password? Request a reset link via email!</p> <up-request-reset-password /> </div> <div up-authenticated=True> <h2>Logout</h2> <p>You have successfully logged in! Click the link below to logout.</p> <up-logout /> </div> <h2>Create A New Account</h2> <up-signup-password /> </div> |]