diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 7a1d136b6..4af81682c 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -38,10 +38,10 @@ CourseRegisterOk: Sie wurden angemeldet
CourseDeregisterOk: Sie wurden abgemeldet
CourseSecretWrong: Falsches Kennwort
CourseSecret: Zugangspasswort
-CourseNewOk tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} wurde erfolgreich erstellt.
-CourseEditOk tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} wurde erfolgreich geändert.
-CourseNewDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
-CourseEditDupShort tid@TermId courseShortHand@CourseShorthand: Kurs #{display tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
+CourseNewOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde erfolgreich erstellt.
+CourseEditOk tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} wurde erfolgreich geändert.
+CourseNewDupShort tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
+CourseEditDupShort tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
FFSheetName: Name
TermCourseListHeading tid@TermId: Kursübersicht #{display tid}
CourseListTitle: Alle Kurse
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 0ad0e1637..2081aa833 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -80,12 +80,12 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm)
colSchool :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
- $ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } ->
+ $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}) } ->
anchorCell (SchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolName}|]
colSchoolShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort)
- $ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } ->
+ $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}) } ->
anchorCell (SchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolShorthand}|]
colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
@@ -289,12 +289,12 @@ postCourseNewR = courseEditHandler False Nothing
getCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCEditR tid ssh csh = do
- course <- runDB $ getBy $ CourseTermShort tid ssh csh
+ course <- runDB $ getBy $ CourseTermSchoolShort tid ssh csh
courseEditHandler True course
postCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
postCEditR tid ssh csh = do
- course <- runDB $ getBy $ CourseTermShort tid ssh csh
+ course <- runDB $ getBy $ CourseTermSchoolShort tid ssh csh
courseEditHandler False course
@@ -431,7 +431,6 @@ newCourseForm template = identForm FIDcourse $ \html -> do
[ map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. userId] []
, map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. userId] []
]
- let schoolField = selectField $ fmap entityKey <$> optionsPersistCryptoId [SchoolId <-. userSchools] [Asc SchoolName] schoolName
(result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
<$> pure (cfCourseId =<< template)
<*> areq (ciField textField) (fslI MsgCourseName) (cfName <$> template)
@@ -442,24 +441,19 @@ newCourseForm template = identForm FIDcourse $ \html -> do
-- & addAttr "disabled" "disabled"
& setTooltip MsgCourseShorthandUnique)
(cfShort <$> template)
- <*> areq termActiveField (fslI MsgCourseSemester) (cfTerm <$> template)
- <*> areq schoolField (fslI MsgCourseSchool) (cfSchool <$> template)
- <*> aopt (natField "Kapazität") (fslI MsgCourseCapacity
- & setTooltip MsgCourseCapacityTip
- ) (cfCapacity <$> template)
- <*> aopt textField (fslpI MsgCourseSecret "beliebige Zeichenkette"
- & setTooltip MsgCourseSecretTip)
- (cfSecret <$> template)
- <*> areq checkBoxField (fslI MsgMaterialFree)(cfMatFree <$> template)
- <*> aopt utcTimeField (fslpI MsgRegisterFrom "Datum"
- & setTooltip MsgCourseRegisterFromTip)
- (cfRegFrom <$> template)
- <*> aopt utcTimeField (fslpI MsgRegisterTo "Datum"
- & setTooltip MsgCourseRegisterToTip)
- (cfRegTo <$> template)
- <*> aopt utcTimeField (fslpI MsgDeRegUntil "Datum"
- & setTooltip MsgCourseDeregisterUntilTip)
- (cfDeRegUntil <$> template)
+ <*> areq termActiveField (fslI MsgCourseSemester) (cfTerm <$> template)
+ <*> areq (schoolFieldFor userSchools) (fslI MsgCourseSchool) (cfSchool <$> template)
+ <*> aopt (natField "Kapazität") (fslI MsgCourseCapacity
+ & setTooltip MsgCourseCapacityTip) (cfCapacity <$> template)
+ <*> aopt textField (fslpI MsgCourseSecret "beliebige Zeichenkette"
+ & setTooltip MsgCourseSecretTip) (cfSecret <$> template)
+ <*> areq checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template)
+ <*> aopt utcTimeField (fslpI MsgRegisterFrom "Datum"
+ & setTooltip MsgCourseRegisterFromTip) (cfRegFrom <$> template)
+ <*> aopt utcTimeField (fslpI MsgRegisterTo "Datum"
+ & setTooltip MsgCourseRegisterToTip) (cfRegTo <$> template)
+ <*> aopt utcTimeField (fslpI MsgDeRegUntil "Datum"
+ & setTooltip MsgCourseDeregisterUntilTip) (cfDeRegUntil <$> template)
<* submitButton
return $ case result of
FormSuccess courseResult
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index 683abe697..41207f774 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -22,12 +22,12 @@ import Data.Time hiding (formatTime)
-- import Web.PathPieces (showToPathPiece, readFromPathPiece)
-import Control.Lens
-import Colonnade hiding (fromMaybe, singleton)
+-- import Control.Lens
+-- import Colonnade hiding (fromMaybe, singleton)
-- import Yesod.Colonnade
import qualified Database.Esqueleto as E
-import Text.Shakespeare.Text
+-- import Text.Shakespeare.Text
import Development.GitRev
@@ -55,7 +55,6 @@ getHomeR = do
homeAnonymous :: Handler Html
homeAnonymous = do
cTime <- liftIO getCurrentTime
- let fTime = addUTCTime (offCourseDeadlines * nominalDay) cTime
let tableData :: E.SqlExpr (Entity Course)
-> E.SqlQuery (E.SqlExpr (Entity Course))
tableData course = do
@@ -68,9 +67,9 @@ 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") (textCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
textCell $ display $ courseTerm course
- , sortable (Just "school") (textCell MsgCourseSchool) $ DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
+ , sortable (Just "school") (textCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
textCell $ display $ courseSchool course
, sortable (Just "course") (textCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
let tid = courseTerm course
@@ -122,6 +121,7 @@ homeUser uid = do
-- (E.SqlExpr (Entity Course )))
-- (E.SqlExpr (Entity Sheet ))
_ -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
+ , E.SqlExpr (E.Value SchoolId)
, E.SqlExpr (E.Value CourseShorthand)
, E.SqlExpr (E.Value SheetName)
, E.SqlExpr (E.Value UTCTime)
@@ -166,7 +166,7 @@ homeUser uid = do
anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
, sortable (Just "deadline") (textCell 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") (textCell 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)
@@ -176,8 +176,8 @@ homeUser uid = do
((), sheetTable) <- dbTable validator $ DBTable
{ dbtSQLQuery = tableData
, dbtColonnade = colonnade
- , dbtProj = \dbRow@DBRow{ dbrOutput = (E.Value tid, E.Value csh, E.Value shn, _, _) }
- -> dbRow <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh shn SShowR) False)
+ , dbtProj = \row@DBRow{ dbrOutput = (E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) }
+ -> row <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SShowR) False)
, dbtSorting = Map.fromList
[ ( "term"
, SortColumn $ \(_ `E.InnerJoin` course `E.InnerJoin` _ `E.LeftOuterJoin` _) -> course E.^. CourseTerm
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index 5fa74b98c..c54945b70 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -141,7 +141,7 @@ postProfileR = do
getProfileDataR :: Handler Html
getProfileDataR = do
- (uid, User{..}) <- requireAuthPair
+ (_uid, User{..}) <- requireAuthPair
-- mr <- getMessageRender
defaultLayout $ do
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 8359e59ca..cba7a981f 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -21,31 +21,31 @@ import Import
import System.FilePath (takeFileName)
import Handler.Utils
-import Handler.Utils.Zip
+-- import Handler.Utils.Zip
-- import Data.Time
-import qualified Data.Text as T
+-- import qualified Data.Text as T
-- import Data.Function ((&))
--
-import Colonnade hiding (fromMaybe, singleton, bool)
+-- import Colonnade hiding (fromMaybe, singleton, bool)
import qualified Yesod.Colonnade as Yesod
import Text.Blaze (text)
--
-import qualified Data.UUID.Cryptographic as UUID
+-- import qualified Data.UUID.Cryptographic as UUID
import qualified Data.Conduit.List as C
-import Data.CaseInsensitive (CI)
+-- import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import qualified Database.Esqueleto as E
-import qualified Database.Esqueleto.Internal.Sql as E
+-- import qualified Database.Esqueleto.Internal.Sql as E
import Control.Monad.Writer (MonadWriter(..), execWriterT)
-import Control.Monad.Trans.RWS.Lazy (RWST, local)
+-- import Control.Monad.Trans.RWS.Lazy (RWST, local)
-import qualified Text.Email.Validate as Email
+-- import qualified Text.Email.Validate as Email
-import qualified Data.List as List
+-- import qualified Data.List as List
import Network.Mime
@@ -59,7 +59,7 @@ import qualified Data.Map as Map
import Data.Monoid (Sum(..))
import Control.Lens
-import Utils.Lens
+-- import Utils.Lens
instance Eq (Unique Sheet) where
@@ -166,14 +166,14 @@ getSheetListR tid ssh csh = do
E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
- let sheetEdit = E.sub_select . E.from $ \sheetEdit -> do
- E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
- return . E.max_ $ sheetEdit E.^. SheetEditTime
+ let sheetEdit = E.sub_select . E.from $ \sheetEdit' -> do
+ E.where_ $ sheetEdit' E.^. SheetEditSheet E.==. sheet E.^. SheetId
+ return . E.max_ $ sheetEdit' E.^. SheetEditTime
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
return (sheet, sheetEdit, submission)
sheetCol = widgetColonnade . mconcat $
[ sortable (Just "name") (i18nCell MsgSheet)
- $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName)
+ $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
, sortable (Just "last-edit") (i18nCell MsgLastEdit)
$ \(_, E.Value mEditTime, _) -> case mEditTime of
Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
@@ -190,9 +190,9 @@ getSheetListR tid ssh csh = do
(Just (Entity sid Submission{..})) ->
let mkCid = encrypt sid -- TODO: executed twice
mkRoute = do
- cid <- mkCid
- return $ CSubmissionR tid csh sheetName cid SubShowR
- in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
+ cid' <- mkCid
+ return $ CSubmissionR tid ssh csh sheetName cid' SubShowR
+ in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{display cid2}|])
, sortable (Just "rating") (i18nCell MsgRating)
$ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
Nothing -> mempty
@@ -200,7 +200,7 @@ getSheetListR tid ssh csh = do
let mkCid = encrypt sid
mkRoute = do
cid <- mkCid
- return $ CSubmissionR tid csh sheetName cid CorrectionR
+ return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
protoCell = anchorCellM mkRoute $(widgetFile "widgets/rating")
in protoCell & cellContents %~ (<* tell (sheetTypeSum (sheetType, submissionRatingPoints)))
, sortable Nothing -- (Just "percent")
@@ -271,7 +271,7 @@ getSShowR tid ssh csh shn = do
-- E.where_ (sheet E.^. SheetId E.==. E.val sid )
-- -- return desired columns
-- return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
--- let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid csh (SheetFileR shn fType fName),modified)) fileNameTypes
+-- let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid ssh csh (SheetFileR shn fType fName),modified)) fileNameTypes
-- with Colonnade
let fileData (sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) = do
@@ -295,7 +295,7 @@ getSShowR tid ssh csh shn = do
{ dbtSQLQuery = fileData
, dbtColonnade = colonnadeFiles
, dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) }
- -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh shn $ SFileR fType fName) False)
+ -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn $ SFileR fType fName) False)
, dbtStyle = def
, dbtFilter = Map.empty
, dbtIdent = "files" :: Text
@@ -319,7 +319,7 @@ getSShowR tid ssh csh shn = do
when (NTop (sheetVisibleFrom sheet) >= NTop cTime) $ addMessageI "warning" $
maybe MsgSheetInvisible MsgSheetInvisibleUntil visibleFrom
defaultLayout $ do
- setTitleI $ MsgSheetTitle tid csh shn
+ setTitleI $ MsgSheetTitle tid ssh csh shn
sheetFrom <- formatTime SelFormatDateTime $ sheetActiveFrom sheet
sheetTo <- formatTime SelFormatDateTime $ sheetActiveTo sheet
hintsFrom <- traverse (formatTime SelFormatDateTime) $ sheetHintFrom sheet
@@ -402,7 +402,7 @@ getSEditR tid ssh csh shn = do
postSEditR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
postSEditR = getSEditR
-handleSheetEdit :: TermId -> SchoolId -< CourseShorthand -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
+handleSheetEdit :: TermId -> SchoolId -> CourseShorthand -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
handleSheetEdit tid ssh csh msId template dbAction = do
let mbshn = sfName <$> template
aid <- requireAuthId
@@ -456,7 +456,7 @@ getSDelR tid ssh csh shn = do
case result of
(FormSuccess BtnAbort) -> redirectUltDest $ CSheetR tid ssh csh shn SShowR
(FormSuccess BtnDelete) -> do
- runDB $ fetchSheetId tid csh shn >>= deleteCascade
+ runDB $ fetchSheetId tid ssh csh shn >>= deleteCascade
-- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!!
addMessageI "info" $ MsgSheetDelOk tid ssh csh shn
redirect $ CourseR tid ssh csh SheetListR
@@ -464,7 +464,7 @@ getSDelR tid ssh csh shn = do
submissionno <- runDB $ do
sid <- fetchSheetId tid ssh csh shn
count [SubmissionSheet ==. sid]
- let formTitle = MsgSheetDelHead tid csh shn
+ let formTitle = MsgSheetDelHead tid ssh csh shn
let formText = Just $ MsgSheetDelText submissionno
let actionUrl = CSheetR tid ssh csh shn SDelR
defaultLayout $ do
@@ -688,10 +688,10 @@ getSCorrR tid ssh csh shn = do
FormMissing -> return ()
let
- -- formTitle = MsgSheetCorrectorsTitle tid csh shn
+ -- formTitle = MsgSheetCorrectorsTitle tid ssh csh shn
formText = Nothing :: Maybe (SomeMessage UniWorX)
actionUrl = CSheetR tid ssh csh shn SCorrR
- -- actionUrl = CSheetR tid csh shn SShowR
+ -- actionUrl = CSheetR tid ssh csh shn SShowR
defaultLayout $ do
setTitleI $ MsgSheetCorrectorsTitle tid ssh csh shn
$(widgetFile "formPageI18n")
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index 09340ce3d..e55a8a25f 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -78,14 +78,14 @@ makeSubmissionForm msmid unpackZips grouping buddies = identForm FIDsubmission $
aforced' f fs (Just (Just v)) = Just <$> aforced f fs v
aforced' _ _ _ = error "Cannot happen since groupNr==0 if grouping/=Arbitrary"
-getSubmissionNewR, postSubmissionNewR :: TermId -> CourseShorthand -> SheetName -> Handler Html
+getSubmissionNewR, postSubmissionNewR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSubmissionNewR = postSubmissionNewR
-postSubmissionNewR tid csh shn = submissionHelper tid csh shn NewSubmission
+postSubmissionNewR tid ssh csh shn = submissionHelper tid ssh csh shn NewSubmission
-getSubShowR, postSubShowR :: TermId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
+getSubShowR, postSubShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSubShowR = postSubShowR
-postSubShowR tid csh shn cid = submissionHelper tid csh shn $ ExistingSubmission cid
+postSubShowR tid ssh csh shn cid = submissionHelper tid ssh csh shn $ ExistingSubmission cid
getSubmissionOwnR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSubmissionOwnR tid ssh csh shn = do
@@ -108,7 +108,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
uid <- requireAuthId
msmid <- traverse decrypt mcid
(Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do
- sheet@(Entity shid Sheet{..}) <- fetchSheet tid csh shn
+ sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn
case msmid of
Nothing -> do
submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
@@ -239,7 +239,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
_other -> return Nothing
case mCID of
- Just cID -> redirect $ CSubmissionR tid csh shn cID SubShowR
+ Just cID -> redirect $ CSubmissionR tid ssh csh shn cID SubShowR
Nothing -> return ()
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
@@ -254,13 +254,13 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr
Just isFile = origIsFile <|> corrIsFile
in if
- | Just True <- origIsFile -> anchorCell (CSubmissionR tid csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
+ | Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
([whamlet|#{fileTitle'}|])
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
, sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of
Nothing -> cell mempty
Just (_, Entity _ File{..})
- | isJust fileContent -> anchorCell (CSubmissionR tid csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
+ | isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
([whamlet|_{MsgFileCorrected}|])
| otherwise -> textCell MsgFileCorrected
, sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
@@ -302,19 +302,19 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
mFileTable <- traverse (fmap snd . dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
defaultLayout $ do
- setTitleI $ MsgSubmissionEditHead tid csh shn
+ setTitleI $ MsgSubmissionEditHead tid ssh csh shn
$(widgetFile "submission")
-getSubDownloadR :: TermId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
-getSubDownloadR tid csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
+getSubDownloadR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
+getSubDownloadR tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
runDB $ do
- submissionID <- submissionMatchesSheet tid csh shn cID
+ submissionID <- submissionMatchesSheet tid ssh csh shn cID
isRating <- maybe False (== submissionID) <$> isRatingFile path
when (isUpdate || isRating) $
- guardAuthResult =<< evalAccessDB (CSubmissionR tid csh shn cID CorrectionR) False
+ guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False
case isRating of
True
@@ -343,10 +343,10 @@ getSubDownloadR tid csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path =
$logErrorS "SubDownloadR" $ "Multiple matching files: " <> tshow other
error "Multiple matching files found."
-getSubArchiveR :: TermId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> ZIPArchiveName SubmissionFileType -> Handler TypedContent
-getSubArchiveR tid csh shn cID (ZIPArchiveName sfType) = do
+getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> ZIPArchiveName SubmissionFileType -> Handler TypedContent
+getSubArchiveR tid ssh csh shn cID (ZIPArchiveName sfType) = do
when (sfType == SubmissionCorrected) $
- guardAuthResult =<< evalAccess (CSubmissionR tid csh shn cID CorrectionR) False
+ guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False
let filename
| SubmissionOriginal <- sfType = ZIPArchiveName $ toPathPiece cID <> "-" <> toPathPiece sfType
@@ -354,7 +354,7 @@ getSubArchiveR tid csh shn cID (ZIPArchiveName sfType) = do
addHeader "Content-Disposition" [st|attachment; filename="#{toPathPiece filename}"|]
respondSourceDB "application/zip" $ do
- submissionID <- lift $ submissionMatchesSheet tid csh shn cID
+ submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
rating <- lift $ getRating submissionID
let
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index c415769a7..fbb5ed22c 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -219,7 +219,15 @@ pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..}
return . fromRational $ round (sci * 100) % 100
--termField: see Utils.Term
---schoolField: see Handler.Course
+
+schoolField :: Field Handler SchoolId
+schoolField = selectField $ optionsPersistKey [] [Asc SchoolName] schoolName
+
+schoolFieldEnt :: Field Handler (Entity School)
+schoolFieldEnt = selectField $ optionsPersist [] [Asc SchoolName] schoolName
+
+schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
+schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolId <-. userSchools] [Asc SchoolName] schoolName
zipFileField :: Bool -- ^ Unpack zips?
-> Field Handler (Source Handler File)
diff --git a/src/Utils.hs b/src/Utils.hs
index 67dfbdd18..d3549bc97 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -86,6 +86,11 @@ unsupportedAuthPredicate = do
tickmark :: IsString a => a
tickmark = fromString "✔"
+-- Avoid annoying warnings:
+tickmarkS :: String
+tickmarkS = tickmark
+tickmarkT :: Text
+tickmarkT = tickmark
text2Html :: Text -> Html
text2Html = toHtml -- prevents ambiguous types
diff --git a/templates/course.hamlet b/templates/course.hamlet
index f45717007..f63629fee 100644
--- a/templates/course.hamlet
+++ b/templates/course.hamlet
@@ -33,7 +33,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)