fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

Browse Source
This commit is contained in:
Gregor Kleen 2019-01-24 16:21:41 +01:00
commit 14c8aa5e30
5 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.vscode/settings.json vendored Normal file
View File

@ -0,0 +1,3 @@
{
"AllAutocomplete.showCurrentDocument": false
}

14
src/Foundation.hs
View File

@ -1360,6 +1360,18 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
guard $ null submissions
return True
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrections
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid)
, ("corrections-school", CI.original $ unSchoolKey ssh)
, ("corrections-course", CI.original csh)
, ("corrections-sheet" , CI.original shn)
])
, menuItemModal = False
, menuItemAccessCallback' = (== Authorized) <$> evalAccess (CourseR tid ssh csh CNotesR) False
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSubmissionOwn
@ -1374,7 +1386,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrectors
, menuItemLabel = MsgMenuSubmissions
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
, menuItemModal = False

13
src/Handler/Corrections.hs
View File

@ -287,6 +287,12 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
| otherwise -> corrector E.?. UserEmail `E.in_` E.justList (E.valList . catMaybes $ Set.toList emails)
E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
)
, ( "israted"
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
)
]
, dbtFilterUI = fromMaybe mempty dbtFilterUI
, dbtStyle = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@ -489,9 +495,10 @@ postCorrectionsR = do
, colRated
] -- Continue here
filterUI = Just $ \mPrev -> mconcat
[ Map.singleton "course" . maybeToList <$> aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) (Just <$> listToMaybe =<< Map.lookup "course" =<< mPrev)
, Map.singleton "term" . maybeToList <$> aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm) (Just <$> listToMaybe =<< Map.lookup "term" =<< mPrev)
, Map.singleton "school" . maybeToList <$> aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) (Just <$> listToMaybe =<< Map.lookup "school" =<< mPrev)
[ Map.singleton "course" . maybeToList <$> aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse) (Just <$> listToMaybe =<< Map.lookup "course" =<< mPrev)
, Map.singleton "term" . maybeToList <$> aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm) (Just <$> listToMaybe =<< Map.lookup "term" =<< mPrev)
, Map.singleton "school" . maybeToList <$> aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool) (Just <$> listToMaybe =<< Map.lookup "school" =<< mPrev)
, Map.singleton "israted" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgRatingTime) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "israted" =<< mPrev)
]
courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)

2
src/Handler/Home.hs
View File

@ -139,7 +139,7 @@ homeUser uid = do
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
tickmark
]
let validator = def & defaultSorting [SortDescBy "done", SortDescBy "deadline"]
let validator = def & defaultSorting [SortDescBy "done", SortAscBy "deadline"]
sheetTable <- runDB $ dbTableWidget' validator DBTable
{ dbtSQLQuery = tableData
, dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` sheet) `E.LeftOuterJoin` _) -> sheet E.^. SheetId

1
templates/widgets/gradingSummary.hamlet
View File

@ -5,6 +5,7 @@ $# hasPasses :: Maybe Int -- Should Passing be displayed?
$# hasMarkedPasses :: Maybe Int -- Number of marked pass-sheets
$# hasPoints :: Maybe Points -- Should Points be displayed?
$# hasMarkedPoints :: Maybe Int -- Number of marked point-sheets
$# rowWdgts :: Liste von Widgets für jede Zeile (Normal,Bonus,KeineWertung)
$# --
<div>
<h3>_{MsgSummaryTitle} _{title $ getSum $ numSheets $ sumSummaries}