Sheet editing working, except for files

messages/de.msg

@@ -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}.
+

src/Handler/Sheet.hs

@@ -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

src/Model/Types.hs

@@ -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 }

templates/sheetShow.hamlet

@@ -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}