diff --git a/FragenSJ.txt b/FragenSJ.txt index 55d0bd4aa..8bdb6f8e6 100644 --- a/FragenSJ.txt +++ b/FragenSJ.txt @@ -1,5 +1,8 @@ ** i18n: - - i18n der Links, Page Titles und Buttons? + - i18n der + Links -> + Page Titles -> setTitleI + Buttons? Was ist mit einfachen Text Feldern, z.B. die Beschriftung von Knöpfen wie in Handler.Course.getCourseListTermR, Zeile 66 "pageActions" für menuItemLabel? Was ist mit PageTitles, z.B. in Handler.Term.termEditHandler: -- setTitle [whamlet| _{MsgTermNewTitle} |] -- TODO, does not work @@ -10,9 +13,6 @@ ** FORMS - 1- Handler.Utils.Form.FormIdentifier: Still needed? - 2- Verification of Ownership during Edit? - D.h. wo wird geprüft, dass Sheet Ersteller Lecturer im Kurs ist? 3 - Sheets: Multiple Files - Versionen für Studenten/Korrektoren/Lecturers/Admins?! diff --git a/routes b/routes index 04c5c77c9..8717ecd9b 100644 --- a/routes +++ b/routes @@ -22,6 +22,7 @@ /course/#TermId/#Text/sheet/#Text/show SheetShowR GET /course/#TermId/#Text/sheet/#Text/#SheetFileType/#FilePath SheetFileR GET /course/#TermId/#Text/sheet/new SheetNewR GET POST +-- TODO: Change routes to #Text statt #SheetId /course/#TermId/#Text/sheet/#SheetId/edit SheetEditR GET POST /course/#TermId/#Text/sheet/#SheetId/delete SheetDelR GET POST diff --git a/src/Foundation.hs b/src/Foundation.hs index a060fdc93..8fa0a34bf 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -200,6 +200,9 @@ isAuthorizedDB TermEditR _ = adminAccess Nothing isAuthorizedDB (TermEditExistR _) _ = adminAccess Nothing isAuthorizedDB CourseNewR _ = lecturerAccess Nothing isAuthorizedDB (CourseEditR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) +isAuthorizedDB (SheetListR t c) False = return Authorized -- +isAuthorizedDB (SheetShowR t c s) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor +isAuthorizedDB (SheetFileR t c s _ _ )_ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor isAuthorizedDB (SheetListR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) isAuthorizedDB (SheetNewR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) isAuthorizedDB (SheetEditR t c s) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 33ded9169..a95e3e719 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -48,7 +48,7 @@ data SheetForm = SheetForm , sfHintF :: Maybe FileInfo , sfSolutionFrom :: Maybe UTCTime , sfSolutionF :: Maybe FileInfo - , sfSheetId :: Maybe SheetId + -- Keine SheetId im Formular! } @@ -57,11 +57,10 @@ makeSheetForm cid template = identForm FIDsheet $ \html -> do -- TODO: Yesod.Form.MassInput.inputList arbeitet Server-seitig :( -- Erstmal nur mit ZIP arbeiten (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm - <$> areq textField (fsb "Name") (sfName <$> template) + <$> areq textField (fsb "Name") (sfName <$> template) <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfMarkingText <$> template) - <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) + <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) <*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template) - --TODO: SICHTBARKEIT hinzunehmen <*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template) <*> aopt utcTimeField (fsb "Sichtbar ab") (sfVisibleFrom <$> template) <*> areq utcTimeField (fsb "Abgabe ab") (sfActiveFrom <$> template) @@ -71,7 +70,6 @@ makeSheetForm cid template = identForm FIDsheet $ \html -> do <*> fileAFormOpt (fsb "Hinweis") <*> aopt utcTimeField (fsb "Lösung ab") (sfSolutionFrom <$> template) <*> fileAFormOpt (fsb "Lösung") - <*> aopt hiddenField "EditSheetId" (sfSheetId <$> template) <* submitButton return $ case result of FormSuccess sheetResult @@ -156,29 +154,27 @@ getSheetList courseEnt = do -- Show single sheet getSheetShowR :: TermId -> Text -> Text -> Handler Html -getSheetShowR tid csh shn = getSheetShow =<< - (runDB $ fetchSheet tid csh shn) - -{- Nur per UUID -getSheetIdShowR :: SheetId -> Handler Html -getSheetIdShowR sheetId = getSheetShow =<< - (Entity sheetId) <$> (runDB $ get404 sheetId)\ --}{- -getSheetUUIDShowR :: CryptoUUIDSheet -> Handler Html -getSheetUUIDShowR sUUID = do - cIDKey <- getsYesod appCryptoIDKey - sheetId <- UUID.decrypt cIDKey sUUID - sheetEnt <- runDB $ get404 sheetId - getSheetShow $ Entity sheetId sheetEnt --} - -getSheetShow :: (Entity Sheet) -> Handler Html -getSheetShow entSheet = do +getSheetShowR tid csh shn = do + entSheet <- runDB $ fetchSheet tid csh shn let sheet = entityVal entSheet + sid = entityKey entSheet + -- + fileNameTypes <- runDB $ E.select $ E.from $ + \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do + -- Restrict to consistent rows that correspond to each other + E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFileId) + E.on (sheetFile E.^. SheetFileSheetId E.==. sheet E.^. SheetId) + -- filter to requested file + E.where_ (sheet E.^. SheetId E.==. E.val sid ) + -- return desired columns + return $ (file E.^. FileTitle, sheetFile E.^. SheetFileType) + let fileLinks = map (\(E.Value fName, E.Value fType) -> SheetFileR tid csh shn fType fName) fileNameTypes + defaultLayout $ do setTitle $ toHtml $ T.append "Übung " $ sheetName sheet - [whamlet| Under Construction !!! |] -- TODO $(widgetFile "sheetAdmin") + [whamlet| Under Construction !!! |] -- TODO + getSheetFileR :: TermId -> Text -> Text -> SheetFileType -> FilePath -> Handler TypedContent getSheetFileR tid csh shn typ title = do @@ -209,7 +205,6 @@ getSheetNewR :: TermId -> Text -> Handler Html getSheetNewR tid csh = do let tident = unTermKey tid aid <- requireAuthId - -- TODO: Verify that aid is lecturer in Course? Here or in Auth? (Entity cid course) <- runDB $ getBy404 $ CourseTermShort tid csh let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days ((res,wdgt), enc) <- runFormPost $ makeSheetForm cid template @@ -233,20 +228,33 @@ getSheetNewR tid csh = do , sheetCreatedBy = aid , sheetChangedBy = aid } - insertOkay <- runDB $ insertUnique sheet - case insertOkay of - Nothing -> addMessageI "danger" $ MsgSheetNewDup tident csh sfName - (Just sid) -> do - addMessageI "info" $ MsgSheetNewOk tident csh sfName - -- Save Files in DB: - -- Prüfe, das FileTitle innerhalb des Sheets eindeutig ist für diesen SheetFileTpye - whenIsJust sfSheetF $ \sinfo -> do - let sheetInsert file = do - fid <- insert file - void . insert $ SheetFile sid fid SheetExercise -- Uniqueness? - runDB . runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert - - redirect $ SheetShowR tid csh sfName + saveOkay <- runDB $ do + insertOkay <- insertUnique sheet + case insertOkay of + Nothing -> insertOkay <$ addMessageI "danger" (MsgSheetNewDup tident csh sfName) + (Just sid) -> do + addMessageI "info" $ MsgSheetNewOk tident csh sfName + -- Save Files in DB: + -- Prüfe, das FileTitle innerhalb des Sheets eindeutig ist für diesen SheetFileTpye + whenIsJust sfSheetF $ \sinfo -> do + let sheetInsert file = do + fid <- insert file + void . insert $ SheetFile sid fid SheetExercise -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step + runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert + -- + whenIsJust sfHintF $ \sinfo -> do + let sheetInsert file = do + fid <- insert file + void . insert $ SheetFile sid fid SheetHint -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step + runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert + -- + whenIsJust sfSolutionF $ \sinfo -> do + let sheetInsert file = do + fid <- insert file + void . insert $ SheetFile sid fid SheetSolution -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step + runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert + return insertOkay + when (isJust saveOkay) $ redirect $ SheetShowR tid csh sfName (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml _ -> return () defaultLayout $ do diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index ca0a66bc0..14e9d1271 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -1,12 +1,15 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-} {-# LANGUAGE QuasiQuotes #-} + module Handler.Utils ( module Handler.Utils ) where + + import Import.NoFoundation import Handler.Utils.DateTime as Handler.Utils @@ -22,6 +25,9 @@ import Text.Blaze (Markup, ToMarkup) import Data.Map (Map) import qualified Data.Map as Map +import qualified Data.List as List + +import Database.Persist.Class tickmark :: IsString a => a tickmark = fromString "✔" @@ -61,3 +67,38 @@ whenIsJust Nothing _ = return () entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty + +-------- +-- DB -- +-------- + +myReplaceUnique + :: (MonadIO m + ,Eq (Unique record) + ,PersistRecordBackend record backend + ,PersistUniqueWrite backend) + => Key record -> record -> ReaderT backend m (Maybe (Unique record)) +myReplaceUnique key datumNew = getJust key >>= replaceOriginal + where + uniqueKeysNew = persistUniqueKeys datumNew + replaceOriginal original = do + conflict <- checkUniqueKeys changedKeys + case conflict of + Nothing -> replace key datumNew >> return Nothing + (Just conflictingKey) -> return $ Just conflictingKey + where + changedKeys = uniqueKeysNew List.\\ uniqueKeysOriginal + uniqueKeysOriginal = persistUniqueKeys original + +checkUniqueKeys + :: (MonadIO m + ,PersistEntity record + ,PersistUniqueRead backend + ,PersistRecordBackend record backend) + => [Unique record] -> ReaderT backend m (Maybe (Unique record)) +checkUniqueKeys [] = return Nothing +checkUniqueKeys (x:xs) = do + y <- getBy x + case y of + Nothing -> checkUniqueKeys xs + Just _ -> return (Just x) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 770a7f481..9ceadd8e7 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -35,9 +35,14 @@ data FormIdentifier = FIDcourse | FIDsheet deriving (Enum, Eq, Ord, Bounded, Read, Show) -identForm :: FormIdentifier -> Form a -> Form a -- TODO: Still needed? +identForm :: FormIdentifier -> Form a -> Form a identForm fid = identifyForm (T.pack $ show fid) +{- Hinweise zur Erinnerung: + - identForm primär, wenn es mehr als ein Formular pro Handler gibt + - nur einmal pro makeForm reicht +-} + ------------------- -- Form Renderer -- ------------------- diff --git a/templates/sheetAdmin.hamlet b/templates/sheetAdmin.hamlet index e7ea0f7bf..66bdf2d0e 100644 --- a/templates/sheetAdmin.hamlet +++ b/templates/sheetAdmin.hamlet @@ -24,7 +24,10 @@
-

Abgaben +

Dateien +