From 146abce346f814b2faaf30b477de52290142d980 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 27 Jun 2018 08:45:15 +0200
Subject: [PATCH] runDbTable & slight cleanup

---
 src/Handler/Term.hs                   | 56 +++++++++++++--------------
 src/Handler/Utils/Table/Pagination.hs | 13 ++++++-
 2 files changed, 39 insertions(+), 30 deletions(-)

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
-                  <a href=@{TermEditExistR tid}>
-                    #{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
+                    <a href=@{TermEditExistR tid}>
+                      #{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}|]