Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

Refactoring for FileTypes complete

config/submission-blacklist

@@ -0,0 +1,12 @@
+$# Syntax:
+$#   - Leere zeilen werden ignoriert
+$#   - Zeilen, die mit '$#' beginnen, werden ignoriert
+$#   - Verbleibende Zeilen werden jeweils als `Glob`-Pattern kompiliert
+
+$# Ignoriere rekursiv alle Ordner __MACOSX und ihren Inhalt
+**/__MACOSX
+**/__MACOSX/*
+**/__MACOSX/**/*
+
+$# Ignoriere rekursiv alle Dateien .DS_Store
+**/.DS_Store

messages/de.msg

@@ -174,6 +174,7 @@ UpdatedAssignedCorrectorsAuto num@Int64: #{display num} Abgaben wurden unter den
 CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden:
 
 CorrectionsUploaded num@Int64: #{display num} Korrekturen wurden gespeichert:
+NoCorrectionsUploaded: In der hochgeladenen Datei wurden keine Korrekturen gefunden.
 
 RatingBy: Korrigiert von
 AchievedBonusPoints: Erreichte Bonuspunkte
@@ -221,3 +222,6 @@ AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC ko
 LastEdits: Letzte Änderungen
 EditedBy name@Text time@Text: Durch #{name} um #{time}
 LastEdit: Letzte Änderung
+
+SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert:
+SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.

package.yaml

@@ -86,6 +86,8 @@ dependencies:
 - tz
 - system-locale
 - th-lift-instances
+- gitrev
+- Glob
 
 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.

src/Handler/Corrections.hs

@@ -14,6 +14,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiWayIf #-}
 
 module Handler.Corrections where
 
@@ -195,7 +196,7 @@ data ActionCorrectionsData = CorrDownloadData
 correctionsR :: _ -> _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Maybe Widget)) -> Handler TypedContent
 correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
   tableForm <- makeCorrectionsTable whereClause displayColumns psValidator
-  ((actionRes, table), tableEncoding) <- runFormPost . identForm FIDcorrectorTable $ \csrf -> do
+  ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
     ((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
     (actionRes, action) <- multiAction actions
     return ((,) <$> actionRes <*> selectionRes, table <> action)
@@ -215,7 +216,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
         when (not $ null alreadyAssigned) $ do
           mr <- (toHtml . ) <$> getMessageRender
           alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission) 
-          addMessage "warn" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
+          addMessage "warning" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
         let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
         when (not $ null unassigned) $ do
           num <- updateWhereCount [SubmissionId <-. Set.toList unassigned] [SubmissionRatingBy =. Just uid]
@@ -238,7 +239,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
         when (not $ null alreadyAssigned) $ do
           mr <- (toHtml . ) <$> getMessageRender
           alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission) 
-          addMessage "warn" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
+          addMessage "warning" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
         let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
         when (not $ null unassigned) $ do
           (assigned, unassigned) <- assignSubmissions shid (Just unassigned)
@@ -247,7 +248,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
           when (not $ null unassigned) $ do
             mr <- (toHtml . ) <$> getMessageRender
             unassigned' <- forM (Set.toList unassigned) $ \sid -> (encrypt sid :: DB CryptoFileNameSubmission) 
-            addMessage "warn" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
+            addMessage "warning" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
       redirect currentRoute
 
   fmap toTypedContent . defaultLayout $ do
@@ -403,7 +404,7 @@ postCorrectionR tid csh shn cid = do
         FormSuccess fileSource -> do
           uid <- requireAuthId
           
-          runDB . runConduit $ transPipe lift fileSource .| extractRatings .| sinkSubmission uid (Right sub) True
+          runDB . runConduit $ transPipe lift fileSource .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
 
           addMessageI "success" MsgRatingFilesUpdated
           redirect $ CSubmissionR tid csh shn cid CorrectionR
@@ -438,10 +439,14 @@ postCorrectionsUploadR = do
     FormFailure errs -> mapM_ (addMessage "error" . toHtml) errs
     FormSuccess files -> do
       uid <- requireAuthId
-      subs <- runDB . runConduit $ transPipe lift files .| extractRatings .| sinkMultiSubmission uid True
+      subs <- runDB . runConduit $ transPipe lift files .| extractRatingsMsg .| sinkMultiSubmission uid True
-      subs' <- traverse encrypt $ Set.toList subs :: Handler [CryptoFileNameSubmission]
+      if
-      mr <- (toHtml .) <$> getMessageRender
+        | null subs -> addMessageI "warning" MsgNoCorrectionsUploaded
-      addMessage "success" =<< withUrlRenderer ($(ihamletFile "templates/messages/correctionsUploaded.hamlet") mr)
+        | otherwise -> do
+            subs' <- traverse encrypt $ Set.toList subs :: Handler [CryptoFileNameSubmission]
+            mr <- (toHtml .) <$> getMessageRender
+            addMessage "success" =<< withUrlRenderer ($(ihamletFile "templates/messages/correctionsUploaded.hamlet") mr)
+        
 
   defaultLayout $ do
     $(widgetFile "corrections-upload")

src/Handler/Home.hs

@@ -29,6 +29,8 @@ import qualified Database.Esqueleto as E
 
 import Text.Shakespeare.Text
 
+import Development.GitRev
+
 -- import qualified Data.UUID.Cryptographic as UUID
 
 
@@ -196,9 +198,13 @@ homeUser uid = do
     $(widgetFile "dsgvDisclaimer")
 
 
-getVersionR :: Handler Html
+getVersionR :: Handler TypedContent
-getVersionR = do
+getVersionR = selectRep $ do
-  let features = $(widgetFile "featureList")
+    provideRep . defaultLayout $ do
-  changeLog <- withUrlRenderer $(textFile "ChangeLog.md")
+      let features = $(widgetFile "featureList")
-  defaultLayout $ do
+          gitInfo :: Text
-    $(widgetFile "versionHistory")
+          gitInfo  = $gitDescribe <> " (" <> $gitCommitDate <> ")"
+      changeLog <- withUrlRenderer $(textFile "ChangeLog.md")
+      $(widgetFile "versionHistory")
+    provideRep $
+      return ($gitDescribe :: Text)

src/Handler/Sheet.hs

@@ -492,7 +492,7 @@ correctorForm shid = do
   (defaultLoads', currentLoads') <- lift . runDB $ (,) <$> defaultLoads shid <*> currentLoads
   loads' <- fmap (Map.fromList [(uid, mempty) | uid <- formCIDs] `Map.union`) $ if
     | Map.null currentLoads'
-    , null formCIDs          -> defaultLoads' <$ when (not $ Map.null defaultLoads') (addMessageI "warn" MsgCorrectorsDefaulted)
+    , null formCIDs          -> defaultLoads' <$ when (not $ Map.null defaultLoads') (addMessageI "warning" MsgCorrectorsDefaulted)
     | otherwise              -> return $ Map.fromList (map (, mempty) formCIDs) `Map.union` currentLoads'
 
   deletions <- lift $ foldM (\dels uid -> maybe (Set.insert uid dels) (const dels) <$> guardNonDeleted uid) Set.empty (Map.keys loads')

src/Handler/Submission.hs

@@ -220,7 +220,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do
             (Nothing, Just smid)   -- no new files, existing submission partners updated
               -> return smid
             (Just files, _)  -- new files
-              -> runConduit $ transPipe lift files .| extractRatings .| sinkSubmission uid (maybe (Left shid) Right msmid) False
+              -> runConduit $ transPipe lift files .| extractRatingsMsg .| sinkSubmission uid (maybe (Left shid) Right msmid) False
             _ -> error "Impossible, because of definition of `makeSubmissionForm`"
           -- Determine members of pre-registered group
           groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do

src/Handler/Utils.hs

@@ -17,7 +17,7 @@ import Handler.Utils.Table as Handler.Utils
 import Handler.Utils.Table.Pagination as Handler.Utils
 
 import Handler.Utils.Zip        as Handler.Utils
-import Handler.Utils.Rating     as Handler.Utils
+import Handler.Utils.Rating     as Handler.Utils hiding (extractRatings)
 import Handler.Utils.Submission as Handler.Utils
 import Handler.Utils.Sheet      as Handler.Utils
 import Handler.Utils.Templates  as Handler.Utils

src/Handler/Utils/Rating.hs

@@ -153,9 +153,11 @@ parseRating :: MonadThrow m => File -> m Rating'
 parseRating File{ fileContent = Just input, .. } = do
   inputText <- either (throw . RatingNotUnicode) return $ Text.decodeUtf8' input
   let
-    (headerLines, commentLines) = break (sep `Text.isInfixOf`) $ Text.lines inputText
+    (headerLines', commentLines) = break (sep `Text.isInfixOf`) $ Text.lines inputText
-    ratingLines = filter (rating `Text.isInfixOf`) headerLines
+    (reverse -> ratingLines, reverse -> headerLines) = break (sep' `Text.isInfixOf`) $ reverse headerLines'
+    ratingLines' = filter (rating `Text.isInfixOf`) ratingLines
     sep = "Beginn der Kommentare"
+    sep' = Text.pack $ replicate 40 '='
     rating = "Bewertung:"
   comment' <- case commentLines of
     (_:commentLines') -> return . Text.strip $ Text.unlines commentLines'

src/Handler/Utils/Submission.hs

@@ -15,6 +15,7 @@
 module Handler.Utils.Submission
   ( AssignSubmissionException(..)
   , assignSubmissions
+  , submissionBlacklist, filterSubmission, extractRatings, extractRatingsMsg
   , submissionFileSource, submissionFileQuery
   , submissionMultiArchive 
   , SubmissionSinkException(..)
@@ -23,12 +24,15 @@ module Handler.Utils.Submission
   ) where
 
 import Import hiding ((.=), joinPath)
+import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
 
 import Control.Lens
 import Control.Lens.Extras (is)
 import Utils.Lens
 
 import Control.Monad.State hiding (forM_, mapM_,foldM)
+import Control.Monad.Writer (MonadWriter(..))
+import Control.Monad.RWS.Lazy (RWST)
 import qualified Control.Monad.Random as Rand
 
 import Data.Maybe
@@ -45,16 +49,24 @@ import qualified Data.CaseInsensitive as CI
 import Data.Monoid (Monoid, Any(..))
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
-import Handler.Utils.Rating
+import Handler.Utils.Rating hiding (extractRatings)
+import qualified Handler.Utils.Rating as Rating (extractRatings)
 import Handler.Utils.Zip
 import Handler.Utils.Sheet
+import Handler.Utils.Submission.TH
 
 import qualified Database.Esqueleto as E
 
+import Data.Conduit
 import qualified Data.Conduit.List as Conduit
 import Data.Conduit.ResumableSink
 
 import System.FilePath
+import System.FilePath.Glob
+
+import Text.Hamlet (ihamletFile)
+
+import qualified Control.Monad.Catch as E (Handler(..))
 
 
 data AssignSubmissionException = NoCorrectorsByProportion
@@ -186,11 +198,46 @@ instance Monoid SubmissionSinkState where
 data SubmissionSinkException = DuplicateFileTitle FilePath
                              | DuplicateRating
                              | RatingWithoutUpdate
-                             | ForeignRating
+                             | ForeignRating CryptoFileNameSubmission
   deriving (Typeable, Show)
 
 instance Exception SubmissionSinkException
 
+submissionBlacklist :: [Pattern]
+submissionBlacklist = $(patternFile compDefault "config/submission-blacklist")
+
+filterSubmission :: MonadLogger m => ConduitM File File m (Set FilePath)
+-- ^ Removes all `File`s matching `submissionBlacklist`, returning their `fileTitle`s
+filterSubmission = do
+  $logDebugS "filterSubmission" $ tshow submissionBlacklist
+  execWriterLC . awaitForever $ \case
+    File{fileTitle}
+      | any (`match'` fileTitle) submissionBlacklist -> tell $ Set.singleton fileTitle
+    file -> yield file
+  where
+    match' = matchWith $ matchDefault
+      { matchDotsImplicitly = True -- Special treatment for . makes no sense since we're multiplatform
+      }
+
+extractRatings :: ( MonadHandler m
+                  , HandlerSite m ~ UniWorX
+                  , MonadCatch m
+                  , MonadLogger m
+                  ) => ConduitM File SubmissionContent m (Set FilePath)
+extractRatings = filterSubmission `fuseUpstream` Rating.extractRatings
+
+extractRatingsMsg :: ( MonadHandler m
+                     , HandlerSite m ~ UniWorX
+                     , MonadCatch m
+                     , MonadLogger m
+                     ) => Conduit File m SubmissionContent
+extractRatingsMsg = do
+  ignored' <- filterSubmission `fuseUpstream` Rating.extractRatings
+  let ignored :: Set (Either CryptoFileNameSubmission FilePath)
+      ignored = Right `Set.map` ignored'
+  mr <- (toHtml . ) <$> getMessageRender
+  addMessage "warning" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionFilesIgnored.hamlet") mr)
+
 sinkSubmission :: UserId
                -> Either SheetId SubmissionId
                -> Bool -- ^ Is this a correction
@@ -228,7 +275,7 @@ sinkSubmission userId mExists isUpdate = do
     sinkSubmission' submissionId isUpdate = lift . finalize <=< execStateLC mempty . Conduit.mapM_ $ \case
       Left file@(File{..}) -> do
         $logDebugS "sinkSubmission" . tshow $ (submissionId, fileTitle)
-        
+
         alreadySeen <- gets (Set.member fileTitle . sinkFilenames)
         when alreadySeen . throwM $ DuplicateFileTitle fileTitle
         tell $ mempty{ sinkFilenames = Set.singleton fileTitle  }
@@ -277,7 +324,9 @@ sinkSubmission userId mExists isUpdate = do
       Right (submissionId', Rating'{..}) -> do
         $logDebugS "sinkSubmission" $ tshow submissionId'
 
-        unless (submissionId' == submissionId) $ throwM ForeignRating
+        unless (submissionId' == submissionId) $ do
+          cID <- encrypt submissionId'
+          throwM $ ForeignRating cID
         
         alreadySeen <- gets $ getAny . sinkSeenRating
         when alreadySeen $ throwM DuplicateRating
@@ -373,6 +422,16 @@ sinkSubmission userId mExists isUpdate = do
               , SubmissionRatingComment =. Nothing
               ]
 
+data SubmissionMultiSinkException
+  = SubmissionSinkException
+    { submissionSinkId :: CryptoFileNameSubmission
+    , submissionSinkFedFile :: Maybe FilePath
+    , submissionSinkException :: SubmissionSinkException
+    }                                   
+  deriving (Typeable, Show)
+
+instance Exception SubmissionMultiSinkException
+
 sinkMultiSubmission :: UserId
                     -> Bool {-^ Are these corrections -}
                     -> Sink SubmissionContent (YesodDB UniWorX) (Set SubmissionId)
@@ -386,7 +445,9 @@ sinkMultiSubmission userId isUpdate = do
   let
     feed :: SubmissionId
          -> SubmissionContent
-         -> StateT
+         -> RWST
+              ()
+              _
               (Map SubmissionId (ResumableSink SubmissionContent (YesodDB UniWorX) SubmissionId))
               (YesodDB UniWorX)
               ()
@@ -396,8 +457,9 @@ sinkMultiSubmission userId isUpdate = do
         Just sink -> return sink
         Nothing -> do
           lift $ do
-            Submission{..} <- get404 sId
             cID <- encrypt sId
+            $(logDebugS) "sinkMultiSubmission" $ "Doing auth checks for " <> toPathPiece cID 
+            Submission{..} <- get404 sId
             Sheet{..} <- get404 submissionSheet
             Course{..} <- get404 sheetCourse
             authRes <- evalAccessDB (CSubmissionR courseTerm courseShorthand sheetName cID CorrectionR) True
@@ -410,20 +472,45 @@ sinkMultiSubmission userId isUpdate = do
       case sink' of
         Left _ -> error "sinkSubmission returned prematurely"
         Right nSink -> modify $ Map.insert sId nSink
-  sinks <- execStateLC Map.empty . awaitForever $ \case
+  (sinks, ignored) <- execRWSLC () Map.empty . awaitForever $ \case
-    v@(Right (sId, _)) -> lift $ feed sId v
+    v@(Right (sId, _)) -> do
+      cID <- encrypt sId
+      $logDebugS "sinkMultiSubmission" $ "Feeding rating for " <> toPathPiece cID
+      lift (feed sId v) `catches` [ E.Handler (throwM . SubmissionSinkException cID Nothing), E.Handler (void . handleHCError (Left cID)) ]
     (Left f@File{..})  -> do
       let
-        tryDecrypt :: FilePath -> _ (Either SomeException SubmissionId)
+        acc :: (Maybe SubmissionId, [FilePath]) -> FilePath -> _ (Maybe SubmissionId, [FilePath])
-        tryDecrypt (CI.mk -> ciphertext) = try $ decrypt (CryptoID{..} :: CryptoFileNameSubmission)
+        acc (Just sId, fp) segment = return (Just sId, fp ++ [segment])
-        acc (Just cID, fp) segment = return (Just cID, fp ++ [segment])
         acc (Nothing , fp) segment = do
-          msId <- tryDecrypt segment
+          let
-          return . either (const id) (set _1 . Just) msId $ (Nothing, fp)
+            tryDecrypt ciphertext = do
+              sId <- decrypt (CryptoID (CI.mk segment) :: CryptoFileNameSubmission)
+              Just sId <$ get404 sId
+          msId <- lift (lift $ tryDecrypt segment) `catches` [ E.Handler handleCryptoID, E.Handler (handleHCError $ Right fileTitle) ]
+          return (msId, fp)
       (msId, (joinPath -> fileTitle')) <- foldM acc (Nothing, []) $ splitDirectories fileTitle
-      $logDebugS "sinkMultiSubmission" $ tshow (splitDirectories fileTitle, msId, fileTitle')
+      case msId of
-      lift . maybe (const $ return ()) feed msId $ Left f{ fileTitle = fileTitle' }
+        Nothing -> do
-  fmap Map.keysSet . lift $ mapM (void . closeResumableSink) sinks
+          $logDebugS "sinkMultiSubmission" $ "Dropping " <> tshow (splitDirectories fileTitle, msId, fileTitle')
+        Just sId -> do
+          $logDebugS "sinkMultiSubmission" $ "Feeding " <> tshow (splitDirectories fileTitle, msId, fileTitle')
+          cID <- encrypt sId
+          handle (throwM . SubmissionSinkException cID (Just fileTitle)) $
+            lift . feed sId $ Left f{ fileTitle = fileTitle' }
+  when (not $ null ignored) $ do
+    mr <- (toHtml .) <$> getMessageRender
+    addMessage "warning" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionFilesIgnored.hamlet") mr)
+  fmap Map.keysSet . lift . sequence $ flip Map.mapWithKey sinks $ \sId sink -> do
+    cID <- encrypt sId
+    handle (throwM . SubmissionSinkException cID Nothing) $
+      void $ closeResumableSink sink
+  where
+    handleHCError :: Either CryptoFileNameSubmission FilePath -> HandlerContents -> _ (Maybe a)
+    handleHCError ident (HCError NotFound) = Nothing <$ tell (Set.singleton ident)
+    handleHCError _ e = throwM e
+    handleCryptoID :: CryptoIDError -> _ (Maybe a)
+    handleCryptoID _ = return Nothing
+    
 
 submissionMatchesSheet :: TermId -> Text -> Text -> CryptoFileNameSubmission -> DB ()
 submissionMatchesSheet tid csh shn cid = do

src/Handler/Utils/Submission/TH.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE NoImplicitPrelude
+           , TemplateHaskell
+           , ViewPatterns
+           , OverloadedStrings
+           , StandaloneDeriving
+           , DeriveLift
+  #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Handler.Utils.Submission.TH
+  ( patternFile
+  ) where
+
+import ClassyPrelude.Yesod
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (qAddDependentFile, Lift(..))
+
+import System.FilePath.Glob
+
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
+
+deriving instance Lift CompOptions
+
+-- $(patternFile compDefault file) :: [System.FilePath.Glob.Pattern]
+patternFile :: CompOptions -> FilePath -> ExpQ
+patternFile opts file = do
+  qAddDependentFile file
+  patternStrings <- runIO $ filter (not . isComment) . Text.lines <$> Text.readFile file
+  listE $ map (\(Text.unpack -> pat) -> [|compileWith opts pat|]) patternStrings
+
+isComment :: Text -> Bool
+isComment line = or
+  [ commentSymbol `Text.isPrefixOf` Text.stripStart line
+  , Text.null $ Text.strip line
+  ]
+  where
+    commentSymbol = "$#"

src/Handler/Utils/Table/Pagination.hs

@@ -204,7 +204,7 @@ instance Default (PSValidator m x) where
       l <- asks piLimit
       case l of
         Just l'
-          | l' >= 0   -> tell . pure $ SomeMessage MsgPSLimitNonPositive
+          | l' <= 0   -> tell . pure $ SomeMessage MsgPSLimitNonPositive
           | otherwise -> modify $ \ps -> ps { psLimit = l' }
         Nothing -> return ()
 
@@ -242,10 +242,10 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)
   cellContents :: DBCell m x -> WriterT x m Widget
 
   cell :: Widget -> DBCell m x
-
     
   -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
-  dbWidget :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Proxy m -> Proxy x -> DBResult m x -> m' Widget
+  dbWidget :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> DBResult m x -> m' Widget
+  dbHandler :: forall m'. (MonadHandler m' , HandlerSite m' ~ UniWorX) => DBTable m x -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x)
   runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x)
 
 instance IsDBTable (WidgetT UniWorX IO) () where
@@ -262,7 +262,8 @@ instance IsDBTable (WidgetT UniWorX IO) () where
   cell = WidgetCell []
   
   -- dbWidget Proxy Proxy = iso (, ()) $ view _1
-  dbWidget Proxy Proxy = return
+  dbWidget _ = return
+  dbHandler _ f x = return $ f x
   runDBTable = return . join . fmap (view _2)
 
 instance Monoid (DBCell (WidgetT UniWorX IO) ()) where
@@ -282,7 +283,8 @@ instance IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) () where
 
   cell = DBCell [] . return
 
-  dbWidget Proxy Proxy = return
+  dbWidget _ = return
+  dbHandler _ f x = return $ f x
   -- runDBTable :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT SqlBackend (HandlerT UniWorX IO) ((), Widget) -> m (Widget)
   runDBTable = fmap snd . mapReaderT liftHandlerT
 
@@ -306,7 +308,8 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
   
   -- dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
   --                            ((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
-  dbWidget Proxy Proxy = liftHandlerT . fmap (view $ _1 . _2) . runFormPost
+  dbWidget DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } = liftHandlerT . fmap (view $ _1 . _2) . runFormPost . identifyForm dbtIdent
+  dbHandler DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } f form = return $ \csrf -> over _2 f <$> identifyForm dbtIdent form csrf
   -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m ((FormResult a, Widget), Enctype)
   -- runDBTable form = liftHandlerT . runFormPost $ \html -> over _2 (<> toWidget html) <$> form
   -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m (Html -> MForm (HandleT UniWorX IO) (FormResult a, Widget))
@@ -413,16 +416,13 @@ dbTable PSValidator{..} dbtable@(DBTable{ dbtIdent = (toPathPiece -> dbtIdent),
             pageNumbers = [0..pred pageCount]
 
         return $(widgetFile "table/layout")
-    
-      dbWidget' :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBResult m x -> m' Widget
-      dbWidget' = dbWidget (Proxy :: Proxy m) (Proxy :: Proxy x)
 
-    bool return (sendResponse <=< tblLayout <=< dbWidget') psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
+    bool (dbHandler dbtable $ \table -> $(widgetFile "table/layout-wrapper")) (sendResponse <=< tblLayout <=< dbWidget dbtable) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
   where
     tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
     tblLayout tbl' = do
       tbl <- liftHandlerT $ widgetToPageContent tbl'
-      withUrlRenderer $(hamletFile "templates/table/layout-wrapper.hamlet")
+      withUrlRenderer $(hamletFile "templates/table/layout-standalone.hamlet")
 
     setParam :: Text -> Maybe Text -> QueryText -> QueryText
     setParam key v qt = (key, v) : [ i | i@(key', _) <- qt, key' /= key ]

templates/default-layout.lucius

@@ -171,6 +171,8 @@ h4 {
   background-color: white;
   overflow: hidden;
   transition: padding-left .2s ease-out;
+  max-width: 1200px;
+  margin: 0 auto;
 
   > .container {
     margin: 20px 0;
@@ -185,6 +187,13 @@ h4 {
   }
 }
 
+.logged-in {
+  .main__content {
+    margin: 0;
+    max-width: none;
+  }
+}
+
 @media (max-width: 768px) {
   .logged-in {
     .main__content {
@@ -210,7 +219,6 @@ h4 {
 }
 
 @media (min-width: 1200px) {
-
   .logged-in {
     .main__content {
       padding-left: 320px;

templates/messages/submissionFilesIgnored.hamlet

@@ -0,0 +1,9 @@
+_{MsgSubmissionFilesIgnored}
+<ul>
+  $forall ident <- ignored
+    $case ident
+      $of Right fileTitle
+        <li style="font-family: monospace">#{fileTitle}
+      $of Left cID
+        <li>Bewertungsdatei für <span style="font-family: monospace">#{toPathPiece cID}</span>
+    

templates/table/layout-standalone.hamlet

@@ -0,0 +1 @@
+^{pageBody tbl}

templates/table/layout-wrapper.hamlet

@@ -1 +1,3 @@
-^{pageBody tbl}
+$newline never
+<div ##{wIdent "table-wrapper"}>
+  ^{table}

templates/table/layout.hamlet

@@ -2,12 +2,11 @@ $newline never
 $if null wRows && (dbsEmptyStyle == DBESNoHeading)
   _{dbsEmptyMessage}
 $else
-  <div ##{wIdent "table-wrapper"}>
+  <div .scrolltable>
-    <div .scrolltable>
+    ^{table}
-      ^{table}
+  $if pageCount > 1
-    $if pageCount > 1
+    <ul ##{wIdent "pagination"} .pagination>
-      <ul ##{wIdent "pagination"} .pagination>
+      $forall p <- pageNumbers
-        $forall p <- pageNumbers
+        <li .pagination-link :p == psPage:.current>
-          <li .pagination-link :p == psPage:.current>
+          <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
-            <a href=#{tblLink $ setParam (wIdent "page") (Just $ tshow p)}>
+            _{MsgPage (succ p)}
-              _{MsgPage (succ p)}

templates/versionHistory.hamlet

@@ -8,9 +8,11 @@
         Vorabversion!
         Die Implementierung von
         Uni2work ist noch nicht abgeschlossen.
-  ^{features}
 
-  <p>
+  <section>
+    ^{features}
+
+  <section>
     <h2>
       Bekannte Bugs
     <ul>
@@ -21,13 +23,13 @@
       <li>
         Tabellen über mehrere Seiten müssen vor Seitenwechsel manuell sortiert werden
 
-  <p>
+  <section>
     <h2>
       Versionsgeschichte
-    <pre #changelog>
+    <p #changelog>
       #{changeLog}
 
-  <p>
+  <section>
     <h2>
       Impressum
 
@@ -46,3 +48,7 @@
         Ludwig-Maximilians-Universität München
       <li>
         Oettingenstr. 67, 80538 München
+
+  <section>
+    <p #gitrev>
+      #{gitInfo}

templates/versionHistory.lucius

@@ -1,4 +1,11 @@
 #changelog {
   font-size: 14px;
-  white-space: pre-line;
+  white-space: pre-wrap;
+  font-family: monospace;
+}
+
+#gitrev {
+  font-size: 12px;
+  white-space: pre-wrap;  
+  font-family: monospace;
 }