59 lines
1.6 KiB
Haskell
59 lines
1.6 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
module Handler.Home where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
|
|
-- import Data.Time
|
|
-- import qualified Data.Text as T
|
|
-- import Yesod.Form.Bootstrap3
|
|
|
|
import Web.PathPieces (showToPathPiece, readFromPathPiece)
|
|
|
|
-- import Colonnade
|
|
-- import Yesod.Colonnade
|
|
|
|
-- import qualified Data.UUID.Cryptographic as UUID
|
|
|
|
-- BEGIN - Buttons needed only here
|
|
data CreateButton = CreateMath | CreateInf -- Dummy for Example
|
|
deriving (Enum, Eq, Ord, Bounded, Read, Show)
|
|
|
|
instance PathPiece CreateButton where -- for displaying the button only, not really for paths
|
|
toPathPiece = showToPathPiece
|
|
fromPathPiece = readFromPathPiece
|
|
|
|
instance Button CreateButton where
|
|
label CreateMath = [whamlet|Ma<i>thema</i>tik|]
|
|
label CreateInf = "Informatik"
|
|
|
|
cssClass CreateMath = BCInfo
|
|
cssClass CreateInf = BCPrimary
|
|
-- END Button needed here
|
|
|
|
getHomeR :: Handler Html
|
|
getHomeR = do
|
|
(btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form CreateButton)
|
|
defaultLayout $ do
|
|
setTitle "Willkommen zum ReWorX Test!"
|
|
$(widgetFile "home")
|
|
|
|
|
|
postHomeR :: Handler Html
|
|
postHomeR = do
|
|
((btnResult,_), _) <- runFormPost $ buttonForm
|
|
case btnResult of
|
|
(FormSuccess CreateInf) -> setMessage "Informatik-Knopf gedrückt"
|
|
(FormSuccess CreateMath) -> addMessage "warning" "Knopf Mathematik erkannt"
|
|
_other -> return ()
|
|
getHomeR
|
|
|