refactor(course-teaser): new DBSTemplateMode datatype with lenses (stub)

src/Foundation.hs

@@ -333,7 +333,6 @@ instance RenderMessage UniWorX StudyDegreeTerm where
 instance RenderMessage UniWorX ExamGrade where
   renderMessage _ _ = pack . (showFixed False :: Deci -> String) . fromRational . review numberGrade
 
-
 -- ToMessage instances for converting raw numbers to Text (no internationalization)
 
 instance ToMessage Int where

src/Handler/Utils/Table/Pagination.hs

@@ -34,12 +34,11 @@ module Handler.Utils.Table.Pagination
   ) where
 
 import Handler.Utils.Table.Pagination.Types
-import Handler.Utils.Table.Pagination.Utils (getTableWidget)
 import Handler.Utils.Form
 import Handler.Utils.Csv
 import Handler.Utils.ContentDisposition
 import Utils
-import Utils.Lens.TH
+import Utils.Lens
 
 import Import hiding (pi)
 import qualified Database.Esqueleto as E
@@ -71,7 +70,6 @@ import Text.Hamlet (hamletFile)
 
 import Data.Ratio ((%))
 
-import Control.Lens hiding ((<.>))
 import Control.Lens.Extras (is)
 
 import Data.List (elemIndex)
@@ -96,6 +94,8 @@ import Data.Semigroup as Sem (Semigroup(..))
 
 import qualified Data.Conduit.List as C
 
+import Handler.Utils.DateTime (formatTimeW)
+
 
 #if MIN_VERSION_base(4,11,0)
 type Monoid' = Monoid
@@ -377,7 +377,7 @@ data DBEmptyStyle = DBESNoHeading | DBESHeading
 instance Default DBEmptyStyle where
   def = DBESHeading
 
-data DBStyle = DBStyle
+data DBStyle r = DBStyle
   { dbsEmptyStyle :: DBEmptyStyle
   , dbsEmptyMessage :: UniWorXMessage
   , dbsAttrs :: [(Text, Text)]
@@ -387,10 +387,12 @@ data DBStyle = DBStyle
                     -> Widget
                     -> Widget
     -- ^ Filter UI, Filter Encoding, Filter action, table
-  , dbsCellTemplate :: String  -- TODO: wip
+  , dbsCellTemplate :: DBSTemplateMode r
   }
 
-instance Default DBStyle where
+data DBSTemplateMode r = DBSTDefault | DBSTCourse (Lens' r (Entity Course))
+
+instance Default (DBStyle r) where
   def = DBStyle
     { dbsEmptyStyle = def
     , dbsEmptyMessage = MsgNoTableContent
@@ -401,7 +403,7 @@ instance Default DBStyle where
           <!-- No Filter UI -->
           ^{scrolltable}
         |]
-    , dbsCellTemplate = "table/cell/body"
+    , dbsCellTemplate = DBSTDefault
     }
 
 defaultDBSFilterLayout :: Widget -- ^ Filter UI
@@ -458,7 +460,7 @@ data DBTable m x = forall a r r' h i t k k' csv.
   , dbtSorting :: Map SortingKey (SortColumn t)
   , dbtFilter :: Map FilterKey (FilterColumn t)
   , dbtFilterUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
-  , dbtStyle :: DBStyle
+  , dbtStyle :: DBStyle r'
   , dbtParams :: DBParams m x
   , dbtCsvEncode :: DBTCsvEncode r' csv
   , dbtCsvDecode :: DBTCsvDecode csv
@@ -841,6 +843,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       . setParam (wIdent "page") Nothing
       . setParam (wIdent "pagination") Nothing
 
+    htmlToCourseDescriptionText (Just html) = html
+    htmlToCourseDescriptionText Nothing     = "No description available."
+
+    utcTimeToWidget (Just t) = formatTimeW SelFormatDateTime t
+    utcTimeToWidget Nothing  = mempty  -- TODO: Fallunterscheidung in hamlet (andere Darstellung)
+
     table' :: HandlerSite m ~ UniWorX => WriterT x m Widget
     table' = do
       let
@@ -859,12 +867,18 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
 
       wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable
 
-      wRows <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> do
-        -- TODO: remove
-        -- widget <- cell' ^. cellContents
-        -- let attrs = cell' ^. cellAttrs
-        -- return $(widgetFile "table/cell/body")
-        getTableWidget dbsCellTemplate cell' cellContents cellAttrs
+      wRows <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> case dbsCellTemplate of
+        DBSTCourse c -> let
+            Course{..}       = row' ^. c . _entityVal
+            courseId         = "cid" :: Text  -- TODO:
+            courseLecturer   = "courseLecturer" :: Text  -- TODO: use tuple of lenses in DBStyle
+            isRegistered     = False -- TODO:
+            courseSchoolName = unSchoolKey courseSchool
+          in return $(widgetFile "table/cell/course-teaser")
+        DBSTDefault  -> do
+          widget <- cell' ^. cellContents
+          let attrs = cell' ^. cellAttrs
+          return $(widgetFile "table/cell/body")
 
       return $(widgetFile "table/colonnade")
 

src/Handler/Utils/Table/Pagination/Utils.hs

@@ -1,29 +1,3 @@
 module Handler.Utils.Table.Pagination.Utils
-  ( getTableWidget
-  ) where
-
-import Import
-
-import Control.Lens (Getting, (^.))
-
-import Control.Monad.Writer ()
-
--- getTableWidget :: forall (m :: * -> *) x a s. HandlerSite m ~ UniWorX => String -> s -> Getting (WriterT x m a) s (WriterT x m a) -> Getting [(Text, Text)] s [(Text, Text)] -> WriterT x m Widget
-getTableWidget :: (ToWidget site a, MonadIO m2, MonadThrow m2, MonadBaseControl IO m2, Monad m1, site ~ UniWorX) => String -> s -> Getting (m1 a) s (m1 a) -> Getting [(Text, Text)] s [(Text, Text)] -> m1 (WidgetT site m2 ())
-getTableWidget widgetName cell' cellContents cellAttrs = case widgetName of
-  "table/cell/course-teaser" -> do
-    -- TODO: get course and deconstruct here
-    let courseId = "courseId" :: Text
-        courseTitle = "Some courseTitle" :: Text
-        courseShorthand = "cTShort" :: Text
-        courseLecturer = "Some courseLecturer" :: Text
-        courseSchoolName = "Some courseSchoolname" :: Text
-        isRegistered = False
-        courseDescription = "Some courseDescription" :: Text
-        courseRegisterTo = "Some courseRegisterTo" :: Text
-    return $(widgetFile "table/cell/course-teaser")
-  _ -> do  -- defaults to "table/cell/body"
-    -- TODO: wip
-    widget <- cell' ^. cellContents
-    let attrs = cell' ^. cellAttrs
-    return $(widgetFile "table/cell/body")
+  (
+  ) where

templates/table/cell/course-teaser.hamlet

@@ -2,12 +2,12 @@
   <div .course-teaser__chevron>
   <div .course-teaser__shorthand>_{courseShorthand}
   <div .course-teaser__title>
-    <a href=@{AdminTestR}>_{courseTitle}
+    <a href=@{AdminTestR}>_{courseName}
   <div .course-teaser__registration>_{MsgRegistered}
   <div .course-teaser__lecturer-label>_{MsgLecturerFor}
   <div .course-teaser__lecturer-value>_{courseLecturer}
   <div .course-teaser__duedate-label>_{MsgRegisterTo}
-  <div .course-teaser__duedate-value>_{courseRegisterTo}
+  <div .course-teaser__duedate-value>^{utcTimeToWidget courseRegisterTo}
   <div .course-teaser__school-label>_{MsgCourseSchool}
   <div .course-teaser__school-value>_{courseSchoolName}
-  <div .course-teaser__description>_{courseDescription}
+  <div .course-teaser__description>#{htmlToCourseDescriptionText courseDescription}

templates/table/course-table.hamlet

@@ -10,12 +10,11 @@ $newline never
     $nothing
     <tbody>
       $if null wRows && (dbsEmptyStyle == DBESHeading)
-        <td .table__row>
+        <tr .table__row>
           <td .table__td colspan=#{show columnCount}>
             _{dbsEmptyMessage}
       $else
         $forall row <- wRows
           <tr .table__row>
             $forall widget <- row
-              $# cell/course-teaser.hamlet
               ^{widget}