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

Sheet editing working, except for files

Browse Source
This commit is contained in:
SJost 2018-03-16 18:52:32 +01:00
parent daed94ae33
commit 037c0cce20
4 changed files with 79 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
messages/de.msg
View File

@ -8,4 +8,7 @@ CourseEditOk tid@TermIdentifier courseShortHand@Text: Kurs #{termToText ti
CourseNewDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
CourseEditDupShort tid@TermIdentifier courseShortHand@Text: Kurs #{termToText tid}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester.
SheetNewOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Neues Übungsblatt #{sheetName} wurde im Kurs #{termToText tid}-#{courseShortHand} erfolgreich erstellt.
SheetNewDup tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{termToText tid}-#{courseShortHand} erfolgreich erstellt!
SheetTitle tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand} #{sheetName}
SheetEditOk tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} aus Kurs #{termToText tid}-#{courseShortHand} wurde bearbeitet.
SheetNameDup tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{termToText tid}-#{courseShortHand}.

79
src/Handler/Sheet.hs
View File

@ -6,11 +6,12 @@
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
module Handler.Sheet where
import Import
import System.FilePath
import System.FilePath (takeFileName)
import Handler.Utils
import Handler.Utils.Zip
@ -30,6 +31,9 @@ import qualified Database.Esqueleto as E
import Network.Mime
instance Eq (Unique Sheet) where
(CourseSheet cid1 name1) == (CourseSheet cid2 name2) =
cid1 == cid2 && name1 == name2
{-
* Implement Handlers
@ -175,7 +179,7 @@ getSheetShowR tid csh shn = do
defaultLayout $ do
setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
$(widgetFile "sheetList")
$(widgetFile "sheetShow")
[whamlet| Under Construction !!! |] -- TODO
@ -214,7 +218,7 @@ getSheetNewR tid csh = do
case res of
(FormSuccess SheetForm{..}) -> do
actTime <- liftIO getCurrentTime
let sheet = Sheet
let newSheet = Sheet
{ sheetCourseId = cid
, sheetName = sfName
, sheetDescription = sfDescription
@ -232,9 +236,9 @@ getSheetNewR tid csh = do
, sheetChangedBy = aid
}
saveOkay <- runDB $ do
insertOkay <- insertUnique sheet
insertOkay <- insertUnique newSheet
case insertOkay of
Nothing -> insertOkay <$ addMessageI "danger" (MsgSheetNewDup tident csh sfName)
Nothing -> insertOkay <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName)
(Just sid) -> do
-- Save Files in DB:
whenIsJust sfSheetF $ insertSheetFile sid SheetExercise
@ -249,16 +253,77 @@ getSheetNewR tid csh = do
let actionUrl = SheetNewR tid csh
-- actionUrl <- getCurrentRoute
defaultLayout $ do
setTitleI $ MsgSheetTitle tident csh "NEW"
$(widgetFile "formPage")
postSheetNewR :: TermId -> Text -> Handler Html
postSheetNewR = getSheetNewR
getSheetEditR :: TermId -> Text -> SheetId -> Handler Html
getSheetEditR _ _ _ = defaultLayout [whamlet| Under Construction !!! |] -- TODO
getSheetEditR tid csh sid = do
let tident = unTermKey tid
aid <- requireAuthId
sheet@(Sheet {..}) <- runDB $ get404 sid
let template = Just $ SheetForm
{ sfName = sheetName
, sfDescription = sheetDescription
, sfType = sheetType
, sfGrouping = sheetGrouping
, sfMarkingText = sheetMarkingText
, sfVisibleFrom = sheetVisibleFrom
, sfActiveFrom = sheetActiveFrom
, sfActiveTo = sheetActiveTo
, sfSheetF = Nothing -- TODO
, sfHintFrom = sheetHintFrom
, sfHintF = Nothing -- TODO
, sfSolutionFrom = sheetSolutionFrom
, sfSolutionF = Nothing -- TODO
}
((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm sheetCourseId template
case res of
(FormSuccess SheetForm{..}) -> do
actTime <- liftIO getCurrentTime
let newSheet = Sheet
{ sheetCourseId = sheetCourseId -- Bad puns?
, sheetName = sfName
, sheetDescription = sfDescription
, sheetType = sfType
, sheetGrouping = sfGrouping
, sheetMarkingText = sfMarkingText
, sheetVisibleFrom = sfVisibleFrom
, sheetActiveFrom = sfActiveFrom
, sheetActiveTo = sfActiveTo
, sheetHintFrom = sfHintFrom
, sheetSolutionFrom = sfSolutionFrom
, sheetCreated = sheetCreated -- Bad puns?
, sheetChanged = actTime
, sheetCreatedBy = sheetChangedBy -- Bad puns?
, sheetChangedBy = aid
}
saveOkay <- runDB $ do
addMessage "debug" "Attempting update!"
insertOkay <- myReplaceUnique sid newSheet
case insertOkay of
(Just _) -> insertOkay <$ addMessageI "danger" (MsgSheetNameDup tident csh sfName)
Nothing -> do
-- Save Files in DB:
whenIsJust sfSheetF $ insertSheetFile sid SheetExercise
whenIsJust sfHintF $ insertSheetFile sid SheetHint
whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution
addMessageI "info" $ MsgSheetEditOk tident csh sfName
return insertOkay
when (isJust saveOkay) $ redirect $ SheetShowR tid csh sfName
(FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
_ -> return ()
let formTitle = "Übungsblatt bearbeiten" :: Text
let actionUrl = SheetEditR tid csh sid
-- actionUrl <- getCurrentRoute
defaultLayout $ do
setTitleI $ MsgSheetTitle tident csh sheetName
$(widgetFile "formPage")
postSheetEditR :: TermId -> Text -> SheetId -> Handler Html
postSheetEditR _ _ _ = defaultLayout [whamlet| Under Construction !!! |] -- TODO
postSheetEditR = getSheetEditR
getSheetDelR :: TermId -> Text -> SheetId -> Handler Html

2
src/Model/Types.hs
View File

@ -43,7 +43,7 @@ toPoints :: Integral a => a -> Points
toPoints = MkFixed . fromIntegral
fromPoints :: Integral a => Points -> a
fromPoints = error "TODO: Types.fromPoints not yet implemented"
fromPoints (MkFixed c) = fromInteger c
data SheetType
= Bonus { maxPoints :: Points }

3
templates/sheetList.hamlet → templates/sheetShow.hamlet
View File

@ -30,7 +30,8 @@
<li>
$case fileLink
$of SheetFileR _ _ _ typ name
#{toPathPiece typ} <a href=@{fileLink}>#{name}
#{toPathPiece typ}
<a href=@{fileLink}>#{name}
$of other
<a href=@{fileLink}>@{fileLink}