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)
|
||||
-> E.SqlQuery (E.SqlExpr (Entity Course))
|
||||
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.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
|
||||
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
|
||||
|
||||
@ -2,10 +2,13 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
|
||||
module Handler.Profile where
|
||||
|
||||
import Import
|
||||
@ -147,12 +150,12 @@ getProfileDataR = do
|
||||
-- mr <- getMessageRender
|
||||
|
||||
-- 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)
|
||||
courseCol = sortable (Just "course") (i18nCell MsgCourse) $
|
||||
\DBRow{ dbrOutput = (Entity {entityVal=Course{..}}, _participant) } ->
|
||||
anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
|
||||
(toWidget courseName)
|
||||
(citext2widget courseName)
|
||||
courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant)))
|
||||
-> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (Entity CourseParticipant))
|
||||
courseData = \(course `E.InnerJoin` participant) -> do
|
||||
@ -166,8 +169,11 @@ getProfileDataR = do
|
||||
[ courseCol
|
||||
]
|
||||
, dbtProj = return
|
||||
, dbtSorting = mempty -- Map.fromList []
|
||||
, dbtFilter = mempty -- Map.fromList []
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "course"
|
||||
, SortColumn $ \(course `E.InnerJoin` _) -> course E.^. CourseName )
|
||||
]
|
||||
, dbtFilter = mempty
|
||||
, dbtStyle = def
|
||||
}
|
||||
|
||||
|
||||
@ -99,10 +99,15 @@ toWgt :: (ToMarkup a, MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
||||
a -> WidgetT site m ()
|
||||
toWgt = toWidget . toHtml
|
||||
|
||||
-- Convenience Functions to avoid type signatures:
|
||||
text2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
||||
Text -> WidgetT site m ()
|
||||
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) =>
|
||||
String -> WidgetT site m ()
|
||||
str2widget s = [whamlet|#{s}|]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user