{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} module Handler.Admin where import Import import Handler.Utils import Jobs -- import Data.Time -- import qualified Data.Text as T -- import Data.Function ((&)) -- import Yesod.Form.Bootstrap3 import Web.PathPieces (showToPathPiece, readFromPathPiece) import Database.Persist.Sql (fromSqlKey) -- import Colonnade hiding (fromMaybe) -- 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 UniWorX CreateButton where label CreateMath = [whamlet|Mathematik|] label CreateInf = "Informatik" cssClass CreateMath = BCInfo cssClass CreateInf = BCPrimary -- END Button needed here emailTestForm :: AForm (HandlerT UniWorX IO) (Email, MailLanguages) emailTestForm = (,) <$> areq emailField (fslI MsgMailTestFormEmail) Nothing <*> (MailLanguages <$> areq (reorderField appLanguages) (fslI MsgMailTestFormLanguages) Nothing) <* submitButton getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden! getAdminTestR = postAdminTestR postAdminTestR = do ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm "buttons" (buttonForm :: Form CreateButton) case btnResult of (FormSuccess CreateInf) -> addMessage Info "Informatik-Knopf gedrückt" (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt" FormMissing -> return () _other -> addMessage Warning "KEIN Knopf erkannt" ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm "email" $ renderAForm FormStandard emailTestForm case emailResult of (FormSuccess (email, ls)) -> do jId <- runDB $ do jId <- queueJob $ JobSendTestEmail email ls addMessage Success [shamlet|Email-test gestartet (Job ##{tshow (fromSqlKey jId)})|] return jId writeJobCtl $ JobCtlPerform jId FormMissing -> return () (FormFailure errs) -> forM_ errs $ addMessage Error . toHtml defaultLayout $ do -- setTitle "Uni2work Admin Testpage" $(widgetFile "adminTest") getAdminUserR :: CryptoUUIDUser -> Handler Html getAdminUserR uuid = do uid <- decrypt uuid User{..} <- runDB $ get404 uid defaultLayout $ [whamlet|

TODO

Admin Page for User ^{nameWidget userDisplayName userSurname} |]