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 17:08:08 +01:00
commit 1ccb8b7c32
15 changed files with 98 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/de.msg
View File

@ -186,6 +186,7 @@ UnauthorizedSystemMessageAuth: Diese Systemnachricht ist nur für angemeldete Be
UnsupportedAuthPredicate authTagT@Text shownRoute@String: "#{authTagT}" wurde auf eine Route angewandt, die dies nicht unterstützt: #{shownRoute}
UnauthorizedDisabledTag authTag@AuthTag: Authorisierungsprädikat "#{toPathPiece authTag}" ist für Ihre Sitzung nicht aktiv
UnknownAuthPredicate tag@String: Authorisierungsprädikat "#{tag}" ist dem System nicht bekannt
UnauthorizedRedirect: Die angeforderte Seite existiert nicht oder Sie haben keine Berechtigung, die angeforderte Seite zu sehen.
EMail: E-Mail
EMailUnknown email@UserEmail: E-Mail #{email} gehört zu keinem bekannten Benutzer.
@ -562,6 +563,7 @@ MenuCourseNew: Neuen Kurs anlegen
MenuTermEdit: Semester editieren
MenuCorrection: Korrektur
MenuCorrections: Korrekturen
MenuCorrectionsOwn: Meine Korrekturen
MenuSubmissions: Abgaben
MenuSheetList: Übungsblätter
MenuSheetNew: Neues Übungsblatt anlegen

6
routes
View File

@ -73,10 +73,10 @@
/subs CCorrectionsR GET POST
/ex SheetListR GET !registered !materials !corrector
!/ex/new SheetNewR GET POST
/ex-current SheetCurrentR GET !free -- just a redirect
/ex-lastinactive SheetLastInactiveR GET !free -- just a redirect
!/ex/current SheetCurrentR GET !free -- just a redirect
!/ex/lastinactive SheetLastInactiveR GET !free -- just a redirect
/ex/#SheetName SheetR:
/ SShowR GET !timeANDregistered !timeANDmaterials !corrector
/show SShowR GET !timeANDregistered !timeANDmaterials !corrector
/edit SEditR GET POST
/delete SDelR GET POST
/subs SSubsR GET POST -- for lecturer only

35
src/Foundation.hs
View File

@ -689,13 +689,18 @@ evalAccess route isWrite = do
evalAccessDB :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> Bool -> ReaderT (YesodPersistBackend UniWorX) m AuthResult
evalAccessDB = evalAccess
redirectAccessDB :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> ReaderT (YesodPersistBackend UniWorX) m a
redirectAccessDB url = do
redirectAccess :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m a
redirectAccess url = do
-- must hide URL if not authorized
access <- evalAccessDB url False
access <- evalAccess url False
case access of
Authorized -> redirect url
_ -> notFound -- permissionDeniedI maybe not always correct?
_ -> permissionDeniedI MsgUnauthorizedRedirect
-- | Verify that the currently logged in user is lecturer or corrector for at least one sheet for the given course
evalAccessCorrector :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX)
=> TermId -> SchoolId -> CourseShorthand -> m AuthResult
evalAccessCorrector tid ssh csh = evalAccess (CourseR tid ssh csh CNotesR) False
-- Please see the documentation for the Yesod typeclass. There are a number
@ -1256,7 +1261,7 @@ pageActions (CourseR tid ssh csh CShowR) =
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetLastInactiveR
, menuItemModal = False
, menuItemAccessCallback' = (== Authorized) <$> evalAccess (CourseR tid ssh csh CNotesR) False
, menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh
}
, MenuItem
{ menuItemType = PageActionPrime
@ -1265,7 +1270,7 @@ pageActions (CourseR tid ssh csh CShowR) =
, menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR
, menuItemModal = False
, menuItemAccessCallback' = do --TODO always show for lecturer
let sheetRouteAccess shn = (== Authorized) <$> isAuthorized (CSheetR tid ssh csh shn SShowR) False
let sheetRouteAccess shn = (== Authorized) <$> evalAccess (CSheetR tid ssh csh shn SShowR) False
muid <- maybeAuthId
(sheets,lecturer) <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
@ -1286,7 +1291,7 @@ pageActions (CourseR tid ssh csh CShowR) =
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrections
, menuItemLabel = MsgMenuCorrectionsOwn
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid)
, ("corrections-school", CI.original $ unSchoolKey ssh)
@ -1362,7 +1367,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrections
, menuItemLabel = MsgMenuCorrectionsOwn
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid)
, ("corrections-school", CI.original $ unSchoolKey ssh)
@ -1370,7 +1375,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
, ("corrections-sheet" , CI.original shn)
])
, menuItemModal = False
, menuItemAccessCallback' = (== Authorized) <$> evalAccess (CourseR tid ssh csh CNotesR) False
, menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh
}
, MenuItem
{ menuItemType = PageActionPrime
@ -1386,7 +1391,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuSubmissions
, menuItemLabel = MsgMenuCorrectors
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SCorrR
, menuItemModal = False
@ -1394,7 +1399,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuCorrections
, menuItemLabel = MsgMenuSubmissions
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
, menuItemModal = False
@ -1501,14 +1506,14 @@ pageActions (CorrectionsR) =
[E.Value sheetCount] <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
let
isCorrector = E.exists . E.from $ \sheetCorrector -> E.where_
isCorrector' = E.exists . E.from $ \sheetCorrector -> E.where_
$ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
isLecturer = E.exists . E.from $ \lecturer -> E.where_
$ lecturer E.^. LecturerUser E.==. E.val uid
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.where_ $ sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions
E.&&. ( isCorrector E.||. isLecturer )
E.&&. ( isCorrector' E.||. isLecturer )
return E.countRows
return $ (sheetCount :: Int) /= 0
}
@ -1541,14 +1546,14 @@ pageActions (CorrectionsGradeR) =
[E.Value sheetCount] <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
let
isCorrector = E.exists . E.from $ \sheetCorrector -> E.where_
isCorrector' = E.exists . E.from $ \sheetCorrector -> E.where_
$ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
isLecturer = E.exists . E.from $ \lecturer -> E.where_
$ lecturer E.^. LecturerUser E.==. E.val uid
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
E.where_ $ sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions
E.&&. ( isCorrector E.||. isLecturer )
E.&&. ( isCorrector' E.||. isLecturer )
return E.countRows
return $ (sheetCount :: Int) /= 0
}

23
src/Handler/Corrections.hs
View File

@ -21,6 +21,7 @@ import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI
import Data.CaseInsensitive (CI)
import Data.Semigroup (Sum(..))
import Data.Monoid (All(..))
@ -281,6 +282,11 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
| Set.null shns -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> sheet E.^. SheetName `E.in_` E.valList (Set.toList shns)
)
, ( "sheet-search"
, FilterColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) shns -> case getLast (shns :: Last (CI Text)) of
Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
Just needle -> sheet E.^. SheetName `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
)
, ( "corrector"
, FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector :: CorrectionTableExpr) emails -> if
| Set.null emails -> E.val True :: E.SqlExpr (E.Value Bool)
@ -495,19 +501,20 @@ 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 "israted" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgRatingTime) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "israted" =<< mPrev)
[ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse)
, prismAForm (singletonFilter "term" ) mPrev $ aopt (lift `hoistField` selectField termOptions) (fslI MsgTerm)
, prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool)
, Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` searchField False) (fslI MsgSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
]
courseOptions = runDB $ do
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)
courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
termOptions = runDB $ do
courses <- selectList [] [Asc CourseTerm] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)
courses <- selectList [] [Asc CourseTerm] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
schoolOptions = runDB $ do
courses <- selectList [] [Asc CourseSchool] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessDB (CourseR courseTerm courseSchool courseShorthand CNotesR) False)
courses <- selectList [] [Asc CourseSchool] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
psValidator = def
@ -655,6 +662,8 @@ postCorrectionR tid ssh csh shn cid = do
let userCorrection = $(widgetFile "correction-user")
$(widgetFile "correction")
_ -> notFound
getCorrectionUserR tid ssh csh shn cid = do
sub <- decrypt cid

4
src/Handler/Course.hs
View File

@ -176,8 +176,8 @@ makeCourseTable whereClause colChoices psValidator = do
)
]
, dbtFilterUI = \mPrev -> mconcat $ catMaybes
[ Just $ Map.singleton "search" . maybeToList <$> aopt (searchField True) (fslI MsgCourseFilterSearch) (Just <$> listToMaybe =<< Map.lookup "search" =<< mPrev)
, muid $> (Map.singleton "registered" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgCourseFilterRegistered) (Just <$> fromPathPiece =<< listToMaybe =<< Map.lookup "registered" =<< mPrev))
[ Just $ prismAForm (singletonFilter "search") mPrev $ aopt (searchField True) (fslI MsgCourseFilterSearch)
, muid $> prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt boolField (fslI MsgCourseFilterRegistered))
]
, dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
, dbtParams = def

7
src/Handler/Sheet.hs
View File

@ -154,7 +154,7 @@ getSheetCurrentR tid ssh csh = runDB $ do
E.limit 1
return $ sheet E.^. SheetName
case sheets of
(E.Value shn):_ -> redirectAccessDB $ CSheetR tid ssh csh shn SShowR
(E.Value shn):_ -> redirectAccess $ CSheetR tid ssh csh shn SShowR
_ -> notFound
getSheetLastInactiveR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
@ -162,7 +162,7 @@ getSheetLastInactiveR tid ssh csh = runDB $ do
-- TODO: deliver oldest sheet with unassigned submissions instead!!!
now <- liftIO getCurrentTime
sheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.where_ $ sheet E.^. SheetActiveTo E.<=. E.val now
E.&&. course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
@ -171,7 +171,7 @@ getSheetLastInactiveR tid ssh csh = runDB $ do
E.limit 1
return $ sheet E.^. SheetName
case sheets of
(E.Value shn):_ -> redirectAccessDB $ CSheetR tid ssh csh shn SShowR
(E.Value shn):_ -> redirectAccess $ CSheetR tid ssh csh shn SShowR
_ -> notFound
@ -386,6 +386,7 @@ getSShowR tid ssh csh shn = do
sheetTo <- formatTime SelFormatDateTime $ sheetActiveTo sheet
hintsFrom <- traverse (formatTime SelFormatDateTime) $ sheetHintFrom sheet
solutionFrom <- traverse (formatTime SelFormatDateTime) $ sheetSolutionFrom sheet
markingText <- runMaybeT $ assertM_ (Authorized ==) (evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
$(widgetFile "sheetShow")
getSPseudonymR, postSPseudonymR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent

6
src/Handler/Utils/Form.hs
View File

@ -318,7 +318,7 @@ nullaryPathPiece ''SheetGrading' (camelToPathPiece . dropSuffix "'")
embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)
data SheetType' = Normal' | Bonus' | Informational' | NotGraded'
data SheetType' = NotGraded' | Normal' | Bonus' | Informational'
deriving (Eq, Ord, Read, Show, Enum, Bounded)
instance Universe SheetType'
@ -328,7 +328,7 @@ nullaryPathPiece ''SheetType' (camelToPathPiece . dropSuffix "'")
embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)
data SheetGroup' = Arbitrary' | RegisteredGroups' | NoGroups'
data SheetGroup' = NoGroups' | Arbitrary' | RegisteredGroups'
deriving (Eq, Ord, Read, Show, Enum, Bounded)
instance Universe SheetGroup'
@ -498,7 +498,7 @@ secretJsonField = Field{..}
<input id=#{theId} name=#{name} *{attrs} type=hidden value=#{either id id val'}>
|]
fieldEnctype = UrlEncoded
funcForm :: forall k v m.
( Finite k, Ord k

18
src/Handler/Utils/Table/Pagination.hs
View File

@ -9,6 +9,7 @@ module Handler.Utils.Table.Pagination
, DBRow(..), _dbrOutput, _dbrIndex, _dbrCount
, DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..)
, DBTable(..), IsDBTable(..), DBCell(..)
, singletonFilter
, DBParams(..)
, cellAttrs, cellContents
, PagesizeLimit(..)
@ -205,7 +206,7 @@ deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 1
, sumEncoding = UntaggedValue
} ''PagesizeLimit
data PaginationSettings = PaginationSettings
{ psSorting :: [SortingSetting]
@ -358,6 +359,15 @@ defaultDBSFilterLayout :: Widget -- ^ Filter UI
-> Widget
defaultDBSFilterLayout filterWgdt filterEnctype filterAction scrolltable = $(widgetFile "table/layout-filter-default")
singletonFilter :: Ord k => k -> Prism' (Map k [v]) (Maybe v)
-- ^ for use with @prismAForm@
singletonFilter key = prism' fromInner (fmap Just . fromOuter)
where
fromInner = maybe Map.empty $ Map.singleton key . pure
fromOuter = Map.lookup key >=> listToMaybe
data DBTable m x = forall a r r' h i t k k'.
( ToSortable h, Functor h
, E.SqlSelect a r, SqlIn k k', DBTableKey k'
@ -723,7 +733,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
setParams :: Text -> [Text] -> QueryText -> QueryText
setParams key vs qt = map ((key, ) . Just) vs ++ [ i | i@(key', _) <- qt, key' /= key ]
setParam :: Text -> Maybe Text -> QueryText -> QueryText
setParam key = setParams key . maybeToList
@ -756,7 +766,7 @@ pagesizeField psLim = selectField $ do
optText (PagesizeLimit l) = tshow l
optText PagesizeAll = mr MsgDBTablePagesizeAll
toOptionList = flip OptionList fromPathPiece . map (\o -> Option (optText o) o $ toPathPiece o) . Set.toAscList . Set.fromList
toOptionList = flip OptionList fromPathPiece . map (\o -> Option (optText o) o $ toPathPiece o) . Set.toAscList . Set.fromList
return $ toOptionList limOpts
where
limOpts :: [PagesizeLimit]
@ -852,7 +862,7 @@ formCell resLens genIndex genForm input@(DBRow{dbrKey}) = FormCell
mkUnique (toPathPiece -> name) = name <> "-" <> decodeUtf8 (Base64.encode rowKeyHash)
where
rowKeyHash = (BA.convert :: HMAC (SHAKE256 264) -> ByteString) . hmac hashKey . LBS.toStrict $ B.encode dbrKey
(edit, w) <- genForm input mkUnique
(edit, w) <- genForm input mkUnique
return (flip (set resLens) mempty . DBFormResult . Map.singleton i . (input,) <$> edit, w)
}

6
src/Model/Types.hs
View File

@ -179,10 +179,10 @@ sheetGradeSum gr (Just p) =
data SheetType
= Normal { grading :: SheetGrading }
= NotGraded
| Normal { grading :: SheetGrading }
| Bonus { grading :: SheetGrading }
| Informational { grading :: SheetGrading }
| NotGraded
deriving (Eq, Read, Show, Generic)
deriveJSON defaultOptions
@ -320,7 +320,7 @@ derivePersistField "ExamStatus"
-- | Specify a corrector's workload
data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rational }
= Load { byTutorial :: Maybe Bool -- ^ Just all from Tutorial, True if counting towards overall workload
= Load { byTutorial :: Maybe Bool -- ^ @Just@ all from Tutorial, @True@ if counting towards overall workload
, byProportion :: Rational -- ^ workload proportion of all submission not assigned to tutorial leaders
}
deriving (Show, Read, Eq, Ord, Generic)

4
src/Utils.hs
View File

@ -353,6 +353,10 @@ maybeT x m = runMaybeT m >>= maybe x return
maybeT_ :: Monad m => MaybeT m () -> m ()
maybeT_ = void . runMaybeT
hoistMaybe :: MonadPlus m => Maybe a -> m a
-- ^ `hoist` regarding `Maybe` as if identical to @MaybeT Identity@
hoistMaybe = maybe mzero return
catchIfMaybeT :: (MonadCatch m, Exception e) => (e -> Bool) -> m a -> MaybeT m a
catchIfMaybeT p act = catchIf p (lift act) (const mzero)

6
src/Utils/Form.hs
View File

@ -447,3 +447,9 @@ hoistField f Field{..} = Field
, fieldView
, fieldEnctype
}
prismAForm :: Monad m => Prism' s a -> Maybe s -> (Maybe a -> AForm m a) -> AForm m s
-- ^ @Monad m => Prism' s a -> (Maybe a -> AForm m a) -> (Maybe s -> AForm m s)@
prismAForm p outer form = review p <$> form inner
where
inner = outer >>= preview p

6
src/Utils/Lens.hs
View File

@ -10,6 +10,12 @@ import qualified Database.Esqueleto as E (Value(..),InnerJoin(..))
_unValue :: Lens' (E.Value a) a
_unValue f (E.Value a) = E.Value <$> f a
_PathPiece :: PathPiece v => Prism' Text v
_PathPiece = prism' toPathPiece fromPathPiece
maybePrism :: Prism' a b -> Prism' (Maybe a) (Maybe b)
maybePrism p = prism' (fmap $ review p) (fmap $ preview p )
_InnerJoinLeft :: Lens' (E.InnerJoin l r) l -- forall f. Functor f => (a -> f a) -> s -> f s
_InnerJoinLeft f (E.InnerJoin l r) = (`E.InnerJoin` r) <$> f l

7
templates/correction.hamlet
View File

@ -1,7 +1,12 @@
<section>
^{userCorrection}
<section>
$maybe marktxt <- sheetMarkingText
<section>
<h2>_{MsgSheetMarking}
<p>
#{marktxt}
<section>
<form method=post enctype=#{corrEncoding} action=@{CSubmissionR tid ssh csh shn cid CorrectionR}>
^{corrForm}

10
templates/sheetShow.hamlet
View File

@ -17,8 +17,6 @@ $maybe descr <- sheetDescription sheet
$maybe solution <- solutionFrom <* guard hasSolution
<dt .deflist__dt>_{MsgSheetSolutionFrom}
<dd .deflist__dd>#{solution}
<dt .deflist__dt>_{MsgSheetType}
<dd .deflist__dd>_{sheetType sheet}
<dt .deflist__dt>_{MsgSheetSubmissionMode}
<dd .deflist__dd>_{sheetSubmissionMode sheet}
$case sheetSubmissionMode sheet
@ -37,6 +35,14 @@ $maybe descr <- sheetDescription sheet
<form method=post action=@{CSheetR tid ssh csh shn SPseudonymR} enctype=#{generateEnctype}>
^{generateWidget}
$of _
<dt .deflist__dt>_{MsgSheetType}
<dd .deflist__dd>_{sheetType sheet}
$maybe marktxt <- markingText
<section>
<h2>_{MsgSheetMarking}
<p>
#{marktxt}
$if hasFiles
<section>

2
templates/widgets/gradingSummary.hamlet
View File

@ -36,7 +36,7 @@ $# --
<td .table__td colspan=2>
$maybe _ <- hasPoints
<td .table__td>
<td .table__td>#{display nrNoGrade}
<td .table__td>#{nrNoGrade}
$maybe _ <- positiveSum $ bonusSummary ^. _numSheets
<p>_{MsgSheetTypeInfoBonus} #
$maybe _ <- positiveSum $ bonusSummary ^. _achievedPoints