Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX
This commit is contained in:
SJost
commit
1b79509b06
@ -102,7 +102,7 @@ colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
|
||||
|
||||
colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers)
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _, _) } -> textCell $ case courseCapacity of
|
||||
$ \DBRow{ dbrOutput=(Entity cid Course{..}, currentParticipants, _, _) } -> i18nCell $ case courseCapacity of
|
||||
Nothing -> MsgCourseMembersCount currentParticipants
|
||||
Just max -> MsgCourseMembersCountLimited currentParticipants max
|
||||
|
||||
|
||||
@ -67,16 +67,16 @@ homeAnonymous = do
|
||||
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
|
||||
colonnade = mconcat
|
||||
[ -- dbRow
|
||||
sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
textCell $ display $ courseTerm course
|
||||
, sortable (Just "school") (textCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||
textCell $ display $ courseSchool course
|
||||
, sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
|
||||
let tid = courseTerm course
|
||||
ssh = courseSchool course
|
||||
csh = courseShorthand course
|
||||
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
||||
, sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
, sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
|
||||
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
|
||||
]
|
||||
((), courseTable) <- dbTable def $ DBTable
|
||||
@ -156,17 +156,17 @@ homeUser uid = do
|
||||
colonnade = mconcat
|
||||
[ -- dbRow
|
||||
-- TOOD: sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(view _1 -> E.Value tid) } ->
|
||||
sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid,_,_,_,_,_) } ->
|
||||
sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(E.Value tid,_,_,_,_,_) } ->
|
||||
textCell $ display tid
|
||||
, sortable (Just "school") (textCell MsgCourseSchool) $ \DBRow{ dbrOutput=(_,E.Value ssh,_,_,_,_) } ->
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(_,E.Value ssh,_,_,_,_) } ->
|
||||
textCell $ display ssh
|
||||
, sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, _, _, _) } ->
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, _, _, _) } ->
|
||||
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
|
||||
, sortable (Just "sheet") (textCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
|
||||
, sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
|
||||
anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
|
||||
, sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
|
||||
, sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
|
||||
cell $ formatTime SelFormatDateTime deadline >>= toWidget
|
||||
, sortable (Just "done") (textCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
|
||||
, sortable (Just "done") (i18nCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
|
||||
case mbsid of
|
||||
Nothing -> mempty
|
||||
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
|
||||
|
||||
@ -274,7 +274,7 @@ getSShowR tid ssh csh shn = do
|
||||
-- return desired columns
|
||||
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
|
||||
let colonnadeFiles = widgetColonnade $ mconcat
|
||||
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> stringCell ftype
|
||||
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> i18nCell ftype
|
||||
, sortable (Just "path") "Dateiname" $ anchorCell' (\(E.Value fName,_,E.Value fType) -> CSheetR tid ssh csh shn (SFileR fType fName))
|
||||
(\(E.Value fName,_,_) -> str2widget fName)
|
||||
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget
|
||||
|
||||
@ -258,7 +258,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
-- Maybe construct a table to display uploaded archive files
|
||||
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ())
|
||||
colonnadeFiles cid = mconcat
|
||||
[ sortable (Just "path") (textCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
|
||||
[ sortable (Just "path") (i18nCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let
|
||||
Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr)
|
||||
origIsFile = fmap (isJust . fileContent . entityVal . snd) mOrig
|
||||
corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
|
||||
@ -272,8 +272,8 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
Just (_, Entity _ File{..})
|
||||
| isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
|
||||
([whamlet|_{MsgFileCorrected}|])
|
||||
| otherwise -> textCell MsgCorrected
|
||||
, sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
|
||||
| otherwise -> i18nCell MsgCorrected
|
||||
, sortable (Just "time") (i18nCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
|
||||
origTime = fileModified . entityVal . snd <$> mOrig
|
||||
corrTime = fileModified . entityVal . snd <$> mCorr
|
||||
Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
|
||||
|
||||
@ -486,10 +486,14 @@ dbColonnade = id
|
||||
cell :: IsDBTable m a => Widget -> DBCell m a
|
||||
cell wgt = dbCell # ([], return wgt)
|
||||
|
||||
textCell, stringCell, i18nCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
||||
textCell, stringCell :: (MonoFoldable msg, Element msg ~ Char, IsDBTable m a) => msg -> DBCell m a
|
||||
textCell = cell . toWidget . (pack :: [Char] -> Text) . otoList
|
||||
stringCell = textCell
|
||||
i18nCell = textCell
|
||||
textCell msg = cell [whamlet|_{msg}|]
|
||||
|
||||
i18nCell :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
||||
i18nCell msg = cell $ do
|
||||
mr <- getMessageRender
|
||||
toWidget $ mr msg
|
||||
|
||||
tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
|
||||
tickmarkCell True = textCell (tickmark :: Text)
|
||||
@ -551,12 +555,12 @@ formCell genIndex genForm input = FormCell
|
||||
-- Predefined colonnades
|
||||
|
||||
dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a)
|
||||
dbRow = Colonnade.singleton (headednessPure $ textCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex
|
||||
dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex
|
||||
|
||||
dbSelect :: forall h r i a. (Headedness h, Ord i, PathPiece i)
|
||||
=> Setter' a Bool
|
||||
-> (r -> MForm (HandlerT UniWorX IO) i)
|
||||
-> Colonnade h r (DBCell ((RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO))) (FormResult (DBFormResult r i a)))
|
||||
dbSelect resLens genIndex = Colonnade.singleton (headednessPure $ textCell MsgSelectColumn) $ \r -> flip (formCell genIndex) r $ \_ i -> do
|
||||
dbSelect resLens genIndex = Colonnade.singleton (headednessPure $ i18nCell MsgSelectColumn) $ \r -> flip (formCell genIndex) r $ \_ i -> do
|
||||
(selResult, selWidget) <- mreq checkBoxField ("" { fsName = Just $ "select-" <> toPathPiece i }) (Just False)
|
||||
return (set resLens <$> selResult, [whamlet|^{fvInput selWidget}|])
|
||||
|
||||
Loading…
Reference in New Issue
Block a user