More type annotations, still not enough
This commit is contained in:
parent
eda8289ce7
commit
0c10e7e0d9
@ -58,7 +58,7 @@ homeAnonymous = do
|
|||||||
let tableData :: E.SqlExpr (Entity Course)
|
let tableData :: E.SqlExpr (Entity Course)
|
||||||
-> E.SqlQuery (E.SqlExpr (Entity Course))
|
-> E.SqlQuery (E.SqlExpr (Entity Course))
|
||||||
tableData course = do
|
tableData course = do
|
||||||
E.where_ $ (E.not_ $ E.isNothing $ course E.^. CourseRegisterFrom) -- TODO: do this with isAuthorized in dbtProj
|
E.where_ $ (E.not_ $ E.isNothing $ course E.^. CourseRegisterFrom) -- DO: do this with isAuthorized in dbtProj
|
||||||
E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
|
E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
|
||||||
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
|
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
|
||||||
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
|
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
|
||||||
|
|||||||
@ -2,10 +2,13 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
|
||||||
module Handler.Profile where
|
module Handler.Profile where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
@ -147,12 +150,12 @@ getProfileDataR = do
|
|||||||
-- mr <- getMessageRender
|
-- mr <- getMessageRender
|
||||||
|
|
||||||
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
|
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
|
||||||
courseTable <- do
|
((), courseTable :: Widget) <- do
|
||||||
let courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, Entity CourseParticipant)) (DBCell m a)
|
let courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, Entity CourseParticipant)) (DBCell m a)
|
||||||
courseCol = sortable (Just "course") (i18nCell MsgCourse) $
|
courseCol = sortable (Just "course") (i18nCell MsgCourse) $
|
||||||
\DBRow{ dbrOutput = (Entity {entityVal=Course{..}}, _participant) } ->
|
\DBRow{ dbrOutput = (Entity {entityVal=Course{..}}, _participant) } ->
|
||||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
||||||
(toWidget courseName)
|
(citext2widget courseName)
|
||||||
courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant)))
|
courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant)))
|
||||||
-> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (Entity CourseParticipant))
|
-> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (Entity CourseParticipant))
|
||||||
courseData = \(course `E.InnerJoin` participant) -> do
|
courseData = \(course `E.InnerJoin` participant) -> do
|
||||||
@ -166,8 +169,11 @@ getProfileDataR = do
|
|||||||
[ courseCol
|
[ courseCol
|
||||||
]
|
]
|
||||||
, dbtProj = return
|
, dbtProj = return
|
||||||
, dbtSorting = mempty -- Map.fromList []
|
, dbtSorting = Map.fromList
|
||||||
, dbtFilter = mempty -- Map.fromList []
|
[ ( "course"
|
||||||
|
, SortColumn $ \(course `E.InnerJoin` _) -> course E.^. CourseName )
|
||||||
|
]
|
||||||
|
, dbtFilter = mempty
|
||||||
, dbtStyle = def
|
, dbtStyle = def
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@ -99,10 +99,15 @@ toWgt :: (ToMarkup a, MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
|||||||
a -> WidgetT site m ()
|
a -> WidgetT site m ()
|
||||||
toWgt = toWidget . toHtml
|
toWgt = toWidget . toHtml
|
||||||
|
|
||||||
|
-- Convenience Functions to avoid type signatures:
|
||||||
text2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
text2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
||||||
Text -> WidgetT site m ()
|
Text -> WidgetT site m ()
|
||||||
text2widget t = [whamlet|#{t}|]
|
text2widget t = [whamlet|#{t}|]
|
||||||
|
|
||||||
|
citext2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
||||||
|
(CI Text) -> WidgetT site m ()
|
||||||
|
citext2widget t = [whamlet|#{CI.original t}|]
|
||||||
|
|
||||||
str2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
str2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
||||||
String -> WidgetT site m ()
|
String -> WidgetT site m ()
|
||||||
str2widget s = [whamlet|#{s}|]
|
str2widget s = [whamlet|#{s}|]
|
||||||
|
|||||||
Reference in New Issue
Block a user