diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index 683c87e9b..4daabc9a5 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -41,35 +41,33 @@ getTermShowR = do
selectRep $ do
provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData)
provideRep $ do
- let
- colonnadeTerms :: Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ())
- colonnadeTerms = mconcat
- [ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do
- -- Scrap this if to slow, create term edit page instead
- adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False
- [whamlet|
- $if adminLink == Authorized
-
- #{termToText termName}
- $else
- #{termToText termName}
- |]
- , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) ->
- stringCell $ formatTimeGerWD termLectureStart
- , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->
- stringCell $ formatTimeGerWD termLectureEnd
- , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
- textCell $ (bool "" tickmark termActive :: Text)
- , sortable Nothing "Kursliste" $ anchorCell
- (\(Entity tid _, _) -> TermCourseListR tid)
- (\(_, E.Value numCourses) -> [whamlet|_{MsgNumCourses numCourses}|])
- , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
- stringCell $ formatTimeGerWD termStart
- , sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) ->
- stringCell $ formatTimeGerWD termEnd
- , sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
- stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays
- ]
+ let colonnadeTerms = widgetColonnade $ mconcat
+ [ sortable Nothing "Kürzel" $ \(Entity tid Term{..},_) -> cell $ do
+ -- Scrap this if to slow, create term edit page instead
+ adminLink <- handlerToWidget $ isAuthorized (TermEditExistR tid) False
+ [whamlet|
+ $if adminLink == Authorized
+
+ #{termToText termName}
+ $else
+ #{termToText termName}
+ |]
+ , sortable (Just "lecture-start") "Beginn Vorlesungen" $ \(Entity _ Term{..},_) ->
+ stringCell $ formatTimeGerWD termLectureStart
+ , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) ->
+ stringCell $ formatTimeGerWD termLectureEnd
+ , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
+ textCell $ (bool "" tickmark termActive :: Text)
+ , sortable Nothing "Kursliste" $ anchorCell
+ (\(Entity tid _, _) -> TermCourseListR tid)
+ (\(_, E.Value numCourses) -> [whamlet|_{MsgNumCourses numCourses}|])
+ , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
+ stringCell $ formatTimeGerWD termStart
+ , sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) ->
+ stringCell $ formatTimeGerWD termEnd
+ , sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
+ stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays
+ ]
table <- dbTable def $ DBTable
{ dbtSQLQuery = termData
, dbtColonnade = colonnadeTerms
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index c0a606175..cf649e8c1 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -24,6 +24,7 @@ module Handler.Utils.Table.Pagination
, PSValidator(..)
, Sortable(..), sortable
, dbTable
+ , widgetColonnade, formColonnade
, textCell, stringCell, anchorCell
) where
@@ -209,7 +210,7 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
-- runDBTable :: MForm (HandlerT UniWorX IO) (Widget, FormResult a) -> m ((FormResult a, Widget), Enctype)
- runDBTable = undefined -- use runFormPost
+ runDBTable form = liftHandlerT . runFormPost $ \html -> over _2 (<> toWidget html) . swap <$> form
instance IsDBTable m a => IsString (DBCell m a) where
fromString = cell . fromString
@@ -316,6 +317,16 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
--- DBCell utility functions
+widgetColonnade :: Headedness h
+ => Colonnade h r (DBCell (WidgetT UniWorX IO) ())
+ -> Colonnade h r (DBCell (WidgetT UniWorX IO) ())
+widgetColonnade = id
+
+formColonnade :: (Headedness h, Monoid a)
+ => Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a))
+ -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a))
+formColonnade = id
+
textCell, stringCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
stringCell = textCell
textCell msg = cell [whamlet|_{msg}|]