diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index f8bddf741..9dd373ce9 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -16,7 +16,12 @@ module Handler.Course where import Import + +import Control.Lens +import Utils.Lens +import Utils.TH import Handler.Utils +import Handler.Utils.Table.Convenience -- import Data.Time import qualified Data.Text as T @@ -42,16 +47,21 @@ colCourse = sortable (Just "course") (i18nCell MsgCourse) anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseName}|] -colCourseDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) -colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> mappend - ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseName}|] ) - ( case courseDescription of - Nothing -> mempty - (Just descr) -> cell [whamlet| ^{modalStatic descr} |] - ) +-- colCourseDescr1 :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) +-- colCourseDescr1 = sortable (Just "course") (i18nCell MsgCourse) +-- $ \DBRow{ dbrOutput=(Entity _cid course, _, _, _) } -> +-- courseCell course -colDescription :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +-- colCourseDescr1 :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) +-- colCourseDescr1 = sortable (Just "course") (i18nCell MsgCourse) $ do +-- course <- view $ _dbrOutput . _1 . _entityVal +-- return $ courseCell course + +-- colCourseDescr1 :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) +-- colCourseDescr1 = colCourseDescr _1 + + +colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a) colDescription = sortable Nothing (i18nCell MsgCourseDescription) $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> case courseDescription of @@ -91,7 +101,8 @@ colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort) colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom) $ \DBRow{ dbrOutput=(Entity cid Course{..}, _, _, _) } -> - cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget + maybe mempty timeCell courseRegisterFrom + -- cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget colRegTo :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo) @@ -178,7 +189,7 @@ getCourseListR :: Handler Html getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!! muid <- maybeAuthId let colonnade = widgetColonnade $ mconcat - [ colCourseDescr + [ colCourseDescr _1 , colCShort , colTerm , maybe mempty (const colRegistered) muid diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 4bb62d344..6e4c640de 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -14,6 +14,8 @@ module Handler.Profile where import Import import Handler.Utils +import Handler.Utils.Table.Convenience + import Utils.Lens -- import Colonnade hiding (fromMaybe, singleton) -- import Yesod.Colonnade @@ -142,6 +144,29 @@ postProfileR = do -- TODO getProfileR +---------------------------------------- +-- TODO: Are these really a good idea? +-- If yes: Move to appropriate Place: Utils.Lens and Utils.Table.Convenience + +-- instance HasCourse (DBRow (Entity Course, a)) where +-- course = _dbrOutput . _1 . _entityVal + +instance HasCourse a => HasCourse (Entity a) where + course = _entityVal . course + +instance HasCourse a => HasCourse (a,b) where + course = _1 . course + +-- instance {-# OVERLAPPABLE #-} HasCourse b => HasCourse (a,b) where +-- course = _2 . course + +instance HasCourse a => HasCourse (a,b,c,d) where + course = _1 . course + +instance HasCourse a => HasCourse (DBRow a) where + course = _dbrOutput . course + +-- getProfileDataR :: Handler Html @@ -153,23 +178,30 @@ getProfileDataR = do -- Tabelle mit allen Teilnehmer: Kurs (link), Datum courseTable <- do let -- should be inlined - -- courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, Entity CourseParticipant)) (DBCell m a) + courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, E.Value UTCTime)) (DBCell m a) courseCol = sortable (Just "course") (i18nCell MsgCourse) $ do -- (->) a Monad - Course{..} <- view $ _dbrOutput . _1 . _entityVal -- view == ^. + course <- view $ _dbrOutput . _1 . _entityVal -- view == ^. -- "preview _left" in order to match Either (result is Maybe) - return $ anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) - (citext2widget courseName) - --courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant))) - -- -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (Entity CourseParticipant)) + return $ courseCell course + +-- termCol = sortable (Just "school") (i18nCell MsgCourseSchool) $ do +-- Course{..} <- view $ _dbrOutput . _1 . _entityVal +-- return $ anchorCell (TermsSchoolCourseListR + + courseData :: (E.InnerJoin (E.SqlExpr (Entity Course)) (E.SqlExpr (Entity CourseParticipant))) + -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value UTCTime)) courseData = \(course `E.InnerJoin` participant) -> do E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid - return (course, participant) + return (course, participant E.^. CourseParticipantRegistration) dbTableWidget' def $ DBTable { dbtIdent = "courseMembership" :: Text , dbtSQLQuery = courseData , dbtColonnade = mconcat - [ courseCol + [ colCourseDescrG + , sortable (Just "time") (i18nCell MsgRegistered) $ do + regTime <- view $ _dbrOutput . _2 . _unValue + return $ timeCell regTime ] , dbtProj = return , dbtSorting = Map.fromList diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index f198e9a6b..e998bc1ca 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -7,9 +7,17 @@ module Utils.Lens ( module Utils.Lens ) where import Import.NoFoundation import Control.Lens as Utils.Lens +import qualified Database.Esqueleto as E (Value(..)) + +_unValue :: Lens' (E.Value a) a +_unValue f (E.Value a) = E.Value <$> f a makeClassy_ ''Entity makeClassy_ ''SheetCorrector +makeClassy_ ''Course + -- makeClassy_ ''Load + + diff --git a/src/Utils/TH.hs b/src/Utils/TH.hs index 04eebdfa2..45bc84c7e 100644 --- a/src/Utils/TH.hs +++ b/src/Utils/TH.hs @@ -17,14 +17,12 @@ import Language.Haskell.TH ------------ -- Alternatively uses lenses: "^. _3" projects the 3rd component of an n-tuple for any n >=3, requires import Control.Lens -{- projNI :: Int -> Int -> ExpQ -- generic projection gives I-th element of N-tuple, i.e. snd3 = $(projNI 3 2) --ghci -fth -- $(projN n m) :: (t1,..,tn) -> tm (for m<=n) projNI n i = lamE [pat] rhs where pat = tupP (map varP xs) rhs = varE (xs !! (i - 1)) xs = [ mkName $ "x" ++ show j | j <- [1..n] ] --} --------------- -- Functions -- diff --git a/src/index.md b/src/index.md index fee16d2ba..bfac4bea2 100644 --- a/src/index.md +++ b/src/index.md @@ -74,7 +74,10 @@ Handler.Utils.Table.Pagination Handler.Utils.Table.Pagination.Types : `Sortable`-Headedness for colonnade - + +Handler.Utils.Table.Convenience + : extends dbTable with UniWorX specific functions, such as special courseCell + Handler.Utils.Templates : Modals