Sheet Download works
This commit is contained in:
SJost
parent
85f132295c
commit
c35f718054
@ -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?!
|
||||
|
||||
|
||||
1
routes
1
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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 --
|
||||
-------------------
|
||||
|
||||
@ -24,7 +24,10 @@
|
||||
|
||||
<div .row>
|
||||
<div .col-lg-12>
|
||||
<h2>Abgaben
|
||||
<h2>Dateien
|
||||
<ul>
|
||||
$forall fileLink <- fileLinks
|
||||
<li> <a href=@{fileLink}>@{fileLink}
|
||||
|
||||
<hr>
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user