diff --git a/src/Foundation.hs b/src/Foundation.hs index f16c9dc79..46ed9addf 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 70d0c27c8..d308a6679 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/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 ^{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") diff --git a/src/Handler/Utils/Table/Pagination/Utils.hs b/src/Handler/Utils/Table/Pagination/Utils.hs index 33e61dfde..802daae02 100644 --- a/src/Handler/Utils/Table/Pagination/Utils.hs +++ b/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 \ No newline at end of file diff --git a/templates/table/cell/course-teaser.hamlet b/templates/table/cell/course-teaser.hamlet index 6aceaa93d..4b31e3968 100644 --- a/templates/table/cell/course-teaser.hamlet +++ b/templates/table/cell/course-teaser.hamlet @@ -2,12 +2,12 @@