Merge branch 'version-bumps' into 'master'

Version bumps to GHC 8.10.x

See merge request uni2work/uni2work!20

load/Load.hs

@@ -96,7 +96,7 @@ sampleIntegral = sampleN scaleIntegral
 
 
 instance PathPiece DiffTime where
-  toPathPiece = toPathPiece . MkFixed @E12 . diffTimeToPicoseconds
+  toPathPiece = (toPathPiece :: Pico -> Text) . MkFixed . diffTimeToPicoseconds
   fromPathPiece t = fromPathPiece t <&> \(MkFixed ps :: Pico) -> picosecondsToDiffTime ps
   
 

package.yaml

@@ -253,7 +253,7 @@ executables:
   uniworx:
     main: main.hs
     source-dirs: app
-    ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T"
+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T -xn"
     dependencies:
       - uniworx
     when:
@@ -278,7 +278,7 @@ executables:
     ghc-options:
       - -main-is Load
       - -threaded
-      - -rtsopts "-with-rtsopts=-N -T"
+      - -rtsopts "-with-rtsopts=-N -T -xn"
     source-dirs: load
     dependencies:
       - uniworx
@@ -313,8 +313,7 @@ tests:
     ghc-options:
       - -fno-warn-orphans
       - -threaded
-      - -rtsopts
+      - -rtsopts "-with-rtsopts=-N -xn"
-      - -with-rtsopts=-N
   hlint:
     main: Hlint.hs
     other-modules: []

src/Application.hs

@@ -94,13 +94,15 @@ import Handler.Utils.Routes (classifyHandler)
 
 import qualified Data.Acid.Memory as Acid
 import qualified Web.ServerSession.Backend.Acid as Acid
-  
+
 import qualified Ldap.Client as Ldap (Host(Plain, Tls))
 
 import qualified Network.Minio as Minio
-  
+
 import Web.ServerSession.Core (StorageException(..))
 
+import GHC.RTS.Flags (getRTSFlags)
+
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
 import Handler.News
@@ -140,7 +142,7 @@ mkYesodDispatch "UniWorX" resourcesUniWorX
 makeFoundation :: (MonadResource m, MonadUnliftIO m, MonadCatch m) => AppSettings -> m UniWorX
 makeFoundation appSettings'@AppSettings{..} = do
     registerGHCMetrics
-  
+
     -- Some basic initializations: HTTP connection manager, logger, and static
     -- subsite.
     appHttpManager <- newManager
@@ -200,6 +202,7 @@ makeFoundation appSettings'@AppSettings{..} = do
     runAppLoggingT tempFoundation $ do
       $logInfoS "InstanceID" $ UUID.toText appInstanceID
       $logDebugS "Configuration" $ tshow appSettings'
+      $logDebugS "RTSFlags" . tshow =<< liftIO getRTSFlags
 
       smtpPool <- for appSmtpConf $ \c -> do
         $logDebugS "setup" "SMTP-Pool"
@@ -353,7 +356,7 @@ makeApplication foundation = liftIO $ makeMiddleware foundation <*> toWaiAppPlai
 makeMiddleware :: MonadIO m => UniWorX -> m Middleware
 makeMiddleware app = do
   logWare <- makeLogWare
-  return $ observeHTTPRequestLatency classifyHandler . logWare . normalizeCookies . defaultMiddlewaresNoLogging 
+  return $ observeHTTPRequestLatency classifyHandler . logWare . normalizeCookies . defaultMiddlewaresNoLogging
   where
     makeLogWare = do
       logWareMap <- liftIO $ newTVarIO HashMap.empty
@@ -388,7 +391,7 @@ makeMiddleware app = do
         respond $ Wai.mapResponseHeaders (const resHdrs') res
       where parseSetCookie' :: ByteString -> IO (Maybe SetCookie)
             parseSetCookie' = fmap (either (\(_ :: SomeException) -> Nothing) Just) . try . evaluate . force . parseSetCookie
-              
+
             go [] = return []
             go (hdr@(hdrName, hdrValue) : hdrs)
               | hdrName == hSetCookie = do
@@ -455,7 +458,7 @@ warpSettings foundation = defaultSettings
           Just (SessionDoesNotExist{} :: StorageException (AcidStorage SessionMap)) -> False
           _other -> True
       ]
-                           
+
 
 getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings
 getAppDevSettings = liftIO $ loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv
@@ -476,7 +479,7 @@ develMain = runResourceT $ do
           lift $ threadDelay 100e3
           whenM (lift $ doesFileExist "yesod-devel/devel-terminate") $
             callCC ($ ())
-  
+
   void . liftIO $ installHandler sigINT (Signals.Catch $ return ()) Nothing
   runAppLoggingT foundation $ handleJobs foundation
   void . liftIO $ awaitTermination `race` runSettings wsettings app

src/Audit.hs

@@ -54,7 +54,7 @@ getRemote = handle testHandler $ do
       guard $ h `elem` ["x-real-ip", "x-forwarded-for"]
       v' <- either (const mzero) return $ Text.decodeUtf8' v
       maybeToList $ IP.decode v'
-    
+
     byRemoteHost wai = case Wai.remoteHost wai of
       Wai.SockAddrInet _ hAddr
         -> let (b1, b2, b3, b4) = Wai.hostAddressToTuple hAddr

src/Audit/Types.hs

@@ -23,7 +23,7 @@ data Transaction
     { transactionExam   :: ExamId
     , transactionUser   :: UserId
     }
-  
+
   | TransactionExamPartResultEdit
     { transactionExamPart :: ExamPartId
     , transactionUser     :: UserId
@@ -88,7 +88,7 @@ data Transaction
     { transactionSubmission :: SubmissionId
     , transactionUser       :: UserId
     }
-  
+
   | TransactionSubmissionFileEdit
     { transactionSubmissionFile :: SubmissionFileId
     , transactionSubmission     :: SubmissionId
@@ -133,7 +133,7 @@ data Transaction
     { transactionExternalExam :: ExternalExamId
     , transactionSchool       :: SchoolId
     }
-  
+
   | TransactionExternalExamStaffEdit
     { transactionExternalExam :: ExternalExamId
     , transactionUser         :: UserId

src/Auth/Dummy.hs

@@ -45,7 +45,7 @@ dummyLogin = AuthPlugin{..}
   where
     apName :: Text
     apName = "dummy"
-    
+
     apDispatch :: forall m. MonadAuthHandler site m => Text -> [Text] -> m TypedContent
     apDispatch method [] | encodeUtf8 method == methodPost = liftSubHandler $ do
       ((loginRes, _), _) <- runFormPost $ renderWForm FormStandard dummyForm
@@ -62,7 +62,7 @@ dummyLogin = AuthPlugin{..}
           setCredsRedirect $ Creds apName (CI.original ident) []
     apDispatch _ [] = badMethod
     apDispatch _ _ = notFound
-  
+
     apLogin :: (Route Auth -> Route site) -> WidgetFor site ()
     apLogin toMaster = do
       (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderWForm FormStandard dummyForm

src/Auth/LDAP.hs

@@ -52,7 +52,7 @@ findUser conf@LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM
       [ ldapUserDisplayName   Ldap.:= Text.encodeUtf8 ident
       , ldapUserMatriculation Ldap.:= Text.encodeUtf8 ident
       ]
-      
+
 findUserMatr :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry]
 findUserMatr conf@LdapConf{..} ldap userMatr retAttrs = fromMaybe [] <$> findM (assertM (not . null) . lift . flip (Ldap.search ldap ldapBase $ userSearchSettings conf) retAttrs) userFilters
   where
@@ -76,8 +76,8 @@ ldapUserFirstName         = Ldap.Attr "givenName"
 ldapUserSurname           = Ldap.Attr "sn"
 ldapUserTitle             = Ldap.Attr "title"
 ldapUserStudyFeatures     = Ldap.Attr "dfnEduPersonFeaturesOfStudy"
-ldapUserFieldName         = Ldap.Attr "LMU-Stg-Fach" 
+ldapUserFieldName         = Ldap.Attr "LMU-Stg-Fach"
-ldapUserSchoolAssociation = Ldap.Attr "LMU-IFI-eduPersonOrgUnitDNString" 
+ldapUserSchoolAssociation = Ldap.Attr "LMU-IFI-eduPersonOrgUnitDNString"
 ldapSex                   = Ldap.Attr "schacGender"
 ldapUserSubTermsSemester  = Ldap.Attr "LMU-Stg-FachundFS"
 
@@ -145,7 +145,7 @@ campusUserMatr pool mode userMatr = either (throwM . CampusUserLdapError) return
     [] -> throwM CampusUserNoResult
     [Ldap.SearchEntry _ attrs] -> return attrs
     _otherwise -> throwM CampusUserAmbiguous
-  
+
 campusUserMatr' :: (MonadMask m, MonadUnliftIO m, MonadLogger m) => Failover (LdapConf, LdapPool) -> FailoverMode -> UserMatriculation -> m (Maybe (Ldap.AttrList []))
 campusUserMatr' pool mode
   = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) . campusUserMatr pool mode
@@ -177,7 +177,7 @@ campusLogin pool mode = AuthPlugin{..}
   where
     apName :: Text
     apName = apLdap
-  
+
     apDispatch :: forall m. MonadAuthHandler site m => Text -> [Text] -> m TypedContent
     apDispatch method [] | encodeUtf8 method == methodPost = liftSubHandler $ do
       ((loginRes, _), _) <- runFormPost $ renderWForm FormStandard campusForm

src/Control/Monad/Trans/Memo/StateCache/Instances.hs

@@ -16,7 +16,7 @@ instance MonadResource m => MonadResource (StateCache c m) where
 
 instance MonadLogger m => MonadLogger (StateCache c m)
 instance MonadLoggerIO m => MonadLoggerIO (StateCache c m)
-  
+
 instance MonadHandler m => MonadHandler (StateCache c m) where
   type HandlerSite (StateCache c m) = HandlerSite m
   type SubHandlerSite (StateCache c m) = SubHandlerSite m

src/Cron.hs

@@ -21,7 +21,7 @@ import qualified Data.Set as Set
 
 import Utils.Lens hiding (from, to)
 
-  
+
 data CronDate = CronDate
   { cdYear, cdWeekYear, cdWeekOfYear, cdDayOfYear
   , cdMonth, cdWeekOfMonth, cdDayOfMonth
@@ -101,7 +101,7 @@ instance Alternative CronNextMatch where
   _ <|> MatchAsap = MatchAsap
   MatchAsap <|> _ = MatchAsap
   (MatchAt a) <|> (MatchAt _) = MatchAt a
-  
+
 
 listToMatch :: [a] -> CronNextMatch a
 listToMatch [] = MatchNone
@@ -203,7 +203,7 @@ nextCronMatch tz mPrev prec now c@Cron{..} = onlyOnceWithinPrec $ case notAfter
                    in case execRef now False cronInitial of
                         MatchAsap
                           | now < cutoffTime -> MatchAt cutoffTime
-                        MatchAt ts 
+                        MatchAt ts
                           | ts < cutoffTime -> MatchAt cutoffTime
                         other -> other
             CronRepeatScheduled cronNext

src/Cron/Types.hs

@@ -11,12 +11,12 @@ import ClassyPrelude
 
 import Utils.Lens.TH
 
-import Data.Time 
+import Data.Time
 
 import Numeric.Natural
 
 import qualified Data.Set as Set
-  
+
 
 data CronMatch
   = CronMatchAny

src/Crypto/Hash/Instances.hs

@@ -26,7 +26,7 @@ instance HashAlgorithm hash => PersistField (Digest hash) where
   fromPersistValue _ = Left "Digest values must be converted from PersistByteString or PersistText"
 
 instance HashAlgorithm hash => PersistFieldSql (Digest hash) where
-  sqlType _ = SqlBlob 
+  sqlType _ = SqlBlob
 
 instance HashAlgorithm hash => PathPiece (Digest hash) where
   toPathPiece = showToPathPiece

src/CryptoID.hs

@@ -38,7 +38,7 @@ encrypt :: forall plaintext ciphertext m.
            , Typeable ciphertext
            , PathPiece plaintext
            )
-        => plaintext -> m (I.CryptoID ciphertext plaintext) 
+        => plaintext -> m (I.CryptoID ciphertext plaintext)
 encrypt plain = $cachedHereBinary (toPathPiece plain) $ I.encrypt plain
 
 decrypt :: forall plaintext ciphertext m.
@@ -47,7 +47,7 @@ decrypt :: forall plaintext ciphertext m.
            , Typeable plaintext
            , PathPiece ciphertext
            )
-        => I.CryptoID ciphertext plaintext -> m plaintext 
+        => I.CryptoID ciphertext plaintext -> m plaintext
 decrypt cipher = $cachedHereBinary (toPathPiece $ ciphertext cipher) $ I.decrypt cipher
 
 

src/Data/CaseInsensitive/Instances.hs

@@ -38,7 +38,7 @@ instance PersistField (CI String) where
   toPersistValue ciText = PersistDbSpecific . Text.encodeUtf8 . pack $ CI.original ciText
   fromPersistValue (PersistDbSpecific bs) = Right . CI.mk . unpack $ Text.decodeUtf8 bs
   fromPersistValue x = Left . pack $ "Expected PersistDbSpecific, received: " ++ show x
-  
+
 instance PersistFieldSql (CI Text) where
   sqlType _ = SqlOther "citext"
 
@@ -77,8 +77,8 @@ instance ToWidget site a => ToWidget site (CI a) where
 instance RenderMessage site a => RenderMessage site (CI a) where
   renderMessage f ls msg = renderMessage f ls $ CI.original msg
 
-instance Lift t => Lift (CI t) where
+instance (CI.FoldCase t, Lift t) => Lift (CI t) where
-  lift (CI.original -> orig) = [e|CI.mk $(lift orig)|]
+  liftTyped (CI.original -> orig) = [||CI.mk $$(liftTyped orig)||]
 
 
 instance (CI.FoldCase s, PathPiece s) => PathPiece (CI s) where

src/Data/Fixed/Instances.hs

@@ -16,7 +16,7 @@ import Data.Proxy (Proxy(..))
 
 import Data.Scientific
 import Data.Scientific.Instances ()
-  
+
 
 instance HasResolution a => ToMarkup (Fixed a) where
   toMarkup = toMarkup . showFixed True

src/Data/Maybe/Instances.hs

@@ -10,4 +10,4 @@ import Text.Blaze (ToMarkup(..), string)
 
 instance ToMarkup a => ToMarkup (Maybe a) where
   toMarkup Nothing  = string ""
-  toMarkup (Just x) = toMarkup x
+  toMarkup (Just x) = toMarkup x

src/Data/MonoTraversable/Instances.hs

@@ -19,7 +19,7 @@ instance MonoFunctor All where
 
 instance MonoPointed Any where
   opoint = Any
-  
+
 instance MonoPointed All where
   opoint = All
 

src/Data/Scientific/Instances.hs

@@ -11,5 +11,5 @@ import Web.PathPieces
 
 
 instance PathPiece Scientific where
-  toPathPiece = pack . formatScientific Fixed Nothing 
+  toPathPiece = pack . formatScientific Fixed Nothing
   fromPathPiece = readFromPathPiece

src/Data/Sum/Instances.hs

@@ -10,4 +10,4 @@ import Data.Monoid (Sum(..))
 import Text.Blaze (ToMarkup(..))
 
 instance ToMarkup a => ToMarkup (Sum a) where
-  toMarkup = toMarkup . getSum
+  toMarkup = toMarkup . getSum

src/Data/UUID/Instances.hs

@@ -10,7 +10,7 @@ import qualified Data.UUID as UUID
 import Database.Persist.Sql
 
 import Text.Blaze (ToMarkup(..))
-  
+
 
 instance PathPiece UUID where
   fromPathPiece = UUID.fromString . unpack

src/Data/Universe/Instances/Reverse/MonoTraversable.hs

@@ -7,11 +7,11 @@ module Data.Universe.Instances.Reverse.MonoTraversable
 import Data.Universe
 import Data.MonoTraversable
 
-import Data.Universe.Instances.Reverse 
+import Data.Universe.Instances.Reverse
-  
+
 
 type instance Element (a -> b) = b
 
 instance Finite a => MonoFoldable (a -> b)
 instance (Ord a, Finite a) => MonoTraversable (a -> b)
-  
+

src/Data/Universe/TH.hs

@@ -23,7 +23,7 @@ import Data.List (elemIndex)
 getTVBName :: TyVarBndr -> Name
 getTVBName (PlainTV  name  ) = name
 getTVBName (KindedTV name _) = name
-  
+
 
 
 finiteEnum :: Name -> DecsQ
@@ -33,7 +33,7 @@ finiteEnum tName = do
 
   let datatype = foldl appT (conT datatypeName) $ map (varT . getTVBName) datatypeVars
       tUniverse = [e|universeF :: [$(datatype)]|]
-  
+
   [d|
     instance Bounded $(datatype) where
       minBound = head $(tUniverse)

src/Database/Esqueleto/Utils.hs

@@ -196,7 +196,7 @@ orderByList :: PersistField a => [a] -> E.SqlExpr (E.Value a) -> E.SqlExpr (E.Va
 orderByList vals
   = let sortUni = zip [1..] vals -- memoize this, might not work due to polymorphism
      in \x -> E.case_ [ (x E.==. E.val u, E.val i) | (i,u) <- sortUni ] (E.val . succ $ List.length vals)
-  
+
 orderByOrd :: (Ord a, Finite a, PersistField a) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
 orderByOrd = orderByList $ List.sort universeF
 
@@ -206,12 +206,12 @@ orderByEnum = orderByList $ List.sortOn fromEnum universeF
 
 lower :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
 lower = E.unsafeSqlFunction "LOWER"
-  
+
 strip :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s)
 strip = E.unsafeSqlFunction "TRIM"
 
 infix 4 `ciEq`
-  
+
 ciEq :: E.SqlString s => E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value s) -> E.SqlExpr (E.Value Bool)
 ciEq a b = lower a E.==. lower b
 
@@ -249,7 +249,7 @@ maybe onNothing onJust val = E.case_
       (onJust $ E.veryUnsafeCoerceSqlExprValue val)
   ]
   (E.else_ onNothing)
-  
+
 infix 4 `maybeEq`
 
 maybeEq :: PersistField a

src/Database/Esqueleto/Utils/TH.hs

@@ -46,7 +46,7 @@ sqlInTuple arity = do
   xsV <- newName "xs"
 
   let
-    matchE = lam1E (tupP $ map (\vV -> conP 'E.Value [varP vV]) vVs) (foldr1 (\e1 e2 -> [e|$(e1) E.&&. $(e2)|]) . map (\(varE -> vE, varE -> xE) -> [e|E.val $(vE) `sqlEq` $(xE)|]) $ zip vVs xVs)
+    matchE = lam1E (tupP $ map (\vV -> conP 'E.Value [varP vV]) vVs) (foldr1 (\e1 e2 -> [e|$(e1) E.&&. $(e2)|]) $ zipWith (\(varE -> vE) (varE -> xE) -> [e|E.val $(vE) `sqlEq` $(xE)|]) vVs xVs)
     tupTy f = foldl (\typ v -> typ `appT` f (varT v)) (tupleT arity) tyVars
 
   instanceD (cxt $ map (\v -> [t|SqlEq $(varT v)|]) tyVars) [t|SqlIn $(tupTy $ \v -> [t|E.SqlExpr (E.Value $(v))|]) $(tupTy $ \v -> [t|E.Value $(v)|])|]

src/Database/Persist/TH/Directory.hs

@@ -18,13 +18,13 @@ import qualified System.Directory.Tree as DirTree
 import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
 
 import Control.Lens
-  
+
 
 persistDirectoryWith :: PersistSettings -> FilePath -> Q Exp
 persistDirectoryWith settings dir = do
   files <- runIO . flip DirTree.readDirectoryWith dir $ \fp -> runMaybeT $ do
     fn <- MaybeT . return . fromNullable $ takeFileName fp
-    guard . not $ head fn == '.'
+    guard $ head fn /= '.'
     guard . not $ head fn == '#' && last fn == '#'
 
     lift $ do
@@ -32,5 +32,5 @@ persistDirectoryWith settings dir = do
       SIO.hSetEncoding h SIO.utf8_bom
       Text.hGetContents h
   mapM_ qAddDependentFile . toListOf (traverse . filtered (has $ _2 . _Just) . _1) $ DirTree.zipPaths files
-  
+
   parseReferences settings . Text.intercalate "\n" . toListOf (traverse . _Just) $ DirTree.dirTree files

src/Foundation.hs

@@ -15,7 +15,8 @@ import Foundation.Routes as Foundation
 
 
 import Import.NoFoundation hiding (embedFile)
-import Database.Persist.Sql (runSqlPool)
+import Database.Persist.Sql
+    ( runSqlPool, transactionUndo, SqlReadBackend(..) )
 import Text.Hamlet          (hamletFile)
 
 import Yesod.Auth.Message
@@ -106,7 +107,6 @@ import qualified Web.ServerSession.Frontend.Yesod.Jwt as JwtSession
 import Web.Cookie
 
 import Yesod.Core.Types (GHState(..), HandlerData(..), HandlerContents, RunHandlerEnv(rheSite, rheChild))
-import Database.Persist.Sql (transactionUndo, SqlReadBackend(..))
 
 import qualified Control.Retry as Retry
 import GHC.IO.Exception (IOErrorType(OtherError))
@@ -197,7 +197,7 @@ data Nav
 
 makeLenses_ ''Nav
 makePrisms ''Nav
-  
+
 data NavChildren
 type instance Children NavChildren a = ChildrenNavChildren a
 type family ChildrenNavChildren a where
@@ -218,13 +218,13 @@ navLinkAccess NavLink{..} = handle shortCircuit $ liftHandler navAccess' `and2M`
   where
     shortCircuit :: HandlerContents -> m Bool
     shortCircuit _ = return False
-    
+
     accessCheck :: HasRoute UniWorX route => NavType -> route -> m Bool
     accessCheck nt (urlRoute -> route) = do
       authCtx <- getAuthContext
       $memcachedByHere (Just $ Right 120) (authCtx, nt, route) $
         bool hasWriteAccessTo hasReadAccessTo (is _NavTypeLink nt) route
-  
+
 
 getTimeLocale' :: [Lang] -> TimeLocale
 getTimeLocale' = $(timeLocaleMap [("de-de", "de_DE.utf8"), ("en-GB", "en_GB.utf8")])
@@ -245,7 +245,7 @@ appLanguagesOpts = do
         }
       langOptions = map mkOption $ toList appLanguages
   return $ mkOptionList langOptions
-  
+
 instance RenderMessage UniWorX WeekDay where
   renderMessage _ ls wDay = pack . fst $ wDays (getTimeLocale' ls) !! (fromEnum wDay `mod` 7)
 
@@ -420,7 +420,7 @@ requireCurrentBearerRestrictions = runMaybeT $ do
   bearer <- requireBearerToken
   route <- MaybeT getCurrentRoute
   hoistMaybe $ bearer ^? _bearerRestrictionIx route
-  
+
 maybeCurrentBearerRestrictions :: forall a m.
                                   ( MonadHandler m
                                   , HandlerSite m ~ UniWorX
@@ -451,7 +451,7 @@ isDryRun = $cachedHere $ orM
       mAuthId <- maybeAuthId
       currentRoute <- maybe (permissionDeniedI MsgUnauthorizedToken404) return =<< getCurrentRoute
       isWrite <- isWriteRequest currentRoute
-      
+
       let noTokenAuth :: AuthDNF -> AuthDNF
           noTokenAuth = over _dnfTerms . Set.filter . noneOf (re _nullable . folded) $ (== AuthToken) . plVar
 
@@ -529,7 +529,7 @@ tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of
            E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
            E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
            E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
-      
+
       E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
     guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
     return Authorized
@@ -651,7 +651,7 @@ tagAccessPredicate AuthCorrector = APDB $ \mAuthId route _ -> exceptT return ret
     CSubmissionR _ _ _ _ cID _ -> $cachedHereBinary (mAuthId, cID) . maybeT (unauthorizedI MsgUnauthorizedSubmissionCorrector) $ do
       sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
       Submission{..} <- MaybeT . lift $ get sid
-      guard $ maybe False (== authId) submissionRatingBy
+      guard $ Just authId == submissionRatingBy
       return Authorized
     CSheetR tid ssh csh shn _ -> $cachedHereBinary (mAuthId, tid, ssh, csh, shn) . maybeT (unauthorizedI MsgUnauthorizedSheetCorrector) $ do
       Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh
@@ -742,24 +742,10 @@ tagAccessPredicate AuthSubmissionGroup = APDB $ \mAuthId route _ -> case route o
         E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
         E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val course
              E.&&. submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
-  
+
     return Authorized
   r -> $unsupportedAuthPredicate AuthSubmissionGroup r
 tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
-  CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
-    course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
-    allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
-    allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
-
-    case allocation of
-      Nothing -> return ()
-      Just Allocation{..} -> do
-        cTime <- liftIO getCurrentTime
-        guard $ NTop allocationStaffAllocationFrom <= NTop (Just cTime)
-        guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
-
-    return Authorized
-
   CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do
     course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
     Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
@@ -783,7 +769,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
           -> guard $ visible
                   && NTop (Just cTime) <= NTop examDeregisterUntil
       ERegisterOccR occn -> do
-        occId <- (>>= hoistMaybe) . $cachedHereBinary (eId, occn) . lift . getKeyBy $ UniqueExamOccurrence eId occn
+        occId <- hoistMaybe <=< $cachedHereBinary (eId, occn) . lift . getKeyBy $ UniqueExamOccurrence eId occn
         if
           | (registration >>= examRegistrationOccurrence . entityVal) == Just occId
             -> guard $ visible
@@ -920,7 +906,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
   MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
     smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
     SystemMessage{systemMessageFrom, systemMessageTo} <- $cachedHereBinary smId . MaybeT $ get smId
-    cTime <- (NTop . Just) <$> liftIO getCurrentTime
+    cTime <- NTop . Just <$> liftIO getCurrentTime
     guard $ NTop systemMessageFrom <= cTime
          && NTop systemMessageTo   >= cTime
     return Authorized
@@ -928,7 +914,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
   MessageHideR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
     smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
     SystemMessage{systemMessageFrom, systemMessageTo} <- $cachedHereBinary smId . MaybeT $ get smId
-    cTime <- (NTop . Just) <$> liftIO getCurrentTime
+    cTime <- NTop . Just <$> liftIO getCurrentTime
     guard $ NTop systemMessageFrom <= cTime
          && NTop systemMessageTo   >= cTime
     return Authorized
@@ -936,7 +922,7 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
   CNewsR _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedCourseNewsTime) $ do
     nId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
     CourseNews{courseNewsVisibleFrom} <- $cachedHereBinary nId . MaybeT $ get nId
-    cTime <- (NTop . Just) <$> liftIO getCurrentTime
+    cTime <- NTop . Just <$> liftIO getCurrentTime
     guard $ NTop courseNewsVisibleFrom <= cTime
     return Authorized
 
@@ -1247,7 +1233,7 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of
         when onlyActive $
           E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
       -- participant has at least one submission
-      when (not onlyActive) $
+      unless onlyActive $
         mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do
           E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
           E.on $ sheet  E.^. SheetId   E.==. submission E.^. SubmissionSheet
@@ -1257,7 +1243,7 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of
                E.&&. course E.^. CourseSchool    E.==. E.val ssh
                E.&&. course E.^. CourseShorthand E.==. E.val csh
       -- participant is member of a submissionGroup
-      when (not onlyActive) $
+      unless onlyActive $
         mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser) -> do
           E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
           E.on $ course E.^. CourseId  E.==. submissionGroup E.^. SubmissionGroupCourse
@@ -1274,7 +1260,7 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of
              E.&&. course E.^. CourseSchool    E.==. E.val ssh
              E.&&. course E.^. CourseShorthand E.==. E.val csh
       -- participant is a tutorial user
-      when (not onlyActive) $
+      unless onlyActive $
         mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialUser) -> do
           E.on $ tutorial  E.^. TutorialId   E.==. tutorialUser E.^. TutorialParticipantTutorial
           E.on $ course E.^. CourseId  E.==. tutorial E.^. TutorialCourse
@@ -1306,7 +1292,7 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of
              E.&&. course E.^. CourseSchool    E.==. E.val ssh
              E.&&. course E.^. CourseShorthand E.==. E.val csh
       -- participant has an exam result for this course
-      when (not onlyActive) $
+      unless onlyActive $
         mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` exam `E.InnerJoin` examResult) -> do
           E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
           E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
@@ -1315,7 +1301,7 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of
                E.&&. course E.^. CourseSchool    E.==. E.val ssh
                E.&&. course E.^. CourseShorthand E.==. E.val csh
       -- participant is registered for an exam for this course
-      when (not onlyActive) $
+      unless onlyActive $
         mapExceptT ($cachedHereBinary (participant, tid, ssh, csh)) . authorizedIfExists $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
           E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
           E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
@@ -1323,21 +1309,19 @@ tagAccessPredicate AuthParticipant = APDB $ \mAuthId route _ -> case route of
                E.&&. course E.^. CourseTerm      E.==. E.val tid
                E.&&. course E.^. CourseSchool    E.==. E.val ssh
                E.&&. course E.^. CourseShorthand E.==. E.val csh
-
-      return ()
 tagAccessPredicate AuthApplicant = APDB $ \mAuthId route _ -> case route of
   CourseR tid ssh csh (CUserR cID) -> maybeT (unauthorizedI MsgUnauthorizedApplicant) $ do
-    uid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID 
+    uid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
     isApplicant <- isCourseApplicant tid ssh csh uid
     guard isApplicant
     return Authorized
-    
+
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedApplicantSelf) $ do
     uid <- hoistMaybe mAuthId
     isApplicant <- isCourseApplicant tid ssh csh uid
     guard isApplicant
     return Authorized
-  
+
   r -> $unsupportedAuthPredicate AuthApplicant r
   where
     isCourseApplicant tid ssh csh uid = lift . $cachedHereBinary (uid, tid, ssh, csh) . E.selectExists . E.from $ \(course `E.InnerJoin` courseApplication) -> do
@@ -1666,8 +1650,8 @@ wouldHaveReadAccessToIff, wouldHaveWriteAccessToIff
   => [(AuthTag, Bool)] -- ^ Assumptions
   -> Route UniWorX
   -> m Bool
-wouldHaveReadAccessToIff assumptions route = and2M (fmap not $ hasReadAccessTo route) $ wouldHaveReadAccessTo assumptions route
+wouldHaveReadAccessToIff assumptions route = and2M (not <$> hasReadAccessTo route) $ wouldHaveReadAccessTo assumptions route
-wouldHaveWriteAccessToIff assumptions route = and2M (fmap not $ hasWriteAccessTo route) $ wouldHaveWriteAccessTo assumptions route
+wouldHaveWriteAccessToIff assumptions route = and2M (not <$> hasWriteAccessTo route) $ wouldHaveWriteAccessTo assumptions route
 
 -- | Conditional redirect that hides the URL if the user is not authorized for the route
 redirectAccess :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m a
@@ -1728,10 +1712,10 @@ instance Yesod UniWorX where
 
     makeSessionBackend app@UniWorX{ appSettings' = AppSettings{..}, ..} = notForBearer . sameSite $ case appSessionStore of
         SessionStorageMemcachedSql sqlStore
-          -> mkBackend =<< stateSettings <$> ServerSession.createState sqlStore
+          -> mkBackend . stateSettings =<< ServerSession.createState sqlStore
         SessionStorageAcid acidStore
           | appServerSessionAcidFallback
-            -> mkBackend =<< stateSettings <$> ServerSession.createState acidStore
+            -> mkBackend . stateSettings =<< ServerSession.createState acidStore
         _other
           -> return Nothing
       where
@@ -1764,7 +1748,7 @@ instance Yesod UniWorX where
                 notForBearer' (SessionBackend load)
                   = let load' req
                           | aHdrs <- mapMaybe (\(h, v) -> v <$ guard (h == W.hAuthorization)) $ W.requestHeaders req
-                          , any (is _Just) $ map W.extractBearerAuth aHdrs
+                          , any (is _Just . W.extractBearerAuth) aHdrs
                           = return (mempty, const $ return [])
                           | otherwise
                           = load req
@@ -1786,7 +1770,7 @@ instance Yesod UniWorX where
           dryRun <- isDryRun
           if | dryRun -> do
                  hData <- ask
-                 prevState <- readIORef (handlerState hData) 
+                 prevState <- readIORef (handlerState hData)
                  let
                    restoreSession =
                      modifyIORef (handlerState hData) $
@@ -1798,7 +1782,7 @@ instance Yesod UniWorX where
                    handler' = local (\hd -> hd { handlerEnv = (handlerEnv hd) { rheSite = site', rheChild = site' } }) handler
 
                  addCustomHeader HeaderDryRun ("1" :: Text)
-                 
+
                  handler' `finally` restoreSession
              | otherwise -> handler
         updateFavouritesMiddleware :: Handler a -> Handler a
@@ -1993,7 +1977,7 @@ updateFavourites :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX)
 updateFavourites cData = void . runMaybeT $ do
   $logDebugS "updateFavourites" "Updating favourites"
 
-  now <- liftIO $ getCurrentTime
+  now <- liftIO getCurrentTime
   uid <- MaybeT $ liftHandler maybeAuthId
   mcid  <- for cData $ \(tid, ssh, csh) -> MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
   User{userMaxFavourites} <- MaybeT $ get uid
@@ -2107,7 +2091,7 @@ siteLayout' headingOverride widget = do
               [ E.when_ isCurrent    E.then_ . E.just $ E.val FavouriteCurrent
               , E.when_ isAssociated E.then_ . E.just $ E.val FavouriteParticipant
               ] (E.else_ $ courseFavourite E.?. CourseFavouriteReason)
-            
+
         E.where_ $ ((isFavourite E.||. isAssociated) E.&&. notBlacklist) E.||. isCurrent
 
         return (course, reason, courseVisible)
@@ -2138,7 +2122,7 @@ siteLayout' headingOverride widget = do
               $logDebugS "FavouriteQuickActions" $ tshow cK <> " Checking..."
               items <- memcachedLimitedKeyTimeoutBy
                 MemcachedLimitKeyFavourites appFavouritesQuickActionsBurstsize appFavouritesQuickActionsAvgInverseRate 1
-                (Right <$> appFavouritesQuickActionsCacheTTL) 
+                (Right <$> appFavouritesQuickActionsCacheTTL)
                 appFavouritesQuickActionsTimeout
                 cK
                 cK
@@ -2207,7 +2191,7 @@ siteLayout' headingOverride widget = do
             -> let route = navRoute'
                    ident = navIdent
                 in $(widgetFile "widgets/navbar/item")
-        NavPageActionPrimary{ navLink = navLink@NavLink{..}, .. }
+        NavPageActionPrimary{ navLink = navLink@NavLink{..} }
           -> let pWidget
                    | NavTypeLink{..} <- navType
                    , navModal
@@ -2226,7 +2210,7 @@ siteLayout' headingOverride widget = do
                  sWidgets = navChildren'
                    & map (\(l, i, r) -> navWidget (NavPageActionSecondary l, i, Just r, []))
               in $(widgetFile "widgets/pageaction/primary-wrapper")
-        NavPageActionSecondary{ navLink = navLink@NavLink{..}, .. }
+        NavPageActionSecondary{ navLink = navLink@NavLink{..} }
           | NavTypeLink{..} <- navType
           , navModal
             -> customModal Modal
@@ -2352,7 +2336,7 @@ getSystemMessageState smId = liftHandler $ do
 applySystemMessages :: (MonadHandler m, HandlerSite m ~ UniWorX) => m ()
 applySystemMessages = liftHandler . maybeT_ . catchMPlus (Proxy @CryptoIDError) $ do
   lift $ maybeAuthId >>= traverse_ syncSystemMessageHidden
-  
+
   cRoute <- lift getCurrentRoute
   guard $ cRoute /= Just NewsR
 
@@ -2369,14 +2353,14 @@ applySystemMessages = liftHandler . maybeT_ . catchMPlus (Proxy @CryptoIDError)
             , systemMessageHiddenTime
             }
             [ SystemMessageHiddenTime =. systemMessageHiddenTime ]
-        
+
         when (maybe False (maybe (const True) (<=) userSystemMessageHidden) userSystemMessageUnhidden) $ do
           deleteBy $ UniqueSystemMessageHidden uid smId
 
         modifyRegisteredCookieJson CookieSystemMessageState $ \(fold -> MergeHashMap hm)
           -> fmap MergeHashMap . assertM' (/= mempty) $
                HashMap.update (\smSt' -> assertM' (/= mempty) $ smSt' { userSystemMessageHidden = Nothing, userSystemMessageUnhidden = Nothing }) cID hm
-    
+
     applyMessage (Entity smId SystemMessage{..}) = maybeT_ $ do
       guard $ not systemMessageNewsOnly
 
@@ -2436,7 +2420,7 @@ instance YesodBreadcrumbs UniWorX where
     User{..} <- MaybeT . runDB $ get uid
     return (userDisplayName, Just UsersR)
   breadcrumb (AdminUserDeleteR cID) = i18nCrumb MsgBreadcrumbUserDelete . Just $ AdminUserR cID
-  breadcrumb (AdminHijackUserR cID) = i18nCrumb MsgBreadcrumbUserHijack . Just $ AdminUserR cID 
+  breadcrumb (AdminHijackUserR cID) = i18nCrumb MsgBreadcrumbUserHijack . Just $ AdminUserR cID
   breadcrumb (UserNotificationR cID) = do
     mayList <- hasReadAccessTo UsersR
     if
@@ -2455,12 +2439,12 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb AdminFunctionaryInviteR = i18nCrumb MsgBreadcrumbFunctionaryInvite Nothing
 
   breadcrumb AdminR           = i18nCrumb MsgAdminHeading           Nothing
-  breadcrumb AdminFeaturesR   = i18nCrumb MsgAdminFeaturesHeading $ Just AdminR 
+  breadcrumb AdminFeaturesR   = i18nCrumb MsgAdminFeaturesHeading $ Just AdminR
   breadcrumb AdminTestR       = i18nCrumb MsgMenuAdminTest        $ Just AdminR
   breadcrumb AdminErrMsgR     = i18nCrumb MsgMenuAdminErrMsg      $ Just AdminR
   breadcrumb AdminTokensR     = i18nCrumb MsgMenuAdminTokens      $ Just AdminR
   breadcrumb AdminCrontabR    = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR
-  
+
   breadcrumb SchoolListR      = i18nCrumb MsgMenuSchoolList       $ Just AdminR
   breadcrumb (SchoolR ssh SchoolEditR) = maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
     School{..} <- MaybeT . runDB $ get ssh
@@ -2514,12 +2498,12 @@ instance YesodBreadcrumbs UniWorX where
     AShowR      -> maybeT (i18nCrumb MsgBreadcrumbAllocation $ Just AllocationListR) $ do
       mr <- getMessageRender
       Entity _ Allocation{allocationName} <- MaybeT . runDB . getBy $ TermSchoolAllocationShort tid ssh ash
-      return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{CI.original (unSchoolKey ssh)})|], Just $ AllocationListR)
+      return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{CI.original (unSchoolKey ssh)})|], Just AllocationListR)
     ARegisterR  -> i18nCrumb MsgBreadcrumbAllocationRegister . Just $ AllocationR tid ssh ash AShowR
     AApplyR cID -> maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ AllocationR tid ssh ash AShowR) $ do
       cid <- decrypt cID
       Course{..} <- hoist runDB $ do
-        aid <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash 
+        aid <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash
         guardM . lift $ exists [ AllocationCourseAllocation ==. aid, AllocationCourseCourse ==. cid ]
         MaybeT $ get cid
       return (CI.original courseName, Just $ AllocationR tid ssh ash AShowR)
@@ -2571,7 +2555,7 @@ instance YesodBreadcrumbs UniWorX where
     CNDeleteR -> i18nCrumb MsgBreadcrumbCourseNewsDelete . Just $ CNewsR tid ssh csh cID CNShowR
     CNArchiveR -> i18nCrumb MsgBreadcrumbCourseNewsArchive . Just $ CNewsR tid ssh csh cID CNShowR
     CNFileR _ -> i18nCrumb MsgBreadcrumbCourseNewsFile . Just $ CNewsR tid ssh csh cID CNShowR
-  
+
   breadcrumb (CourseR tid ssh csh CEventsNewR)    = i18nCrumb MsgMenuCourseEventNew . Just $ CourseR tid ssh csh CShowR
   breadcrumb (CourseR tid ssh csh (CourseEventR _cID sRoute)) = case sRoute of
     CEvEditR   -> i18nCrumb MsgMenuCourseEventEdit . Just $ CourseR tid ssh csh CShowR
@@ -2668,7 +2652,7 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb CorrectionsDownloadR = i18nCrumb MsgMenuCorrectionsDownload $ Just CorrectionsR
 
   breadcrumb (CryptoUUIDDispatchR _) = i18nCrumb MsgBreadcrumbCryptoIDDispatch Nothing
-  
+
   breadcrumb (MessageR _) = do
     mayList <- (== Authorized) <$> evalAccess MessageListR False
     if
@@ -2695,9 +2679,9 @@ instance YesodBreadcrumbs UniWorX where
           | otherwise -> EExamListR
     EEEditR -> i18nCrumb MsgBreadcrumbExternalExamEdit . Just $ EExamR tid ssh coursen examn EEShowR
     EEUsersR -> i18nCrumb MsgBreadcrumbExternalExamUsers . Just $ EExamR tid ssh coursen examn EEShowR
-    EEGradesR -> i18nCrumb MsgBreadcrumbExternalExamGrades . Just $ EExamR tid ssh coursen examn EEShowR 
+    EEGradesR -> i18nCrumb MsgBreadcrumbExternalExamGrades . Just $ EExamR tid ssh coursen examn EEShowR
-    EEStaffInviteR -> i18nCrumb MsgBreadcrumbExternalExamStaffInvite . Just $ EExamR tid ssh coursen examn EEShowR 
+    EEStaffInviteR -> i18nCrumb MsgBreadcrumbExternalExamStaffInvite . Just $ EExamR tid ssh coursen examn EEShowR
-  
+
   -- breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
 
 submissionList :: TermId -> CourseShorthand -> SheetName -> UserId -> DB [E.Value SubmissionId]
@@ -2780,7 +2764,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
         }
   , do
       mCurrentRoute <- getCurrentRoute
-      
+
       return NavHeader
         { navHeaderRole = NavHeaderSecondary
         , navIcon       = IconMenuHelp
@@ -2792,7 +2776,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
           , navQuick'      = mempty
           , navForceActive = False
           }
-        } 
+        }
   , return $ NavFooter NavLink
       { navLabel       = MsgMenuDataProt
       , navRoute       = LegalR :#: ("data-protection" :: Text)
@@ -2901,7 +2885,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
       { navHeaderRole = NavHeaderPrimary
       , navLabel      = SomeMessage MsgAdminHeading
       , navIcon       = IconMenuAdmin
-      , navChildren   = 
+      , navChildren   =
           [ NavLink
               { navLabel       = MsgMenuUsers
               , navRoute       = UsersR
@@ -2972,7 +2956,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
       { navHeaderRole = NavHeaderPrimary
       , navLabel      = SomeMessage (mempty :: Text)
       , navIcon       = IconMenuExtra
-      , navChildren   = 
+      , navChildren   =
           [ NavLink
               { navLabel       = MsgMenuCourseNew
               , navRoute       = CourseNewR
@@ -3198,7 +3182,7 @@ pageActions (CourseR tid ssh csh CShowR) = do
         , navAccess' = do
             uid <- requireAuthId
             runDB $ do
-              cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh 
+              cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
               E.selectExists $ do
                 (_school, isForced) <- courseExamOfficeSchools (E.val uid) (E.val cid)
                 E.where_ $ E.not_ isForced
@@ -3476,7 +3460,7 @@ pageActions HelpR = return
           , ("allocations", MsgInfoLecturerAllocations)
           ] :: [(Text, UniWorXMessage)]
         return NavLink
-          { navLabel 
+          { navLabel
           , navRoute       = InfoLecturerR :#: section
           , navAccess'     = return True
           , navType        = NavTypeLink { navModal = False }
@@ -3591,7 +3575,7 @@ pageActions (AllocationR tid ssh ash AShowR) = return
       }
     , navChildren = []
     }
-  ]  
+  ]
 pageActions (AllocationR tid ssh ash AUsersR) = return
   [ NavPageActionPrimary
     { navLink = NavLink
@@ -3615,7 +3599,7 @@ pageActions (AllocationR tid ssh ash AUsersR) = return
       }
     , navChildren = []
     }
-  ]  
+  ]
 pageActions CourseListR = do
   participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR
   return
@@ -3652,7 +3636,7 @@ pageActions CourseListR = do
         }
       , navChildren = participantsSecondary
       }
-    ] 
+    ]
 pageActions CourseNewR = return
   [ NavPageActionPrimary
     { navLink = NavLink
@@ -3692,14 +3676,13 @@ pageActions (CourseR tid ssh csh CCorrectionsR) = return
           case muid of
             Nothing -> return False
             (Just uid) -> do
-              ok <- runDB . E.selectExists . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission) -> do
+              runDB . E.selectExists . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission) -> do
                 E.on $ submission E.^. SubmissionSheet E.==. sheet  E.^. SheetId
                 E.on $ sheet      E.^. SheetCourse     E.==. course E.^. CourseId
                 E.where_ $ submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
                   E.&&. course E.^. CourseTerm      E.==. E.val tid
                   E.&&. course E.^. CourseSchool    E.==. E.val ssh
                   E.&&. course E.^. CourseShorthand E.==. E.val csh
-              return ok
       , navType        = NavTypeLink { navModal = False }
       , navQuick'      = navQuick NavQuickViewPageActionSecondary
       , navForceActive = False
@@ -3723,7 +3706,7 @@ pageActions (CourseR tid ssh csh SheetListR) = do
       , navChildren = correctionsSecondary
       }
   showCorrections <- maybeT (return False) $ True <$ navAccess navCorrections
-  
+
   return $
     [ NavPageActionPrimary
       { navLink = NavLink
@@ -4070,7 +4053,7 @@ pageActions (CSheetR tid ssh csh shn SShowR) = do
       , navChildren = subsSecondary
       }
   showSubmissions <- maybeT (return False) $ True <$ navAccess navSubmissions
-  
+
   return $
     [ NavPageActionPrimary
       { navLink = NavLink
@@ -4513,19 +4496,19 @@ pageHeading UsersR
   = Just $ i18nHeading MsgUsers
 pageHeading (AdminUserR _)
   = Just $ i18nHeading MsgAdminUserHeading
-pageHeading (AdminTestR)
+pageHeading AdminTestR
-  = Just $ [whamlet|Internal Code Demonstration Page|]
+  = Just [whamlet|Internal Code Demonstration Page|]
-pageHeading (AdminErrMsgR)
+pageHeading AdminErrMsgR
   = Just $ i18nHeading MsgErrMsgHeading
 
-pageHeading (InfoR)
+pageHeading InfoR
   = Just $ i18nHeading MsgInfoHeading
-pageHeading (LegalR)
+pageHeading LegalR
   = Just $ i18nHeading MsgLegalHeading
-pageHeading (VersionR)
+pageHeading VersionR
   = Just $ i18nHeading MsgVersionHeading
 
-pageHeading (HelpR)
+pageHeading HelpR
   = Just $ i18nHeading MsgHelpRequest
 
 pageHeading ProfileR
@@ -4548,8 +4531,8 @@ pageHeading (TermSchoolCourseListR tid ssh)
       School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh
       i18nHeading $ MsgTermSchoolCourseListHeading tid school
 
-pageHeading (CourseListR)
+pageHeading CourseListR
-  = Just $ i18nHeading $ MsgCourseListTitle
+  = Just $ i18nHeading MsgCourseListTitle
 pageHeading CourseNewR
   = Just $ i18nHeading MsgCourseNewHeading
 pageHeading (CourseR tid ssh csh CShowR)
@@ -4661,25 +4644,25 @@ routeNormalizers =
       return $ route & typesUsing @RouteChildren @CourseShorthand . filtered (== csh) .~ courseShorthand
     ncSheet = maybeOrig $ \route -> do
       CSheetR tid ssh csh shn _ <- return route
-      Entity cid Course{..} <- MaybeT . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      cid <- MaybeT . $cachedHereBinary (tid, ssh, csh) . lift . getKeyBy $ TermSchoolCourseShort tid ssh csh
       Entity _ Sheet{..} <- MaybeT . $cachedHereBinary (cid, shn) . lift . getBy $ CourseSheet cid shn
       caseChanged shn sheetName
       return $ route & typesUsing @RouteChildren @SheetName . filtered (== shn) .~ sheetName
     ncMaterial = maybeOrig $ \route -> do
       CMaterialR tid ssh csh mnm _ <- return route
-      Entity cid Course{..} <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      cid <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getKeyBy $ TermSchoolCourseShort tid ssh csh
       Entity _ Material{..} <- MaybeT . $cachedHereBinary (cid, mnm) . lift . getBy $ UniqueMaterial cid mnm
       caseChanged mnm materialName
       return $ route & typesUsing @RouteChildren @MaterialName . filtered (== mnm) .~ materialName
     ncTutorial = maybeOrig $ \route -> do
       CTutorialR tid ssh csh tutn _ <- return route
-      Entity cid Course{..} <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      cid <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getKeyBy $ TermSchoolCourseShort tid ssh csh
       Entity _ Tutorial{..} <- MaybeT . $cachedHereBinary (cid, tutn) . lift . getBy $ UniqueTutorial cid tutn
       caseChanged tutn tutorialName
       return $ route & typesUsing @RouteChildren @TutorialName . filtered (== tutn) .~ tutorialName
     ncExam = maybeOrig $ \route -> do
       CExamR tid ssh csh examn _ <- return route
-      Entity cid Course{..} <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getBy $ TermSchoolCourseShort tid ssh csh
+      cid <- MaybeT  . $cachedHereBinary (tid, ssh, csh) . lift . getKeyBy $ TermSchoolCourseShort tid ssh csh
       Entity _ Exam{..} <- MaybeT . $cachedHereBinary (cid, examn) . lift . getBy $ UniqueExam cid examn
       caseChanged examn examName
       return $ route & typesUsing @RouteChildren @ExamName . filtered (== examn) .~ examName
@@ -4725,7 +4708,7 @@ runSqlPoolRetry :: forall m a backend.
                 => ReaderT backend m a
                 -> Pool backend
                 -> m a
-runSqlPoolRetry action pool = do 
+runSqlPoolRetry action pool = do
   let policy = Retry.fullJitterBackoff 1e3 & Retry.limitRetriesByCumulativeDelay 10e6
       handlers = Retry.skipAsyncExceptions `snoc` Retry.logRetries suggestRetry logRetry
         where suggestRetry :: IOException -> m Bool
@@ -4748,7 +4731,7 @@ runSqlPoolRetry action pool = do
 runDBRead :: ReaderT SqlReadBackend Handler a -> Handler a
 runDBRead action = do
   $logDebugS "YesodPersist" "runDBRead"
-  runSqlPoolRetry (withReaderT SqlReadBackend action) =<< appConnPool <$> getYesod
+  runSqlPoolRetry (withReaderT SqlReadBackend action) . appConnPool =<< getYesod
 
 -- How to run database actions.
 instance YesodPersist UniWorX where
@@ -4762,7 +4745,7 @@ instance YesodPersist UniWorX where
             | dryRun = action <* transactionUndo
             | otherwise = action
 
-      runSqlPoolRetry action' =<< appConnPool <$> getYesod
+      runSqlPoolRetry action' . appConnPool =<< getYesod
 
 instance YesodPersistRunner UniWorX where
     getDBRunner = do
@@ -4914,7 +4897,7 @@ upsertCampusUser plugin ldapData = do
                   -- , UserDisplayName             =. userDisplayName
                   , UserFirstName               =. userFirstName
                   , UserSurname                 =. userSurname
-                  , UserTitle                   =. userTitle  
+                  , UserTitle                   =. userTitle
                   , UserEmail                   =. userEmail
                   , UserSex                     =. userSex
                   , UserLastLdapSynchronisation =. Just now
@@ -4992,7 +4975,7 @@ upsertCampusUser plugin ldapData = do
           knownParents <- lift $ map (studySubTermsParent . entityVal) <$> selectList [ StudySubTermsChild ==. subterm ] []
           let matchingFeatures = case knownParents of
                 []      -> filter ((== subSemester) . studyFeaturesSemester) unusedFeats
-                ps      -> filter (\StudyFeatures{studyFeaturesField, studyFeaturesSemester} -> any (== studyFeaturesField) ps && studyFeaturesSemester == subSemester) unusedFeats
+                ps      -> filter (\StudyFeatures{studyFeaturesField, studyFeaturesSemester} -> elem studyFeaturesField ps && studyFeaturesSemester == subSemester) unusedFeats
           when (null knownParents) . forM_ matchingFeatures $ \StudyFeatures{..} ->
             tell $ Set.singleton (subterm, Just studyFeaturesField)
           if
@@ -5051,12 +5034,12 @@ upsertCampusUser plugin ldapData = do
     insertMaybe studyFeaturesDegree $ StudyDegree (unStudyDegreeKey studyFeaturesDegree) Nothing Nothing
     insertMaybe studyFeaturesField $ StudyTerms (unStudyTermsKey studyFeaturesField) Nothing Nothing Nothing Nothing
     oldFs <- selectKeysList
-      ([ StudyFeaturesUser ==. studyFeaturesUser
+      [ StudyFeaturesUser ==. studyFeaturesUser
        , StudyFeaturesDegree ==. studyFeaturesDegree
        , StudyFeaturesField ==. studyFeaturesField
        , StudyFeaturesType ==. studyFeaturesType
        , StudyFeaturesSemester ==. studyFeaturesSemester
-       ])
+       ]
       []
     case oldFs of
       [oldF] -> update oldF
@@ -5073,20 +5056,20 @@ upsertCampusUser plugin ldapData = do
   associateUserSchoolsByTerms userId
 
   let
-    userAssociatedSchools = fmap concat $ forM userAssociatedSchools' parseLdapSchools
+    userAssociatedSchools = concat <$> forM userAssociatedSchools' parseLdapSchools
     userAssociatedSchools' = do
       (k, v) <- ldapData
       guard $ k == ldapUserSchoolAssociation
       v' <- v
       Right str <- return $ Text.decodeUtf8' v'
       return str
-  
+
   ss <- either (throwM . CampusUserInvalidAssociatedSchools . tshow) return userAssociatedSchools
 
   forM_ ss $ \frag -> void . runMaybeT $ do
     let
       exactMatch = MaybeT . getBy $ UniqueOrgUnit frag
-      infixMatch = (hoistMaybe . preview _head =<<) . lift . E.select . E.from $ \schoolLdap -> do
+      infixMatch = (hoistMaybe . preview _head) <=< (lift . E.select . E.from) $ \schoolLdap -> do
         E.where_ $ E.val frag `E.isInfixOf` schoolLdap E.^. SchoolLdapOrgUnit
              E.&&. E.not_ (E.isNothing $ schoolLdap E.^. SchoolLdapSchool)
         return schoolLdap
@@ -5100,7 +5083,7 @@ upsertCampusUser plugin ldapData = do
       }
 
   forM_ ss $ void . insertUnique . SchoolLdap Nothing
-  
+
   return user
   where
     insertMaybe key val = get key >>= maybe (insert_ val) (\_ -> return ())
@@ -5221,7 +5204,7 @@ instance YesodAuth UniWorX where
             _other -> return res
 
       $logDebugS "auth" $ tshow Creds{..}
-      UniWorX{ appSettings' = AppSettings{ appUserDefaults = UserDefaultConf{..}, ..}, .. } <- getYesod
+      UniWorX{..} <- getYesod
 
       flip catches excHandlers $ case appLdapPool of
         Just ldapPool
@@ -5232,7 +5215,7 @@ instance YesodAuth UniWorX where
         _other
           -> acceptExisting
 
-    authPlugins (UniWorX{ appSettings' = AppSettings{..}, appLdapPool }) = catMaybes
+    authPlugins UniWorX{ appSettings' = AppSettings{..}, appLdapPool } = catMaybes
       [ flip campusLogin campusUserFailoverMode <$> appLdapPool
       , Just . hashLogin $ pwHashAlgorithm appAuthPWHash
       , dummyLogin <$ guard appAuthDummyLogin
@@ -5262,7 +5245,7 @@ campusUserFailoverMode = FailoverUnlimited
 instance YesodAuthPersist UniWorX where
   getAuthEntity = liftHandler . runDBRead . get
 
-  
+
 unsafeHandler :: UniWorX -> Handler a -> IO a
 unsafeHandler f h = do
   logger <- makeLogger f

src/Foundation/I18n.hs

@@ -116,7 +116,7 @@ ordinalEN (toMessage -> numStr) = case lastChar of
   Just '3' -> [st|#{numStr}rd|]
   _other   -> [st|#{numStr}th|]
   where
-    lastChar = last <$> fromNullable numStr 
+    lastChar = last <$> fromNullable numStr
 
 
 -- Convenience Type for Messages, since Yesod messages cannot deal with compound type identifiers
@@ -178,7 +178,7 @@ instance RenderMessage UniWorX MsgLanguage where
     | ("de" : "DE" : _) <- lang' = mr MsgGermanGermany
     | ("de" : _)        <- lang' = mr MsgGerman
     | ("en" : "EU" : _) <- lang' = mr MsgEnglishEurope
-    | ("en" : _)        <- lang' = mr MsgEnglish 
+    | ("en" : _)        <- lang' = mr MsgEnglish
     | otherwise = lang
     where
       mr = renderMessage foundation $ lang : filter (/= lang) ls
@@ -255,7 +255,7 @@ instance RenderMessage UniWorX StudyDegreeTerm where
     where
       mr :: RenderMessage UniWorX msg => msg -> Text
       mr = renderMessage foundation ls
-  
+
 newtype ShortStudyFieldType = ShortStudyFieldType StudyFieldType
 embedRenderMessageVariant ''UniWorX ''ShortStudyFieldType ("Short" <>)
 
@@ -341,7 +341,7 @@ instance RenderMessage UniWorX UniWorXMessages where
 uniworxMessages :: [UniWorXMessage] -> UniWorXMessages
 uniworxMessages = UniWorXMessages . map SomeMessage
 
-  
+
 -- This instance is required to use forms. You can modify renderMessage to
 -- achieve customized and internationalized form validation messages.
 instance RenderMessage UniWorX FormMessage where

src/Foundation/Routes.hs

@@ -75,11 +75,11 @@ pattern CSubmissionR tid ssh csh shn cid ptn
 pattern CApplicationR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> CourseApplicationR -> Route UniWorX
 pattern CApplicationR tid ssh csh appId ptn
   = CourseR tid ssh csh (CourseApplicationR appId ptn)
-  
+
 pattern CNewsR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> CourseNewsR -> Route UniWorX
 pattern CNewsR tid ssh csh nId ptn
   = CourseR tid ssh csh (CourseNewsR nId ptn)
-  
+
 pattern CEventR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseEvent -> CourseEventR -> Route UniWorX
 pattern CEventR tid ssh csh nId ptn
   = CourseR tid ssh csh (CourseEventR nId ptn)

src/Handler/Admin/StudyFeatures.hs

@@ -47,7 +47,7 @@ embedRenderMessage ''UniWorX ''ButtonAdminStudyTermsParents id
 instance Button UniWorX ButtonAdminStudyTermsParents where
   btnClasses BtnParentCandidatesInfer     = [BCIsButton, BCPrimary]
   btnClasses BtnParentCandidatesDeleteAll = [BCIsButton, BCDanger]
-  
+
 data ButtonAdminStudyTermsStandalone
   = BtnStandaloneCandidatesDeleteRedundant
   | BtnStandaloneCandidatesDeleteAll
@@ -62,7 +62,7 @@ instance Button UniWorX ButtonAdminStudyTermsStandalone where
   btnClasses BtnStandaloneCandidatesDeleteRedundant = [BCIsButton, BCPrimary]
   btnClasses BtnStandaloneCandidatesDeleteAll       = [BCIsButton, BCDanger]
 
-  
+
 {-# ANN postAdminFeaturesR ("HLint: ignore Redundant void" :: String) #-}
 getAdminFeaturesR, postAdminFeaturesR :: Handler Html
 getAdminFeaturesR = postAdminFeaturesR
@@ -147,7 +147,7 @@ postAdminFeaturesR = do
           deleteWhere ([] :: [Filter StudyTermStandaloneCandidate])
           addMessageI Success MsgAllStandaloneIncidencesDeleted
         redirect AdminFeaturesR
-  
+
 
     newStudyTermKeys <- fromMaybe [] <$> lookupSessionJson SessionNewStudyTerms
     badStudyTermKeys <- lookupSessionJson SessionConflictingStudyTerms
@@ -208,7 +208,7 @@ postAdminFeaturesR = do
         infRedundantStandalone <- Candidates.removeRedundantStandalone
         unless (null infRedundantStandalone) . addMessageI Info . MsgRedundantStandaloneCandidatesRemoved $ length infRedundantStandalone
         return updated
-      
+
       let newKeys = catMaybes $ Map.elems updated
       unless (null newKeys) $ do
         setSessionJson SessionNewStudyTerms newKeys
@@ -247,19 +247,19 @@ postAdminFeaturesR = do
                   => Lens' a (Maybe Text)
                   -> Getter (DBRow r) (Maybe Text)
                   -> Getter (DBRow r) i
-                  -> DBRow r 
+                  -> DBRow r
                   -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
     textInputCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
       (\row _mkUnique -> bimap (fmap $ set lensRes . assertM (not . Text.null)) fvWidget
         <$> mopt (textField & cfStrip) "" (Just $ row ^. lensDefault)
       )
-  
+
     checkboxCell :: Ord i
                  => Lens' a Bool
                  -> Getter (DBRow r) Bool
                  -> Getter (DBRow r) i
-                 -> DBRow r 
+                 -> DBRow r
-                 -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) 
+                 -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
     checkboxCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
       ( \row _mkUnique -> bimap (fmap $ set lensRes) fvWidget
         <$> mpopt checkBoxField "" (Just $ row ^. lensDefault)
@@ -306,7 +306,7 @@ postAdminFeaturesR = do
       ( \row _mkUnique -> bimap (fmap $ set lensRes) fvWidget
         <$> mopt degreeField "" (Just $ row ^. lensDefault)
       )
-  
+
     fieldTypeCell :: Ord i
                   => Lens' a (Maybe StudyFieldType)
                   -> Getter (DBRow r) (Maybe StudyFieldType)
@@ -359,7 +359,7 @@ postAdminFeaturesR = do
             fieldSchools <- fmap (setOf $ folded . _Value) . E.select . E.from $ \school -> do
               E.where_ . E.exists . E.from $ \schoolTerms ->
                 E.where_ $ schoolTerms E.^. SchoolTermsSchool E.==. school E.^. SchoolId
-                     E.&&. schoolTerms E.^. SchoolTermsTerms  E.==. E.val fId 
+                     E.&&. schoolTerms E.^. SchoolTermsTerms  E.==. E.val fId
               E.where_ $ school E.^. SchoolShorthand `E.in_` E.valList (toListOf (folded . _entityKey . _SchoolId) schools)
               return $ school E.^. SchoolId
             fieldParents <- fmap (setOf folded) . E.select . E.from $ \terms -> do

src/Handler/Admin/Test/Download.hs

@@ -45,10 +45,10 @@ testDownloadForm = identifyForm FIDTestDownload . renderWForm FormStandard $ do
 
   maxSizeRes <- wreq intField (fslI MsgTestDownloadMaxSize) . Just $ 2 * 2^30
   modeRes <- wpopt (selectField optionsFinite) (fslI MsgTestDownloadMode) $ Just TestDownloadDirect
-  
+
   return $ TestDownloadOptions
-    <$> pure randomSeed
+        randomSeed
-    <*> maxSizeRes
+    <$> maxSizeRes
     <*> pure (2^20)
     <*> modeRes
 
@@ -86,7 +86,7 @@ testDownload = do
           sourceDBFiles = E.selectSource . E.from $ \fileContent -> do
             E.orderBy [E.asc $ E.random_ @Int64]
             return fileContent
-          
+
           takeLimit n | n <= 0 = return ()
           takeLimit n = do
             c <- await

src/Handler/Admin/Tokens.hs

@@ -30,7 +30,7 @@ bearerTokenForm :: WForm Handler (FormResult BearerTokenForm)
 bearerTokenForm = do
   muid <- maybeAuthId
   mr <- getMessageRender
-  
+
   btfAuthorityGroups <- aFormToWForm $ HashSet.fromList . map Left <$> massInputListA pathPieceField (const "") MsgBearerTokenAuthorityGroupMissing (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-groups" :: Text) (fslI MsgBearerTokenAuthorityGroups & setTooltip MsgBearerTokenAuthorityGroupsTip) False Nothing
   btfAuthorityUsers <- fmap (fmap . ofoldMap $ HashSet.singleton . Right) <$> wopt (checkMap (foldMapM $ fmap Set.singleton . left MsgBearerTokenAuthorityUnknownUser) (Set.map Right) $ multiUserField False Nothing) (fslpI MsgBearerTokenAuthorityUsers (mr MsgLdapIdentificationOrEmail) & setTooltip MsgBearerTokenAuthorityUsersTip) (Just $ Set.singleton <$> muid)
   let btfAuthority' :: FormResult (HashSet (Either UserGroupName UserId))
@@ -58,7 +58,7 @@ bearerTokenForm = do
 
               miLayout' :: MassInputLayout ListLength (Route UniWorX, Value) (Route UniWorX, Value)
               miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/token-restrictions/layout")
-                
+
   btfRestrict' <- fmap HashMap.fromList <$> btfRestrictForm
 
   btfAddAuth' <- fmap (assertM $ not . Set.null . dnfTerms) <$> wopt pathPieceField (fslI MsgBearerTokenAdditionalAuth & setTooltip MsgBearerTokenAdditionalAuthTip) Nothing
@@ -87,7 +87,7 @@ postAdminTokensR = do
           & HashSet.map (left toJSON)
 
     fmap Just . encodeBearer . set _bearerRestrictions btfRestrict =<< bearerToken btfAuthority' btfRoutes btfAddAuth btfExpiresAt btfStartsAt
-    
+
   siteLayoutMsg' MsgMenuAdminTokens $ do
     setTitleI MsgMenuAdminTokens
 

src/Handler/Allocation/Accept.hs

@@ -33,7 +33,7 @@ newtype SessionDataAllocationResults = SessionDataAllocationResults
     deriving (Monoid, Semigroup) via Dual (Map (TermId, SchoolId, AllocationShorthand) (UTCTime, AllocationFingerprint, Set (UserId, CourseId), Seq MatchingLogRun))
 
 makeWrapped ''SessionDataAllocationResults
-  
+
 
 data AllocationAcceptButton
   = BtnAllocationAccept
@@ -59,7 +59,7 @@ allocationAcceptForm aId = runMaybeT $ do
     let applications = E.subSelectCount . E.from $ \courseApplication ->
           E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.val (Just aId)
                E.&&. courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
-    return . (allocationUser E.^. AllocationUserUser, ) $ E.case_ 
+    return . (allocationUser E.^. AllocationUserUser, ) $ E.case_
       [ E.when_ (E.castNum (allocationUser E.^. AllocationUserTotalCourses) E.>. applications)
         E.then_ (applications :: E.SqlExpr (E.Value Int))
       ]
@@ -124,7 +124,7 @@ allocationAcceptForm aId = runMaybeT $ do
         = invDualHeat (optimumAllocated capN) capN
       degenerateHeat capN
         = capN <= optimumAllocated capN
-      
+
     return (prevAllocMatches, $(widgetFile "allocation/accept"))
 
 getAAcceptR, postAAcceptR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
@@ -135,7 +135,7 @@ postAAcceptR tid ssh ash = do
 
     acceptForm <- maybe (redirect $ AllocationR tid ssh ash AComputeR) return =<< allocationAcceptForm aId
 
-    formRes@((acceptRes, _), _) <- liftHandler $ runFormPost acceptForm 
+    formRes@((acceptRes, _), _) <- liftHandler $ runFormPost acceptForm
 
     didStore <- formResultMaybe acceptRes $ \(now, allocFp, allocMatchings, allocLog) -> do
       modifySessionJson SessionAllocationResults . fmap (assertM $ not . views _Wrapped onull) . over (mapped . _Wrapped :: Setter' (Maybe SessionDataAllocationResults) _) $

src/Handler/Allocation/Application.hs

@@ -58,24 +58,24 @@ data ApplicationFormMode = ApplicationFormMode
   , afmApplicantEdit :: Bool -- ^ Allow editing text, files, priority (if shown)
   , afmLecturer      :: Bool -- ^ Allow editing rating
   }
- 
+
 
 data ApplicationFormException = ApplicationFormNoApplication -- ^ Could not fill forced fields of application form with data from application
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 instance Exception ApplicationFormException
 
-applicationForm :: (Maybe AllocationId)
+applicationForm :: Maybe AllocationId
                 -> CourseId
                 -> UserId
                 -> ApplicationFormMode -- ^ Which parts of the shared form to display
                 -> Html -> MForm Handler (FormResult ApplicationForm, ApplicationFormView)
 applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf = do
-  
+
   (mApp, coursesNum, Course{..}, maxPrio) <- liftHandler . runDB $ do
     mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. maId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
     coursesNum <- fromIntegral . fromMaybe 1 <$> for maId (\aId -> count [AllocationCourseAllocation ==. aId])
     course <- getJust cid
-    (fromMaybe 0 -> maxPrio) <- fmap ((>>= E.unValue) . listToMaybe) . E.select . E.from $ \courseApplication -> do
+    (fromMaybe 0 -> maxPrio) <- fmap (E.unValue <=< listToMaybe) . E.select . E.from $ \courseApplication -> do
       E.where_ $ courseApplication E.^. CourseApplicationUser       E.==. E.val uid
            E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.val maId
            E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocationPriority)
@@ -91,25 +91,25 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
 
     mkPrioOption :: Natural -> Option Natural
     mkPrioOption i = Option
-      { optionDisplay       = mr . MsgAllocationCoursePriority $ coursesNum' - i 
+      { optionDisplay       = mr . MsgAllocationCoursePriority $ coursesNum' - i
       , optionInternalValue = i
       , optionExternalValue = tshow i
       }
-    
+
     prioOptions :: OptionList Natural
     prioOptions = OptionList
       { olOptions = sortOn (Down . optionInternalValue) . map mkPrioOption $ [0 .. pred coursesNum']
       , olReadExternal = readMay
       }
     prioField = selectField' (Just $ SomeMessage MsgAllocationCourseNoApplication) $ return prioOptions
-      
+
   (prioRes, prioView) <- case (isAlloc, afmApplicant, afmApplicantEdit, mApp) of
     (True , True , True , Nothing)
-      -> over _2 Just <$> mopt prioField (fslI MsgApplicationPriority) (Just $ oldPrio) 
+      -> over _2 Just <$> mopt prioField (fslI MsgApplicationPriority) (Just oldPrio)
     (True , True , True , Just _ )
       -> over (_1 . _FormSuccess) Just . over _2 Just <$> mreq prioField (fslI MsgApplicationPriority) oldPrio
     (True , True , False, _      )
-      -> over _2 Just <$> mforcedOpt prioField (fslI MsgApplicationPriority) oldPrio 
+      -> over _2 Just <$> mforcedOpt prioField (fslI MsgApplicationPriority) oldPrio
     (True , False, _    , Just _ )
       | is _Just oldPrio
         -> pure (FormSuccess oldPrio, Nothing)
@@ -144,7 +144,7 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
   let appFilesInfo = (,) <$> hasFiles <*> appCID
 
   filesLinkView <- if
-    | fromMaybe False hasFiles || (isn't _NoUpload courseApplicationsFiles && not afmApplicantEdit)
+    | Just True == hasFiles || (isn't _NoUpload courseApplicationsFiles && not afmApplicantEdit)
       -> let filesLinkField = Field{..}
                where
                  fieldParse _ _ = return $ Right Nothing
@@ -165,7 +165,7 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
       -> return Nothing
 
   filesWarningView <- if
-    | fromMaybe False hasFiles && isn't _NoUpload courseApplicationsFiles && afmApplicantEdit
+    | Just True == hasFiles && isn't _NoUpload courseApplicationsFiles && afmApplicantEdit
       -> fmap (Just . snd) . formMessage =<< messageIconI Info IconFileUpload MsgCourseApplicationFilesNeedReupload
     | otherwise
       -> return Nothing
@@ -174,16 +174,16 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
     let mkFs = bool MsgCourseApplicationFile MsgCourseApplicationArchive
      in if
       | not afmApplicantEdit || is _NoUpload courseApplicationsFiles
-        -> return $ (FormSuccess Nothing, Nothing)
+        -> return (FormSuccess Nothing, Nothing)
       | otherwise
         -> fmap (over _2 $ Just . ($ [])) . aFormToForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
 
   (vetoRes, vetoView) <- if
     | afmLecturer
-      -> over _2 Just <$> mpopt checkBoxField (fslI MsgApplicationVeto & setTooltip MsgApplicationVetoTip) (Just . fromMaybe False $ courseApplicationRatingVeto . entityVal <$> mApp)
+      -> over _2 Just <$> mpopt checkBoxField (fslI MsgApplicationVeto & setTooltip MsgApplicationVetoTip) (Just $ Just True == fmap (courseApplicationRatingVeto . entityVal) mApp)
     | otherwise
-      -> return (FormSuccess . fromMaybe False $ courseApplicationRatingVeto . entityVal <$> mApp, Nothing)
+      -> return (FormSuccess $ Just True == fmap (courseApplicationRatingVeto . entityVal) mApp, Nothing)
-  
+
   (pointsRes, pointsView) <- if
     | afmLecturer
       -> over _2 Just <$> mopt examGradeField (fslI MsgApplicationRatingPoints & setTooltip MsgApplicationRatingPointsTip) (fmap Just $ mApp >>= courseApplicationRatingPoints . entityVal)
@@ -195,7 +195,7 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
       -> over _2 Just . over (_1 . _FormSuccess) (assertM $ not . Text.null) <$> mopt textField' (fslI MsgApplicationRatingComment & setTooltip (bool MsgApplicationRatingCommentInvisibleTip MsgApplicationRatingCommentVisibleTip courseApplicationsRatingsVisible)) (fmap Just $ mApp >>= courseApplicationRatingComment . entityVal)
     | otherwise
       -> return (FormSuccess $ courseApplicationRatingComment . entityVal =<< mApp, Nothing)
-  
+
   let
     buttons = catMaybes
       [ guardOn (not afmApplicantEdit && is _Just    mApp && afmLecturer) BtnAllocationApplicationRate
@@ -225,7 +225,7 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
            <*> actionRes
          , ApplicationFormView
            { afvPriority = prioView
-           , afvForm = catMaybes $ 
+           , afvForm = catMaybes $
              [ Just fieldView'
              , textView
              , filesLinkView
@@ -240,7 +240,7 @@ applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf
            }
          )
 
- 
+
 
 
 editApplicationR :: Maybe AllocationId
@@ -285,7 +285,7 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
             , courseApplicationRatingTime         = guardOn rated now
             }
 
-          runConduit $ transPipe liftHandler (traverse_ id afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
+          runConduit $ transPipe liftHandler (sequence_ afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
           audit $ TransactionCourseApplicationEdit cid uid appId
           addMessageI Success $ MsgCourseApplicationCreated courseShorthand
       | is _BtnAllocationApplicationEdit afAction || is _BtnAllocationApplicationRate afAction
@@ -354,7 +354,7 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
     redirect postAction
 
   return (appView, appEnc)
-        
+
 
 postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
 postAApplyR tid ssh ash cID = do

src/Handler/Allocation/Compute.hs

@@ -62,7 +62,7 @@ missingPriorities aId = wFormToAForm $ do
           missingPriosFieldView theId name attrs res isReq
             = $(i18nWidgetFile "allocation-confirm-missing-prios")
             where checkBoxFieldView = labeledCheckBoxView (i18n MsgAllocationUsersMissingPrioritiesOk) theId name attrs res isReq
-          
+
   if
     | null usersWithoutPrio
       -> return $ pure Set.empty

src/Handler/Allocation/List.hs

@@ -58,7 +58,7 @@ resultApplied = _dbrOutput . _3
 
 allocationTermLink :: TermId -> SomeRoute UniWorX
 allocationTermLink tid = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "term", toPathPiece tid)])
-  
+
 allocationSchoolLink :: SchoolId -> SomeRoute UniWorX
 allocationSchoolLink ssh = SomeRoute (AllocationListR, [(dbFilterKey allocationListIdent "school", toPathPiece ssh)])
 

src/Handler/Allocation/Prios.hs

@@ -26,7 +26,7 @@ instance Finite AllocationPrioritiesMode
 nullaryPathPiece ''AllocationPrioritiesMode $ camelToPathPiece' 2
 
 embedRenderMessage ''UniWorX ''AllocationPrioritiesMode id
-  
+
 
 getAPriosR, postAPriosR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
 getAPriosR = postAPriosR
@@ -37,7 +37,7 @@ postAPriosR tid ssh ash = do
     numericPrios <- E.selectCountRows . E.from $ \allocationUser -> do
       E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
       E.where_ . E.maybe E.false sqlAllocationPriorityNumeric $ allocationUser E.^. AllocationUserPriority
-  
+
     ordinalPrios <- E.selectCountRows . E.from $ \allocationUser -> do
       E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
       E.where_ . E.maybe E.false (E.not_ . sqlAllocationPriorityNumeric) $ allocationUser E.^. AllocationUserPriority
@@ -59,7 +59,7 @@ postAPriosR tid ssh ash = do
     let sourcePrios = case mode of
           AllocationPrioritiesNumeric -> transPipe liftHandler fInfo .| fileSourceCsvPositional Csv.NoHeader
           AllocationPrioritiesOrdinal -> transPipe liftHandler fInfo .| fileSourceCsvPositional Csv.NoHeader .| C.map Csv.fromOnly .| ordinalPriorities
-    
+
     (matrSunk, matrMissing) <- runDB $ do
       Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
       updateWhere
@@ -77,7 +77,7 @@ postAPriosR tid ssh ash = do
                E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (E.val aId)
       return (matrSunk, matrMissing)
 
-    when (matrSunk > 0) $ 
+    when (matrSunk > 0) $
       addMessageI Success $ MsgAllocationPrioritiesSunk matrSunk
     when (matrMissing > 0) $
       addMessageI Error $ MsgAllocationPrioritiesMissing matrMissing

src/Handler/Allocation/Register.hs

@@ -46,7 +46,7 @@ postARegisterR tid ssh ash = do
   formResult registerRes $ \AllocationRegisterForm{..} -> runDB $ do
     aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
     isRegistered <- existsBy $ UniqueAllocationUser aId uid
-    void $ upsert AllocationUser 
+    void $ upsert AllocationUser
       { allocationUserAllocation = aId
       , allocationUserUser = uid
       , allocationUserTotalCourses = arfTotalCourses
@@ -57,5 +57,5 @@ postARegisterR tid ssh ash = do
     if
       | isRegistered -> addMessageI Success MsgAllocationRegistrationEdited
       | otherwise -> addMessageI Success MsgAllocationRegistered
-  
+
   redirect $ AllocationR tid ssh ash AShowR :#: ("allocation-participation" :: Text)

src/Handler/Allocation/Show.hs

@@ -7,7 +7,7 @@ import Import
 import Utils.Course
 
 import Handler.Utils
-  
+
 import Handler.Allocation.Register
 import Handler.Allocation.Application
 

src/Handler/Allocation/Users.hs

@@ -63,11 +63,11 @@ type UserTableData = DBRow ( Entity User
                            , Int -- ^ Applied
                            , Int -- ^ Assigned
                            , Int -- ^ Vetoed
-                           )                          
+                           )
 
 resultUser :: Lens' UserTableData (Entity User)
 resultUser = _dbrOutput . _1
-  
+
 resultAllocationUser :: Lens' UserTableData (Entity AllocationUser)
 resultAllocationUser = _dbrOutput . _2
 
@@ -83,7 +83,7 @@ data AllocationUserTableCsv = AllocationUserTableCsv
   , csvAUserName          :: Text
   , csvAUserMatriculation :: Maybe Text
   , csvAUserRequested
-  , csvAUserApplied   
+  , csvAUserApplied
   , csvAUserVetos
   , csvAUserAssigned      :: Natural
   , csvAUserPriority      :: Maybe AllocationPriority
@@ -94,10 +94,10 @@ allocationUserTableCsvOptions :: Csv.Options
 allocationUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3}
 
 instance Csv.ToNamedRecord AllocationUserTableCsv where
-  toNamedRecord = Csv.genericToNamedRecord allocationUserTableCsvOptions 
+  toNamedRecord = Csv.genericToNamedRecord allocationUserTableCsvOptions
 
 instance Csv.DefaultOrdered AllocationUserTableCsv where
-  headerOrder = Csv.genericHeaderOrder allocationUserTableCsvOptions 
+  headerOrder = Csv.genericHeaderOrder allocationUserTableCsvOptions
 
 instance CsvColumnsExplained AllocationUserTableCsv where
   csvColumnsExplanations = genericCsvColumnsExplanations allocationUserTableCsvOptions $ mconcat

src/Handler/Course/Application/Files.hs

@@ -42,7 +42,7 @@ getCAppsFilesR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
 getCAppsFilesR tid ssh csh = do
   runDB . existsBy404 $ TermSchoolCourseShort tid ssh csh
   MsgRenderer mr <- getMsgRenderer
-  
+
   archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseAllApplicationsArchiveName tid ssh csh
 
   let
@@ -61,12 +61,12 @@ getCAppsFilesR tid ssh csh = do
         hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR
       let
         applicationAllocs = setOf (folded . _1) apps'
-        
+
         allocations = applicationAllocs ^.. folded . _Just . _entityVal . $(multifocusG 3) _allocationTerm _allocationSchool _allocationShorthand
 
         allEqualOn :: Eq x => Getter _ x -> Bool
         allEqualOn l = maybe True (\x -> allOf (folded . l) (== x) allocations) (allocations ^? _head . l)
-        
+
         mkAllocationDir mbAlloc
           | not $ allEqualOn _1
           , Just Allocation{..} <- mbAlloc
@@ -92,7 +92,7 @@ getCAppsFilesR tid ssh csh = do
             fileEntitySource = E.selectSource . E.from $ \courseApplicationFile -> do
               E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
               return courseApplicationFile
-        
+
         yield $ _FileReference # ( FileReference
                                    { fileReferenceModified = courseApplicationTime
                                    , fileReferenceTitle = mkAppDir ""

src/Handler/Course/Application/List.hs

@@ -47,7 +47,7 @@ type CourseApplicationsTableData = DBRow ( Entity CourseApplication
                                          , Maybe (Entity StudyDegree)
                                          , Bool -- isParticipant
                                          )
-  
+
 courseApplicationsIdent :: Text
 courseApplicationsIdent = "applications"
 
@@ -120,7 +120,7 @@ instance Csv.FromField CourseApplicationsTableVeto where
     (CI.map Text.strip -> t :: CI Text) <- Csv.parseField f
     return . CourseApplicationsTableVeto $ elem t
       [ "veto", "v", "yes", "y", "ja", "j", "wahr", "w", "true", "t", "1" ]
-  
+
 data CourseApplicationsTableCsv = CourseApplicationsTableCsv
   { csvCAAllocation :: Maybe AllocationShorthand
   , csvCAApplication :: Maybe CryptoFileNameCourseApplication
@@ -223,7 +223,7 @@ instance Exception CourseApplicationsTableCsvException
 
 embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvException id
 
-  
+
 data ButtonAcceptApplications = BtnAcceptApplications
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonAcceptApplications
@@ -277,7 +277,7 @@ postCApplicationsR tid ssh csh = do
       applicationLink appId = liftHandler $ do
         cID <- encrypt appId
         return . SomeRoute $ CApplicationR tid ssh csh cID CAEditR
-      
+
       dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _
       dbtSQLQuery = runReaderT $ do
         courseApplication <- view queryCourseApplication
@@ -415,13 +415,13 @@ postCApplicationsR tid ssh csh = do
               -> return () -- no addition
             DBCsvDiffExisting{..} -> do
               let appId = dbCsvOld ^. resultCourseApplication . _entityKey
-              
+
               newFeatures <- lift $ lookupStudyFeatures dbCsvNew
               when (newFeatures /= dbCsvOld ^? resultStudyFeatures . _entityKey) $
                 yield $ CourseApplicationsTableCsvSetFieldData appId newFeatures
 
               let mVeto = dbCsvNew ^? _csvCAVeto . _Just . _CourseApplicationsTableVeto
-              whenIsJust mVeto $ \veto -> 
+              whenIsJust mVeto $ \veto ->
                 when (veto /= dbCsvOld ^. resultCourseApplication . _entityVal . _courseApplicationRatingVeto) $
                   yield $ CourseApplicationsTableCsvSetVetoData appId veto
 
@@ -638,7 +638,7 @@ postCApplicationsR tid ssh csh = do
   let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle
       registrationOpen = maybe True (now <)
 
-  
+
   ((acceptRes, acceptWgt'), acceptEnc) <- runFormPost . identifyForm BtnAcceptApplications . renderAForm FormStandard $
     (,) <$> apopt (selectField optionsFinite) (fslI MsgAcceptApplicationsMode & setTooltip MsgAcceptApplicationsModeTip) (Just AcceptApplicationsInvite)
         <*> apopt (selectField optionsFinite) (fslI MsgAcceptApplicationsSecondary & setTooltip MsgAcceptApplicationsSecondaryTip) (Just AcceptApplicationsSecondaryTime)
@@ -679,7 +679,7 @@ postCApplicationsR tid ssh csh = do
             AcceptApplicationsSecondaryRandom
               -> comparing $ view   ratingL
         sortedApplications <- unstableSortBy cmp applications
-  
+
         let applicants = sortedApplications
                        & nubOn (view $ _1 . _entityKey)
                        & maybe id take openCapacity
@@ -687,7 +687,7 @@ postCApplicationsR tid ssh csh = do
                                   AcceptApplicationsDirect -> folded . _1 . _entityKey . to Right
                                   AcceptApplicationsInvite -> folded . _1 . _entityVal . _userEmail . to Left
                                )
-  
+
         mapM_ addMessage' <=< execWriterT $ registerUsers cid applicants
       redirect $ CourseR tid ssh csh CUsersR
 

src/Handler/Course/Communication.hs

@@ -94,7 +94,7 @@ postCCommR tid ssh csh = do
               E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val cid
                    E.&&. courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
                    E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
-            return user  
+            return user
         )
       ] ++ tuts ++ exams ++ sheets
     , crRecipientAuth = Just $ \uid -> do

src/Handler/Course/Edit.hs

@@ -92,7 +92,7 @@ courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
       where selectAppFiles = E.selectSource . E.from $ \courseAppInstructionFile -> do
               E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. E.val cid
               return courseAppInstructionFile
-      
+
 
 allocationCourseToForm :: Entity Course -> Entity AllocationCourse -> AllocationCourseForm
 allocationCourseToForm (Entity _ Course{..}) (Entity _ AllocationCourse{..}) = AllocationCourseForm
@@ -139,7 +139,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
                 , not $ Set.null existing
                   -> FormFailure [mr MsgCourseLecturerAlreadyAdded]
                 | otherwise
-                  -> FormSuccess . Map.fromList . zip [maybe 0 succ . fmap fst $ Map.lookupMax oldDat ..] $ Set.toList newDat
+                  -> FormSuccess . Map.fromList . zip [maybe 0 (succ . fst) $ Map.lookupMax oldDat ..] $ Set.toList newDat
               addView' = $(widgetFile "course/lecturerMassInput/add")
           return (addRes'', addView')
 
@@ -199,10 +199,11 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
         (Just cform) | (Just _cid) <- cfCourseId cform -> return (Nothing,Nothing,Nothing,Nothing)
         _allIOtherCases -> do
             mbLastTerm <- liftHandler $ runDB $ selectFirst [TermActive ==. True] [Desc TermName]
-            return (  Just (Just now)
+            return ( Just $ Just now
-                   , (Just . toMidnight     . termStart . entityVal) <$> mbLastTerm
+                   , Just . toMidnight     . termStart . entityVal <$> mbLastTerm
-                   , (Just . beforeMidnight . termEnd   . entityVal) <$> mbLastTerm
+                   , Just . beforeMidnight . termEnd   . entityVal <$> mbLastTerm
-                   , (Just . beforeMidnight . termEnd   . entityVal) <$> mbLastTerm )
+                   , Just . beforeMidnight . termEnd   . entityVal <$> mbLastTerm
+                   )
 
     let
       allocationForm :: AForm Handler (Maybe AllocationCourseForm)
@@ -214,7 +215,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
                 E.exists . E.from $ \allocationCourse ->
                   E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
                        E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. allocation E.^. AllocationId
-    
+
           E.where_ $ term E.^. TermActive
                E.||. alreadyParticipates
                E.||. allocation E.^. AllocationSchool `E.in_` E.valList adminSchools
@@ -243,8 +244,8 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
 
             let
               userAdmin = not $ null adminSchools
-              mayChange = fromMaybe True $ (|| userAdmin) <$> currentAllocationAvailable
+              mayChange = Just False /= fmap (|| userAdmin) currentAllocationAvailable
-              
+
               allocationForm' =
                 let ainp :: Field Handler a -> FieldSettings UniWorX -> Maybe a -> AForm Handler a
                     ainp
@@ -265,8 +266,8 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
     multipleTermsMsg <- messageI Warning MsgCourseSemesterMultipleTip
 
     (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
-      <$> pure (cfCourseId =<< template)
+          (cfCourseId =<< template)
-      <*> areq (textField & cfStrip & cfCI) (fslI MsgCourseName)                             (cfName       <$> template)
+      <$> areq (textField & cfStrip & cfCI) (fslI MsgCourseName)                             (cfName       <$> template)
       <*> areq (textField & cfStrip & cfCI) (fslpI MsgCourseShorthand "ProMo, LinAlg1, AlgoDat, Ana2, EiP, …"
             -- & addAttr "disabled" "disabled"
             & setTooltip MsgCourseShorthandUnique)                      (cfShort      <$> template)
@@ -333,7 +334,7 @@ validateCourse = do
   guardValidation MsgCourseRegistrationEndMustBeAfterStart
     $ NTop cfRegFrom <= NTop cfRegTo
   guardValidation MsgCourseDeregistrationEndMustBeAfterStart
-    $ fromMaybe True $ (<=) <$> cfRegFrom <*> cfDeRegUntil
+    $ Just False /= ((<=) <$> cfRegFrom <*> cfDeRegUntil)
   unless userAdmin $
     guardValidation MsgCourseUserMustBeLecturer
       $ anyOf (traverse . _Right . _1) (== uid) cfLecturers
@@ -538,7 +539,7 @@ courseEditHandler miButtonAction mbCourseForm = do
                     insert_ $ CourseEdit aid now cid
 
                     let mkFilter CourseAppInstructionFileResidual{..} = [ CourseAppInstructionFileCourse ==. courseAppInstructionFileResidualCourse ]
-                     in void . replaceFileReferences mkFilter (CourseAppInstructionFileResidual cid) . traverse_ id $ cfAppInstructionFiles res
+                     in void . replaceFileReferences mkFilter (CourseAppInstructionFileResidual cid) . sequence_ $ cfAppInstructionFiles res
 
                     upsertAllocationCourse cid $ cfAllocation res
 
@@ -556,7 +557,7 @@ courseEditHandler miButtonAction mbCourseForm = do
 upsertAllocationCourse :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe AllocationCourseForm -> ReaderT SqlBackend m ()
 upsertAllocationCourse cid cfAllocation = do
   now <- liftIO getCurrentTime
-  Course{..} <- getJust cid
+  Course{} <- getJust cid
   prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
   prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
   userAdmin <- fromMaybe False <$> for prevAllocation (\Allocation{..} -> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR)

src/Handler/Course/Events/Delete.hs

@@ -8,13 +8,13 @@ import Handler.Utils.Occurrences
 import Handler.Utils.Delete
 
 import qualified Data.Set as Set
-  
+
 
 getCEvDeleteR, postCEvDeleteR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseEvent -> Handler Html
 getCEvDeleteR = postCEvDeleteR
 postCEvDeleteR tid ssh csh cID = do
   nId <- decrypt cID
-  
+
   let
     drRecords :: Set (Key CourseEvent)
     drRecords = Set.singleton nId
@@ -31,23 +31,23 @@ postCEvDeleteR tid ssh csh cID = do
         :
         ^{occurrencesWidget courseEventTime}
       |]
-  
+
     drRecordConfirmString :: Entity CourseEvent -> DB Text
     drRecordConfirmString _ = return ""
-  
+
     drCaption, drSuccessMessage :: SomeMessage UniWorX
     drCaption = SomeMessage MsgCourseEventDeleteQuestion
     drSuccessMessage = SomeMessage MsgCourseEventDeleted
-  
+
     drAbort, drSuccess :: SomeRoute UniWorX
     drAbort = SomeRoute $ CourseR tid ssh csh CShowR :#: [st|event-#{toPathPiece cID}|]
     drSuccess = SomeRoute $ CourseR tid ssh csh CShowR
-  
+
     drFormMessage :: [Entity CourseEvent] -> DB (Maybe Message)
     drFormMessage _ = return Nothing
-  
+
     drDelete :: forall a. CourseEventId -> JobDB a -> JobDB a
     drDelete _ = id
-  
+
   deleteR DeleteRoute{..}
 

src/Handler/Course/Events/Edit.hs

@@ -4,7 +4,7 @@ module Handler.Course.Events.Edit
 
 import Import
 import Handler.Utils
-  
+
 import Handler.Course.Events.Form
 
 

src/Handler/Course/Events/Form.hs

@@ -31,7 +31,7 @@ courseEventForm template = identifyForm FIDCourseEvent . renderWForm FormStandar
     )
   let courseEventTypes = optionsPairs [ (courseEventType, courseEventType) | Entity _ CourseEvent{..} <- existingEvents ]
       courseEventRooms = optionsPairs [ (courseEventRoom, courseEventRoom) | Entity _ CourseEvent{..} <- existingEvents ]
-  
+
   cefType' <- wreq (textField & cfStrip & cfCI & addDatalist courseEventTypes) (fslI MsgCourseEventType & addPlaceholder (mr MsgCourseEventTypePlaceholder)) (cefType <$> template)
   cefRoom' <- wreq (textField & cfStrip & addDatalist courseEventRooms) (fslI MsgCourseEventRoom) (cefRoom <$> template)
   cefTime' <- aFormToWForm $ occurrencesAForm ("time" :: Text) (cefTime <$> template)

src/Handler/Course/Events/New.hs

@@ -4,7 +4,7 @@ module Handler.Course.Events.New
 
 import Import
 import Handler.Utils
-  
+
 import Handler.Course.Events.Form
 
 getCEventsNewR, postCEventsNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html

src/Handler/Course/News/Delete.hs

@@ -12,7 +12,7 @@ getCNDeleteR, postCNDeleteR :: TermId -> SchoolId -> CourseShorthand -> CryptoUU
 getCNDeleteR = postCNDeleteR
 postCNDeleteR tid ssh csh cID = do
   nId <- decrypt cID
-  
+
   let
     drRecords :: Set (Key CourseNews)
     drRecords = Set.singleton nId
@@ -26,22 +26,22 @@ postCNDeleteR tid ssh csh cID = do
         [ toWidget <$> courseNewsTitle
         , toWidget <$> courseNewsSummary
         ]
-  
+
     drRecordConfirmString :: Entity CourseNews -> DB Text
     drRecordConfirmString _ = return ""
-  
+
     drCaption, drSuccessMessage :: SomeMessage UniWorX
     drCaption = SomeMessage MsgCourseNewsDeleteQuestion
     drSuccessMessage = SomeMessage MsgCourseNewsDeleted
-  
+
     drAbort, drSuccess :: SomeRoute UniWorX
     drAbort = SomeRoute $ CourseR tid ssh csh CShowR :#: [st|news-#{toPathPiece cID}|]
     drSuccess = SomeRoute $ CourseR tid ssh csh CShowR
 
     drFormMessage :: [Entity CourseNews] -> DB (Maybe Message)
     drFormMessage _ = return Nothing
-  
+
     drDelete :: forall a. CourseNewsId -> JobDB a -> JobDB a
     drDelete _ = id
-  
+
   deleteR DeleteRoute{..}

src/Handler/Course/News/Download.hs

@@ -25,7 +25,7 @@ getCNArchiveR tid ssh csh cID = do
 
   serveSomeFiles archiveName getFilesQuery
 
-  
+
 getCNFileR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> FilePath -> Handler TypedContent
 getCNFileR _ _ _ cID title = do
   nId <- decrypt cID

src/Handler/Course/News/Edit.hs

@@ -33,8 +33,8 @@ postCNEditR tid ssh csh cID = do
         , courseNewsSummary          = cnfSummary
         , courseNewsLastEdit         = now
         }
-      let mkFilter CourseNewsFileResidual{..} = [ CourseNewsFileNews ==. nId ]
+      let mkFilter CourseNewsFileResidual{} = [ CourseNewsFileNews ==. nId ]
-       in void . replaceFileReferences mkFilter (CourseNewsFileResidual nId) $ traverse_ id cnfFiles
+       in void . replaceFileReferences mkFilter (CourseNewsFileResidual nId) $ sequence_ cnfFiles
     addMessageI Success MsgCourseNewsEdited
     redirect $ CourseR tid ssh csh CShowR :#: [st|news-#{toPathPiece cID}|]
 

src/Handler/Course/News/Form.hs

@@ -16,7 +16,7 @@ data CourseNewsForm = CourseNewsForm
   , cnfContent          :: Html
   , cnfParticipantsOnly :: Bool
   , cnfVisibleFrom      :: Maybe UTCTime
-  , cnfFiles            :: Maybe FileUploads 
+  , cnfFiles            :: Maybe FileUploads
   }
 
 courseNewsForm :: Maybe CourseNewsForm -> Form CourseNewsForm

src/Handler/Course/ParticipantInvite.hs

@@ -92,11 +92,11 @@ participantInvitationConfig = InvitationConfig{..}
       itAuthority <- HashSet.singleton . Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
-    invitationForm (Entity _ Course{..}) _ uid = hoistAForm lift . wFormToAForm $ do
+    invitationForm _ _ uid = hoistAForm lift . wFormToAForm $ do
       now <- liftIO getCurrentTime
       studyFeatures <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid)
           (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
-      return . fmap (, ()) $ JunctionParticipant <$> pure now <*> studyFeatures <*> pure Nothing <*> pure CourseParticipantActive
+      return . fmap (, ()) $ JunctionParticipant now <$> studyFeatures <*> pure Nothing <*> pure CourseParticipantActive
     invitationInsertHook _ _ (_, InvTokenDataParticipant{..}) CourseParticipant{..} _ act = do
       deleteBy $ UniqueParticipant courseParticipantUser courseParticipantCourse -- there are no foreign key references to @{CourseParticipant}; therefor we can delete and recreate to simulate upsert
       res <- act -- insertUnique
@@ -138,7 +138,7 @@ postCAddUserR tid ssh csh = do
 
     formResultModal usersToEnlist (CourseR tid ssh csh CUsersR) $
       hoist runDBJobs . registerUsers' cid
-      
+
 
     let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading
 
@@ -169,7 +169,7 @@ addParticipantsResultMessages :: (MonadHandler m, HandlerSite m ~ UniWorX)
                               => AddParticipantsResult
                               -> ReaderT (YesodPersistBackend UniWorX) m [Message]
 addParticipantsResultMessages AddParticipantsResult{..} = execWriterT $ do
-  (aurAlreadyRegistered', aurNoUniquePrimaryField') <- 
+  (aurAlreadyRegistered', aurNoUniquePrimaryField') <-
     (,) <$> fmap sort (lift . mapM (fmap userEmail . getJust) $ Set.toList aurAlreadyRegistered)
         <*> fmap sort (lift . mapM (fmap userEmail . getJust) $ Set.toList aurNoUniquePrimaryField)
 

src/Handler/Course/Register.hs

@@ -69,7 +69,7 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
       isRegistered = btn `elem` [BtnCourseRetractApplication, BtnCourseDeregister]
   return . (, btn) . wFormToAForm $ do
     MsgRenderer mr <- getMsgRenderer
-    
+
     secretRes <- if
       | Just secret <- courseRegisterSecret
       , not isRegistered
@@ -118,7 +118,7 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
     let appFilesInfo = (,) <$> hasFiles <*> appCID
         filesMsg = bool MsgCourseRegistrationFiles MsgCourseApplicationFiles courseApplicationsRequired
 
-    when (isn't _NoUpload courseApplicationsFiles || fromMaybe False hasFiles) $
+    when (isn't _NoUpload courseApplicationsFiles || Just True == hasFiles) $
       let filesLinkField = Field{..}
             where
               fieldParse _ _ = return $ Right Nothing
@@ -136,7 +136,7 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
                   |]
        in void $ wforced filesLinkField (fslI filesMsg) Nothing
 
-    when (fromMaybe False hasFiles && isn't _NoUpload courseApplicationsFiles) $
+    when (Just True == hasFiles && isn't _NoUpload courseApplicationsFiles) $
       wformMessage <=< messageIconI Info IconFileUpload $ bool MsgCourseRegistrationFilesNeedReupload MsgCourseApplicationFilesNeedReupload courseApplicationsRequired
 
     appFilesRes <- let mkFs | courseApplicationsRequired = bool MsgCourseApplicationFile MsgCourseApplicationArchive
@@ -171,7 +171,7 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
       <*> appTextRes
       <*> appFilesRes
 
- 
+
 -- | Workaround for klicking register button without being logged in.
 -- After log in, the user sees a "get request not supported" error.
 getCRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
@@ -212,8 +212,8 @@ postCRegisterR tid ssh csh = do
 
                 return $ Just prevId
 
-            whenIsJust appRes $ 
+            whenIsJust appRes $
-              audit . TransactionCourseApplicationEdit cid uid 
+              audit . TransactionCourseApplicationEdit cid uid
             whenIsJust ((,) <$> appRes <*> crfApplicationFiles) $ \(appId, fSource) -> do
               runConduit $ transPipe liftHandler fSource .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
             return appRes
@@ -288,7 +288,7 @@ deregisterParticipant :: UserId -> CourseId -> DB ()
 deregisterParticipant uid cid = do
   deleteApplications uid cid
   part <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
-  forM_ part $ \(Entity partId CourseParticipant{..}) -> do
+  forM_ part $ \(Entity partId CourseParticipant{}) -> do
     update partId [CourseParticipantState =. CourseParticipantInactive False]
     audit $ TransactionCourseParticipantDeleted cid uid
 
@@ -300,7 +300,7 @@ deregisterParticipant uid cid = do
   forM_ examRegistrations $ \(Entity erId ExamRegistration{..}) -> do
     delete erId
     audit $ TransactionExamDeregister examRegistrationExam uid
-  
+
   E.delete . E.from $ \tutorialParticipant -> do
     let tutorialCourse = E.subSelectForeign tutorialParticipant TutorialParticipantTutorial (E.^. TutorialCourse)
 

src/Handler/Course/Show.hs

@@ -109,12 +109,11 @@ getCShowR tid ssh csh = do
     return (cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup,hasAllocationRegistrationOpen)
 
   let mDereg' = maybe id min (allocationOverrideDeregister =<< mAllocation) <$> courseDeregisterUntil course
-  mDereg <- traverse (formatTime SelFormatDateTime) mDereg' 
+  mDereg <- traverse (formatTime SelFormatDateTime) mDereg'
 
   cID <- encrypt cid :: Handler CryptoUUIDCourse
-  mAllocation' <- for mAllocation $ \alloc@Allocation{..} -> (,)
+  mAllocation' <- for mAllocation $ \alloc@Allocation{..} -> (alloc, )
-    <$> pure alloc
+    <$> toTextUrl (AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID)
-    <*> toTextUrl (AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID)
   regForm <- if
     | is _Just mbAid -> do
         (courseRegisterForm', regButton) <- courseRegisterForm (Entity cid course)
@@ -127,9 +126,9 @@ getCShowR tid ssh csh = do
     | otherwise
       -> return . modal $(widgetFile "course/login-to-register") . Left . SomeRoute $ AuthR LoginR
   registrationOpen <- hasWriteAccessTo $ CourseR tid ssh csh CRegisterR
-  
+
   MsgRenderer mr <- getMsgRenderer
-  
+
   let
     tutorialDBTable = DBTable{..}
       where

src/Handler/Course/User.hs

@@ -60,7 +60,7 @@ postCUserR tid ssh csh uCId = do
     registered <- exists [ CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive ]
 
     return (course, Entity uid user, registered)
-  
+
   sections <- mapM (runMaybeT . ($ user) . ($ course))
     [ courseUserProfileSection
     , courseUserNoteSection
@@ -115,7 +115,7 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
         , formSubmit = FormAutoSubmit
         , formAnchor = Just registrationFieldFrag
         }
-  for_ mRegistration $ \(Entity pId CourseParticipant{..}) ->
+  for_ mRegistration $ \(Entity pId CourseParticipant{}) ->
     formResult regFieldRes $ \courseParticipantField' -> do
       lift . runDB $ do
         update pId [ CourseParticipantField =. courseParticipantField' ]
@@ -202,11 +202,11 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
 
   return $(widgetFile "course/user/profile")
 
-      
+
 courseUserNoteSection :: Entity Course -> Entity User -> MaybeT Handler Widget
 courseUserNoteSection (Entity cid Course{..}) (Entity uid _) = do
   guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CUsersR
-  
+
   currentRoute <- MaybeT getCurrentRoute
 
   (thisUniqueNote, noteText, noteEdits) <- lift . runDB $ do
@@ -306,7 +306,7 @@ courseUserExamsSection (Entity cid Course{..}) (Entity uid _) = do
   guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CExamNewR
 
   uCID <- encrypt uid
-  
+
   let
     examDBTable = DBTable{..}
       where

src/Handler/Course/Users.hs

@@ -139,7 +139,7 @@ _userSheets = _dbrOutput . _8
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
-    sortable (Just "note") (i18nCell MsgCourseUserNote) $ views (_dbrOutput . $(multifocusG 2) (_1 . _entityKey) _3) $ \(uid, mbNoteKey) -> 
+    sortable (Just "note") (i18nCell MsgCourseUserNote) $ views (_dbrOutput . $(multifocusG 2) (_1 . _entityKey) _3) $ \(uid, mbNoteKey) ->
                                                                                                                            maybeEmpty mbNoteKey $ const $
          anchorCellM (courseLink <$> encrypt uid) (hasComment True)
   where
@@ -191,15 +191,15 @@ colUserSubmissionGroup = sortable (Just "submission-group") (i18nCell MsgSubmiss
 colUserSheets :: forall m c. IsDBTable m c => [SheetName] -> Cornice Sortable ('Cap 'Base) UserTableData (DBCell m c)
 colUserSheets shns = cap (Sortable Nothing caption) $ foldMap userSheetCol shns
   where
-    caption = i18nCell MsgCourseUserSheets 
+    caption = i18nCell MsgCourseUserSheets
       & cellAttrs <>~ [ ("uw-hide-column-header", "sheets")
                       , ("uw-hide-column-default-hidden", "")
                       ]
-    
+
     userSheetCol :: SheetName -> Colonnade Sortable UserTableData (DBCell m c)
     userSheetCol shn = sortable (Just . SortingKey $ "sheet-" <> shn) (i18nCell shn) . views (_userSheets . at shn) $ \case
       Just (preview _grading -> Just Points{..}, Just points) -> i18nCell $ MsgAchievedOf points maxPoints
-      Just (preview _grading -> Just grading', Just points) -> i18nCell . bool MsgNotPassed MsgPassed . fromMaybe False $ gradingPassed grading' points
+      Just (preview _grading -> Just grading', Just points) -> i18nCell . bool MsgNotPassed MsgPassed $ Just True == gradingPassed grading' points
       _other -> mempty
 
 
@@ -210,7 +210,7 @@ data UserTableCsvStudyFeature = UserTableCsvStudyFeature
   , csvUserType :: StudyFieldType
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 makeLenses_ ''UserTableCsvStudyFeature
-  
+
 data UserTableCsv = UserTableCsv
   { csvUserName :: Text
   , csvUserSex :: Maybe Sex
@@ -404,33 +404,33 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
           , single $ sortUserEmail       queryUser
           , single $ sortUserMatriclenr  queryUser
           , sortUserSex (to queryUser . to (E.^. UserSex))
-          , single $ ("degree"      , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
+          , single ("degree"      , SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeName))
-          , single $ ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
+          , single ("degree-short", SortColumn $ queryFeaturesDegree >>> (E.?. StudyDegreeShorthand))
-          , single $ ("field"       , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsName))
+          , single ("field"       , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsName))
-          , single $ ("field-short" , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsShorthand))
+          , single ("field-short" , SortColumn $ queryFeaturesField  >>> (E.?. StudyTermsShorthand))
-          , single $ ("semesternr"  , SortColumn $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
+          , single ("semesternr"  , SortColumn $ queryFeaturesStudy  >>> (E.?. StudyFeaturesSemester))
-          , single $ ("registration", SortColumn $ queryParticipant    >>> (E.^. CourseParticipantRegistration))
+          , single ("registration", SortColumn $ queryParticipant    >>> (E.^. CourseParticipantRegistration))
-          , single $ ("note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
+          , single ("note"        , SortColumn $ queryUserNote >>> \note -> -- sort by last edit date
                 E.subSelectMaybe . E.from $ \edit -> do
                   E.where_ $ note E.?. CourseUserNoteId E.==. E.just (edit E.^. CourseUserNoteEditNote)
                   return . E.max_ $ edit E.^. CourseUserNoteEditTime
             )
-          , single $ ("tutorials"   , SortColumn $ queryUser >>> \user ->
+          , single ("tutorials"   , SortColumn $ queryUser >>> \user ->
                 E.subSelectMaybe . E.from $ \(tutorial `E.InnerJoin` participant) -> do
                   E.on $ tutorial E.^. TutorialId E.==. participant E.^. TutorialParticipantTutorial
                    E.&&. tutorial E.^. TutorialCourse E.==. E.val cid
                   E.where_ $ participant E.^. TutorialParticipantUser E.==. user E.^. UserId
                   return . E.min_ $ tutorial E.^. TutorialName
             )
-          , single $ ("exams"       , SortColumn $ queryUser >>> \user ->
+          , single ("exams"       , SortColumn $ queryUser >>> \user ->
                 E.subSelectMaybe . E.from $ \(exam `E.InnerJoin` examRegistration) -> do
                   E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
                    E.&&. exam E.^. ExamCourse E.==. E.val cid
                   E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
                   return . E.min_ $ exam E.^. ExamName
             )
-          , single $ ("submission-group", SortColumn $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
+          , single ("submission-group", SortColumn $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
-          , single $ ("state", SortColumn $ queryParticipant >>> (E.^. CourseParticipantState))
+          , single ("state", SortColumn $ queryParticipant >>> (E.^. CourseParticipantState))
           , mconcat
             [ single ( SortingKey $ "sheet-" <> sheetName
                      , SortColumn $ \(queryUser -> user) -> E.subSelectMaybe . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
@@ -438,8 +438,8 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                          E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
                          E.where_ $ submission E.^. SubmissionSheet E.==. E.val shId
                          return $ submission E.^. SubmissionRatingPoints
-                         
+
-                     ) 
+                     )
             | Entity shId Sheet{..} <- sheets
             ]
           ]
@@ -450,28 +450,28 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
           , single $ fltrUserMatriclenr  queryUser
           , single $ fltrUserNameEmail   queryUser
           , fltrUserSex (to queryUser . to (E.^. UserSex))
-          , single $ ("field-name"  , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsName))
+          , single ("field-name"  , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsName))
-          , single $ ("field-short" , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
+          , single ("field-short" , FilterColumn $ E.mkContainsFilter $ queryFeaturesField >>> (E.?. StudyTermsShorthand))
-          , single $ ("field-key"   , FilterColumn $ E.mkExactFilter    $ queryFeaturesField >>> (E.?. StudyTermsKey))
+          , single ("field-key"   , FilterColumn $ E.mkExactFilter    $ queryFeaturesField >>> (E.?. StudyTermsKey))
-          , single $ ("field"       , FilterColumn $ E.anyFilter
+          , single ("field"       , FilterColumn $ E.anyFilter
                                         [ E.mkContainsFilterWith Just $ queryFeaturesField >>> E.joinV . (E.?. StudyTermsName)
                                         , E.mkContainsFilterWith Just $ queryFeaturesField >>> E.joinV . (E.?. StudyTermsShorthand)
                                         , E.mkExactFilterWith readMay $ queryFeaturesField >>> (E.?. StudyTermsKey)
                                         ] )
-          , single $ ("degree"      , FilterColumn $ E.anyFilter
+          , single ("degree"      , FilterColumn $ E.anyFilter
                                         [ E.mkContainsFilterWith Just $ queryFeaturesDegree >>> E.joinV . (E.?. StudyDegreeName)
                                         , E.mkContainsFilterWith Just $ queryFeaturesDegree >>> E.joinV . (E.?. StudyDegreeShorthand)
                                         , E.mkExactFilterWith readMay $ queryFeaturesDegree >>> (E.?. StudyDegreeKey)
                                         ] )
-          , single $ ("semesternr"  , FilterColumn $ E.mkExactFilter    $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
+          , single ("semesternr"  , FilterColumn $ E.mkExactFilter    $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester))
-          , single $ ("tutorial"    , FilterColumn $ E.mkExistsFilter   $ \row criterion ->
+          , single ("tutorial"    , FilterColumn $ E.mkExistsFilter   $ \row criterion ->
                          E.from $ \(tutorial `E.InnerJoin` tutorialParticipant) -> do
                            E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
                            E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
                                 E.&&. E.hasInfix (tutorial E.^. TutorialName) (E.val criterion :: E.SqlExpr (E.Value (CI Text)))
                                 E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser row E.^. UserId
                      )
-          , single $ ("exam"        , FilterColumn $ E.mkExistsFilter $ \row criterion -> 
+          , single ("exam"        , FilterColumn $ E.mkExistsFilter $ \row criterion ->
                          E.from $ \(exam `E.InnerJoin` examRegistration) -> do
                            E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
                            E.where_ $ exam E.^. ExamCourse E.==. E.val cid
@@ -480,15 +480,15 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                      )
           -- , ("course-registration", error "TODO") -- TODO
           -- , ("course-user-note", error "TODO") -- TODO
-          , single $ ("submission-group", FilterColumn $ E.mkContainsFilter $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
+          , single ("submission-group", FilterColumn $ E.mkContainsFilter $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
-          , single $ ("active", FilterColumn $ E.mkExactFilter $ queryParticipant >>> (E.==. E.val CourseParticipantActive) . (E.^. CourseParticipantState))
+          , single ("active", FilterColumn $ E.mkExactFilter $ queryParticipant >>> (E.==. E.val CourseParticipantActive) . (E.^. CourseParticipantState))
-          , single $ ("has-personalised-sheet-files", FilterColumn $ \t (Last criterion) -> flip (maybe E.true) criterion $ \shn
+          , single ("has-personalised-sheet-files", FilterColumn $ \t (Last criterion) -> flip (maybe E.true) criterion $ \shn
-                       -> E.exists . E.from $ \(psFile `E.InnerJoin` sheet) -> do
+                     -> E.exists . E.from $ \(psFile `E.InnerJoin` sheet) -> do
-                            E.on $ psFile E.^. PersonalisedSheetFileSheet E.==. sheet E.^. SheetId
+                          E.on $ psFile E.^. PersonalisedSheetFileSheet E.==. sheet E.^. SheetId
-                            E.where_ $ psFile E.^. PersonalisedSheetFileUser E.==. queryParticipant t E.^. CourseParticipantUser
+                          E.where_ $ psFile E.^. PersonalisedSheetFileUser E.==. queryParticipant t E.^. CourseParticipantUser
-                            E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+                          E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
-                                 E.&&. sheet E.^. SheetName E.==. E.val shn
+                               E.&&. sheet E.^. SheetName E.==. E.val shn
-                     )
+                   )
           ]
           where single = uncurry Map.singleton
         dbtFilterUI mPrev = mconcat $
@@ -525,7 +525,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
             { dbtCsvExportForm = UserCsvExportData
                 <$> apopt checkBoxField (fslI MsgUserSimplifiedFeaturesOfStudyCsv & setTooltip MsgUserSimplifiedFeaturesOfStudyCsvTip) (Just $ csvUserSimplifiedFeaturesOfStudy def)
                 <*> apopt checkBoxField (fslI MsgCourseUserCsvIncludeSheets & setTooltip MsgCourseUserCsvIncludeSheetsTip) (Just $ csvUserIncludeSheets def)
-            , dbtCsvDoEncode = \UserCsvExportData{..} -> C.mapM $ \(E.Value uid, row) -> flip runReaderT row $ 
+            , dbtCsvDoEncode = \UserCsvExportData{..} -> C.mapM $ \(E.Value uid, row) -> flip runReaderT row $
                 UserTableCsv
                   <$> view (hasUser . _userDisplayName)
                   <*> view (hasUser . _userSex)
@@ -652,7 +652,7 @@ postCUsersR tid ssh csh = do
         hasExams = not $ null exams
         examOccActs :: Map ExamId (AForm Handler (ExamId, Maybe ExamOccurrenceId))
         examOccActs = examOccurrencesPerExam
-          & (map (bimap entityKey hoistMaybe)) 
+          & map (bimap entityKey hoistMaybe)
           & Map.fromListWith (<>)
           & imap (\k v -> case v of
             [] -> pure (k, Nothing)
@@ -726,7 +726,7 @@ postCUsersR tid ssh csh = do
         addMessageI Success $ MsgCourseUsersDeregistered nrDel
         redirect $ CourseR tid ssh csh CUsersR
     (CourseUserRegisterTutorialData{..}, selectedUsers) -> do
-        runDB . forM_ selectedUsers $ 
+        runDB . forM_ selectedUsers $
           void . insertUnique . TutorialParticipant registerTutorial
         addMessageI Success . MsgCourseUsersTutorialRegistered . fromIntegral $ Set.size selectedUsers
         redirect $ CourseR tid ssh csh CUsersR
@@ -767,7 +767,7 @@ postCUsersR tid ssh csh = do
           ]
           [ CourseParticipantState =. CourseParticipantActive
           , CourseParticipantRegistration =. now
-          , CourseParticipantAllocated =. Nothing 
+          , CourseParticipantAllocated =. Nothing
           ]
         guard $ didUpdate > 0
         lift $ deleteWhere [ AllocationDeregisterCourse ==. Just cid, AllocationDeregisterUser ==. uid ]

src/Handler/CryptoIDDispatch.hs

@@ -62,7 +62,7 @@ instance (CryptoRoute ciphertext plaintext, Dispatch ciphertext ps) => Dispatch
           handleCryptoID :: CryptoIDError -> Handler (Maybe a)
           handleCryptoID _ = return Nothing
       dispatchTail = dispatchID (Proxy :: Proxy ps) ciphertext
-  
+
 
 getCryptoUUIDDispatchR :: UUID -> Handler ()
 getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectAccessWith movedPermanently301)
@@ -75,5 +75,5 @@ getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectAcce
 getCryptoFileNameDispatchR :: CI FilePath -> Handler ()
 getCryptoFileNameDispatchR path = dispatchID p path >>= maybe notFound (redirectAccessWith movedPermanently301)
   where
-    p :: Proxy '[ SubmissionId ] 
+    p :: Proxy '[ SubmissionId ]
     p = Proxy

src/Handler/Exam/AddUser.hs

@@ -8,15 +8,15 @@ import Handler.Exam.RegistrationInvite
 import Handler.Utils
 import Handler.Utils.Exam
 import Handler.Utils.Invitations
-  
+
 import qualified Data.Set as Set
 
 import Data.Semigroup (Option(..))
-  
+
 import Control.Monad.Error.Class (MonadError(..))
 
 import Jobs.Queue
-  
+
 import Generics.Deriving.Monoid
 
 
@@ -43,7 +43,7 @@ postEAddUserR tid ssh csh examn = do
     ((usersToEnlist,formWgt),formEncoding) <- runFormPost . renderWForm FormStandard $ do
       now <- liftIO getCurrentTime
       occurrences <- liftHandler . runDB $ selectList [ExamOccurrenceExam ==. eid] []
-      
+
       let
         localNow = utcToLocalTime now
         tomorrowEndOfDay = case localTimeToUTC (LocalTime (addDays 2 $ localDay localNow) midnight) of
@@ -65,7 +65,7 @@ postEAddUserR tid ssh csh examn = do
           = max tomorrowEndOfDay earliestDate'
           | otherwise
           = tomorrowEndOfDay
-          
+
       deadline <- wreq utcTimeField (fslI MsgExamRegistrationInviteDeadline) (Just defDeadline)
       enlist <- wpopt checkBoxField (fslI MsgExamRegistrationEnlistDirectly & setTooltip MsgExamRegistrationEnlistDirectlyTip) (Just False)
       registerCourse <- wpopt checkBoxField (fslI MsgExamRegistrationRegisterCourse & setTooltip MsgExamRegistrationRegisterCourseTip) (Just False)
@@ -132,7 +132,7 @@ postEAddUserR tid ssh csh examn = do
         lift $ lift examRegister
         throwError $ mempty { aurSuccess = pure userEmail }
 
-      unless registerCourse $ 
+      unless registerCourse $
         throwError $ mempty { aurNoCourseRegistration = pure userEmail }
 
       guardAuthResult =<< lift (lift $ evalAccessDB (CourseR tid ssh csh CAddUserR) True)

src/Handler/Exam/AutoOccurrence.hs

@@ -52,7 +52,7 @@ examAutoOccurrenceCalculateForm :: ExamAutoOccurrenceCalculateForm -> Form ExamA
 examAutoOccurrenceCalculateForm ExamAutoOccurrenceCalculateForm{ eaofConfig }
   = identifyForm FIDExamAutoOccurrenceCalculate . renderAForm FormStandard $ ExamAutoOccurrenceCalculateForm <$> eaocForm
   where
-    eaocForm = 
+    eaocForm =
       (set _eaocMinimizeRooms <$> apopt checkBoxField (fslI MsgExamAutoOccurrenceMinimizeRooms & setTooltip MsgExamAutoOccurrenceMinimizeRoomsTip) (Just $ eaofConfig ^. _eaocMinimizeRooms))
       <*> pure def
 
@@ -62,7 +62,7 @@ examAutoOccurrenceNudgeForm occId protoForm html = do
   (btnRes, wgt) <- identifyForm (FIDExamAutoOccurrenceNudge $ ciphertext cID) (buttonForm' [BtnExamAutoOccurrenceNudgeUp, BtnExamAutoOccurrenceNudgeDown]) html
   oldDataRes <- globalPostParamField PostExamAutoOccurrencePrevious secretJsonField
   oldDataId <- newIdent
-  
+
   let protoForm' = fromMaybe def $ oldDataRes <|> protoForm
       genForm btn = protoForm' & _eaofConfig . _eaocNudge %~ Map.insertWith (+) occId n
         where n = case btn of
@@ -83,12 +83,12 @@ examAutoOccurrenceAcceptForm confirmData = identifyForm FIDExamAutoOccurrenceCon
 examAutoOccurrenceCalculateWidget :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Widget
 examAutoOccurrenceCalculateWidget tid ssh csh examn = do
   (formView, formEncoding) <- liftHandler . generateFormPost $ examAutoOccurrenceCalculateForm def
-  
+
   wrapForm' BtnExamAutoOccurrenceCalculate $(i18nWidgetFile "exam-auto-occurrence-calculate") def
     { formAction = Just . SomeRoute $ CExamR tid ssh csh examn EAutoOccurrenceR
     , formEncoding
     }
-      
+
 
 postEAutoOccurrenceR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 postEAutoOccurrenceR tid ssh csh examn = do
@@ -96,8 +96,8 @@ postEAutoOccurrenceR tid ssh csh examn = do
     exam@(Entity eId _) <- fetchExam tid ssh csh examn
     occurrences <- selectList [ ExamOccurrenceExam ==. eId ] [ Asc ExamOccurrenceName ]
     return (exam, occurrences)
-  
+
-  
+
   ((calculateRes, _), _) <- runFormPost $ examAutoOccurrenceCalculateForm def
 
   nudgeRes <- sequence . flip Map.fromSet (setOf (folded . _entityKey) occurrences) $ \occId ->

src/Handler/Exam/Correct.hs

@@ -84,15 +84,15 @@ getECorrectR tid ssh csh examn = do
     return (exam, entityVal <$> examParts)
 
   mayEditResults <- hasWriteAccessTo $ CExamR tid ssh csh examn EUsersR
-  
+
   let
     heading = prependCourseTitle tid ssh csh $ (mr . MsgExamCorrectHeading . CI.original) examName
-    
+
     ptsInput :: ExamPartNumber -> Widget
     ptsInput n = do
       name <- newIdent
       fieldView (pointsField :: Field Handler Points) ("exam-correct__" <> toPathPiece n) name [("uw-exam-correct--part-input", toPathPiece n)] (Left "") False
-    
+
     examGrades :: [ExamGrade]
     examGrades = universeF
 
@@ -111,12 +111,12 @@ postECorrectR tid ssh csh examn = do
   CorrectInterfaceRequest{..} <- requireCheckJsonBody
 
   mayEditResults <- hasWriteAccessTo $ CExamR tid ssh csh examn EUsersR
-  
+
   response <- runDB . exceptT (<$ transactionUndo) return $ do
-    Entity eId Exam{..} <- lift $ fetchExam tid ssh csh examn
+    Entity eId Exam{} <- lift $ fetchExam tid ssh csh examn
     euid <- traverse decrypt ciqUser
 
-    guardMExceptT (maybe True ((>= 3) . length) $ euid ^? _Left) $ 
+    guardMExceptT (maybe True ((>= 3) . length) $ euid ^? _Left) $
       CorrectInterfaceResponseFailure Nothing <$> (getMessageRender <*> pure MsgExamCorrectErrorNeedleTooShort)
 
 
@@ -188,7 +188,7 @@ postECorrectR tid ssh csh examn = do
                          in CorrectInterfaceResponseFailure
                               <$> (Just <$> userToResponse match)
                               <*> (getMessageRender <*> pure msg)
-                      
+
                       newExamPartResult <- lift $ upsert ExamPartResult
                         { examPartResultExamPart    = examPartId
                         , examPartResultUser        = uid
@@ -230,7 +230,7 @@ postECorrectR tid ssh csh examn = do
                   return $ newResult ^? _entityVal . _examResultResult
                 | otherwise -> return $ mOldResult ^? _Just . _entityVal . _examResultResult
             | otherwise -> return Nothing
-              
+
         user <- userToResponse match
         return CorrectInterfaceResponseSuccess
           { cirsUser    = user
@@ -252,7 +252,7 @@ postECorrectR tid ssh csh examn = do
           { ciraMessage = mr MsgExamCorrectErrorMultipleMatchingParticipants
           , ciraUsers   = Set.fromList users
           }
-  
+
   let
     responseStatus = case response of
       CorrectInterfaceResponseSuccess{} -> ok200
@@ -261,5 +261,5 @@ postECorrectR tid ssh csh examn = do
 
   whenM acceptsJson $
     sendResponseStatus responseStatus $ toJSON response
-  
+
   redirect $ CExamR tid ssh csh examn EShowR

src/Handler/Exam/CorrectorInvite.hs

@@ -18,7 +18,7 @@ import Data.Aeson hiding (Result(..))
 
 import qualified Data.HashSet as HashSet
 
-  
+
 instance IsInvitableJunction ExamCorrector where
   type InvitationFor ExamCorrector = Exam
   data InvitableJunction ExamCorrector = JunctionExamCorrector

src/Handler/Exam/Form.hs

@@ -96,7 +96,7 @@ examForm template html = do
     <*> apopt checkBoxField (fslI MsgExamPublicStatistics & setTooltip MsgExamPublicStatisticsTip) (efPublicStatistics <$> template <|> Just True)
     <*> optionalActionA (examGradingRuleForm $ efGradingRule =<< template) (fslI MsgExamAutomaticGrading & setTooltip MsgExamAutomaticGradingTip) (is _Just . efGradingRule <$> template)
     <*> optionalActionA (examBonusRuleForm $ efBonusRule =<< template) (fslI MsgExamBonus) (is _Just . efBonusRule <$> template)
-    <*> (examOccurrenceRuleForm $ efOccurrenceRule <$> template)
+    <*> examOccurrenceRuleForm (efOccurrenceRule <$> template)
     <*  aformSection MsgExamFormCorrection
     <*> examCorrectorsForm (efCorrectors <$> template)
     <*  aformSection MsgExamFormParts
@@ -117,7 +117,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do
       (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just corrUserSuggestions) (fslI MsgExamCorrectorEmail & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
       let
         addRes'
-          | otherwise
+
           = addRes <&> \newDat oldDat -> if
               | existing <- newDat `Set.intersection` Set.fromList oldDat
               , not $ Set.null existing
@@ -201,7 +201,7 @@ examPartsForm prev = wFormToAForm $ do
   fmap (fmap Set.fromList) . massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' (fslI MsgExamParts) False $ Set.toList <$> prev
   where
     examPartForm' nudge mPrev csrf = do
-      (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev)  
+      (epfIdRes, epfIdView) <- mopt hiddenField ("" & addName (nudge "id")) (Just $ epfId =<< mPrev)
       (epfNumberRes, epfNumberView) <- mpreq (isoField (from _ExamPartNumber) $ textField & cfStrip & cfCI) (fslI MsgExamPartNumber & addName (nudge "number") & addPlaceholder "1, 6a, 3.1.4, ...") (epfNumber <$> mPrev)
       (epfNameRes, epfNameView) <- mopt (textField & cfStrip & cfCI) (fslI MsgExamPartName & addName (nudge "name")) (epfName <$> mPrev)
       (epfMaxPointsRes, epfMaxPointsView) <- mopt pointsField (fslI MsgExamPartMaxPoints & addName (nudge "max-points")) (epfMaxPoints <$> mPrev)
@@ -221,7 +221,7 @@ examPartsForm prev = wFormToAForm $ do
       (res, formWidget) <- examPartForm' nudge Nothing csrf
       let
         addRes = res <&> \newDat (Set.fromList -> oldDat) -> if
-          | any (\old -> fromMaybe False $ (==) <$> epfName newDat <*> epfName old) oldDat
+          | any (\old -> Just True == ((==) <$> epfName newDat <*> epfName old)) oldDat
             -> FormFailure [mr MsgExamPartAlreadyExists]
           | otherwise -> FormSuccess $ pure newDat
       return (addRes, $(widgetFile "widgets/massinput/examParts/add"))
@@ -336,10 +336,10 @@ validateExam = do
 
   guardValidation MsgExamRegisterToMustBeAfterRegisterFrom                 $ NTop efRegisterTo                   >= NTop efRegisterFrom
   guardValidation MsgExamDeregisterUntilMustBeAfterRegisterFrom            $ NTop efDeregisterUntil              >= NTop efRegisterFrom
-  guardValidation MsgExamStartMustBeAfterPublishOccurrenceAssignments      . fromMaybe True $ (>=) <$> efStart <*> efPublishOccurrenceAssignments
+  guardValidation MsgExamStartMustBeAfterPublishOccurrenceAssignments      $ Just False /= ((>=) <$> efStart <*> efPublishOccurrenceAssignments)
   guardValidation MsgExamEndMustBeAfterStart                               $ NTop efEnd                          >= NTop efStart
-  guardValidation MsgExamFinishedMustBeAfterEnd                            . fromMaybe True $ (>=) <$> efFinished <*> efEnd
+  guardValidation MsgExamFinishedMustBeAfterEnd   $ Just False /= ((>=) <$> efFinished <*> efEnd)
-  guardValidation MsgExamFinishedMustBeAfterStart                          . fromMaybe True $ (>=) <$> efFinished <*> efStart
+  guardValidation MsgExamFinishedMustBeAfterStart $ Just False /= ((>=) <$> efFinished <*> efStart)
 
   forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
     guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName)       $ NTop eofEnd >= NTop (Just eofStart)

src/Handler/Exam/List.hs

@@ -6,7 +6,7 @@ module Handler.Exam.List
 import Import
 
 import Handler.Utils
-  
+
 import qualified Data.Map as Map
 
 import qualified Database.Esqueleto as E
@@ -75,16 +75,15 @@ mkExamTable (Entity cid Course{..}) = do
     examDBTableValidator = def
       & defaultSorting [SortAscBy "time"]
       & forceFilter "may-read" (Any True)
-  
+
   dbTable examDBTableValidator examDBTable
 
 
 getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCExamListR tid ssh csh = do
-  (Entity _ Course{..}, examTable) <- runDB $ do
+  examTable <- runDB $ do
     c <- getBy404 $ TermSchoolCourseShort tid ssh csh
-    (_, examTable) <- mkExamTable c
+    view _2 <$> mkExamTable c
-    return (c, examTable)
 
   siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamsHeading) $ do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamsHeading

src/Handler/Exam/New.hs

@@ -12,7 +12,7 @@ import Handler.Utils
 import Handler.Utils.Invitations
 
 import Jobs.Queue
-  
+
 import qualified Data.Conduit.Combinators as C
 
 
@@ -29,7 +29,7 @@ postCExamNewR tid ssh csh = do
   formResult newExamResult $ \ExamForm{..} -> do
     insertRes <- runDBJobs $ do
       now <- liftIO getCurrentTime
-      
+
       insertRes <- insertUnique Exam
         { examName                         = efName
         , examCourse                       = cid
@@ -90,7 +90,7 @@ postCExamNewR tid ssh csh = do
               when didRecord $
                 audit $ TransactionExamResultEdit examid courseParticipantUser
         runConduit $ selectSource [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantInactive True ] [] .| C.mapM_ recordNoShow
-        
+
       return insertRes
     case insertRes of
       Nothing -> addMessageI Error $ MsgExamNameTaken efName

src/Handler/Exam/Register.hs

@@ -21,7 +21,7 @@ data ButtonExamRegister = BtnExamRegisterOccurrence
 instance Universe ButtonExamRegister
 instance Finite ButtonExamRegister
 nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 2
-  
+
 instance Button UniWorX ButtonExamRegister where
   btnClasses BtnExamRegisterOccurrence = [BCIsButton, BCPrimary]
   btnClasses BtnExamSwitchOccurrence   = [BCIsButton, BCPrimary]
@@ -36,9 +36,9 @@ instance Button UniWorX ButtonExamRegister where
 
 postERegisterR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 postERegisterR tid ssh csh examn = do
-  Entity uid User{..} <- requireAuth
+  uid <- requireAuthId
 
-  Entity eId Exam{..} <- runDB $ fetchExam tid ssh csh examn
+  Entity eId Exam{} <- runDB $ fetchExam tid ssh csh examn
 
   ((btnResult, _), _) <- runFormPost $ buttonForm' [BtnExamRegister, BtnExamDeregister]
 
@@ -63,14 +63,14 @@ postERegisterR tid ssh csh examn = do
 
 postERegisterOccR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> ExamOccurrenceName -> Handler Html
 postERegisterOccR tid ssh csh examn occn = do
-  Entity uid User{..} <- requireAuth
+  uid <- requireAuthId
-  (Entity eId Exam{..}, Entity occId ExamOccurrence{..}) <- runDB $ do
+  (eId, occId) <- runDB $ do
-    eexam@(Entity eId _) <- fetchExam tid ssh csh examn
+    Entity eId _ <- fetchExam tid ssh csh examn
-    occ <- getBy404 $ UniqueExamOccurrence eId occn
+    occ <- getKeyBy404 $ UniqueExamOccurrence eId occn
-    return (eexam, occ)
+    return (eId, occ)
 
   ((btnResult, _), _) <- runFormPost buttonForm
-  
+
   formResult btnResult $ \case
     BtnExamDeregister -> do
       runDB $ do
@@ -89,4 +89,4 @@ postERegisterOccR tid ssh csh examn occn = do
     _other -> error "Unexpected due to definition of buttonForm'"
 
   redirect $ CExamR tid ssh csh examn EShowR
-  
+

src/Handler/Exam/RegistrationInvite.hs

@@ -16,13 +16,13 @@ import Handler.Utils.Invitations
 import qualified Data.Set as Set
 
 import Text.Hamlet (ihamlet)
-  
+
 import Data.Aeson hiding (Result(..))
 
 import Jobs.Queue
 
 import qualified Data.HashSet as HashSet
-  
+
 
 instance IsInvitableJunction ExamRegistration where
   type InvitationFor ExamRegistration = Exam
@@ -98,7 +98,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
         (False, True ) -> do
           fieldRes <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature) Nothing
           return $ (JunctionExamRegistration invDBExamRegistrationOccurrence now, ) . Just <$> fieldRes
-        (True , _    ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, Nothing) 
+        (True , _    ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, Nothing)
     invitationInsertHook _ (Entity eid Exam{..}) _ ExamRegistration{..} mField act = do
       whenIsJust mField $ \cpField -> do
         void $ upsert
@@ -110,7 +110,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
           ]
         queueDBJob . JobQueueNotification $ NotificationCourseRegistered examRegistrationUser examCourse
         audit $ TransactionCourseParticipantEdit examCourse examRegistrationUser
-      
+
       let doAudit = audit $ TransactionExamRegister eid examRegistrationUser
       act <* doAudit
     invitationSuccessMsg (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamRegistrationInvitationAccepted examName

src/Handler/Exam/Show.hs

@@ -96,9 +96,9 @@ getEShowR tid ssh csh examn = do
 
       sumRegisteredCount = sumOf (folded . _3) occurrences
 
-      noBonus = fromMaybe False $ do
+      noBonus = (Just True ==) $ do
         guardM $ bonusOnlyPassed <$> examBonusRule
-        return . fromMaybe True $ result ^? _Just . _entityVal . _examResultResult . _examResult . to (either id $ view passingGrade) . _Wrapped . to not
+        return $ Just False /= result ^? _Just . _entityVal . _examResultResult . _examResult . to (either id $ view passingGrade) . _Wrapped . to not
 
       sumPoints = fmap getSum . mconcat $ catMaybes
         [ Just $ foldMap (fmap Sum . examPartResultResult . entityVal) results
@@ -187,5 +187,5 @@ getEShowR tid ssh csh examn = do
       examBonusW bonusRule = $(widgetFile "widgets/bonusRule")
 
       occurrenceMapping :: ExamOccurrenceName -> Maybe Widget
-      occurrenceMapping occName = examOccurrenceMappingDescriptionWidget <$> fmap examOccurrenceMappingRule examExamOccurrenceMapping <*> (fmap examOccurrenceMappingMapping examExamOccurrenceMapping >>= Map.lookup occName)
+      occurrenceMapping occName = examOccurrenceMappingDescriptionWidget <$> fmap examOccurrenceMappingRule examExamOccurrenceMapping <*> (examExamOccurrenceMapping >>= Map.lookup occName . examOccurrenceMappingMapping)
     $(widgetFile "exam-show")

src/Handler/Exam/Users.hs

@@ -88,7 +88,7 @@ queryExamOccurrence = $(sqlLOJproj 6 2)
 
 queryCourseParticipant :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity CourseParticipant))
 queryCourseParticipant = $(sqlLOJproj 2 1) . $(sqlLOJproj 6 3)
-  
+
 queryStudyFeatures :: ExamUserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
 queryStudyFeatures = $(sqlIJproj 3 1) . $(sqlLOJproj 2 2) . $(sqlLOJproj 6 3)
 
@@ -184,7 +184,7 @@ csvExamPartHeader = prism' toHeader fromHeader
       review _ExamPartNumber . CI.mk <$> stripPrefix partPrefix tHdr
 
     partPrefix = "part-"
-  
+
 
 data ExamUserTableCsv = ExamUserTableCsv
   { csvEUserSurname :: Maybe Text
@@ -498,7 +498,7 @@ postEUsersR tid ssh csh examn = do
                   [ (epId, (examPart, mbRes))
                   | (Entity epId examPart, mbRes) <- rawResults
                   ]
-            
+
           dbtColonnade = mconcat $ catMaybes
             [ pure $ dbSelect (_2 . applying _2) _1 $ return . view (resultExamRegistration . _entityKey)
             , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
@@ -507,7 +507,7 @@ postEUsersR tid ssh csh examn = do
             , pure $ colDegreeShort      resultStudyDegree
             , pure $ colFeaturesSemester resultStudyFeatures
             , pure $ sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (anchorCell' (\n -> CExamR tid ssh csh examn EShowR :#: [st|exam-occurrence__#{n}|]) id . examOccurrenceName . entityVal) . view _userTableOccurrence
-            , guardOn showPasses $ sortable Nothing (i18nCell MsgAchievedPasses) $ \(view $ resultUser . _entityKey -> uid) -> 
+            , guardOn showPasses $ sortable Nothing (i18nCell MsgAchievedPasses) $ \(view $ resultUser . _entityKey -> uid) ->
                 let SheetGradeSummary{achievedPasses} = examBonusAchieved uid bonus
                     SheetGradeSummary{numSheetsPasses} = examBonusPossible uid bonus
                  in propCell (getSum achievedPasses) (getSum numSheetsPasses)
@@ -516,7 +516,7 @@ postEUsersR tid ssh csh examn = do
                     SheetGradeSummary{sumSheetsPoints} = examBonusPossible uid bonus
                  in propCell (getSum achievedPoints) (getSum sumSheetsPoints)
             , guardOn doBonus $ sortable (Just "bonus") (i18nCell MsgExamBonusAchieved) . automaticCell $ resultExamBonus . _entityVal . _examBonusBonus . to Right <> resultAutomaticExamBonus' . to Left
-            , pure $ mconcat 
+            , pure $ mconcat
               [ sortable (Just $ fromText [st|part-#{toPathPiece examPartNumber}|]) (i18nCell $ MsgExamPartNumbered examPartNumber) $ maybe mempty i18nCell . preview (resultExamPartResult epId . _Just . _entityVal . _examPartResultResult)
               | Entity epId ExamPart{..} <- sortOn (examPartNumber . entityVal) examParts
               ]
@@ -597,7 +597,7 @@ postEUsersR tid ssh csh examn = do
                     tell =<< optionsF [ ExamUserDeregister, ExamUserAssignOccurrence ]
                     when (is _Just examGradingRule) $
                       tell =<< optionsF [ ExamUserAcceptComputedResult, ExamUserResetToComputedResult ]
-                    when (not $ null examParts) $
+                    unless (null examParts) $
                       tell =<< optionsF [ ExamUserSetPartResult ]
                     when doBonus $
                       tell =<< optionsF [ ExamUserSetBonus ]
@@ -651,7 +651,7 @@ postEUsersR tid ssh csh examn = do
                   (isPart, uid) <- lift $ guessUser' dbCsvNew
                   if
                     | isPart -> do
-                        yieldM $ ExamUserCsvRegisterData <$> pure uid <*> lookupOccurrence dbCsvNew
+                        yieldM $ ExamUserCsvRegisterData uid <$> lookupOccurrence dbCsvNew
                         newFeatures <- lift $ lookupStudyFeatures dbCsvNew
                         Entity cpId CourseParticipant{ courseParticipantField = oldFeatures } <- lift . getJustBy $ UniqueParticipant uid examCourse
                         when (newFeatures /= oldFeatures) $
@@ -662,10 +662,10 @@ postEUsersR tid ssh csh examn = do
                   iforMOf_ (ifolded <. _Just) (csvEUserExamPartResults dbCsvNew) $ \epNumber epRes ->
                     when (epNumber `elem` examPartNumbers) $
                       yield $ ExamUserCsvSetPartResultData uid epNumber (Just epRes)
-            
+
                   when (doBonus && is _Just (join $ csvEUserBonus dbCsvNew)) $
                     yield . ExamUserCsvSetBonusData False uid . join $ csvEUserBonus dbCsvNew
-            
+
                   whenIsJust (csvEUserExamResult dbCsvNew) $ \res -> do
                     yield . ExamUserCsvSetResultData False uid $ csvEUserExamResult dbCsvNew
                     guardResultKind res
@@ -693,7 +693,7 @@ postEUsersR tid ssh csh examn = do
 
                   let newResults :: Maybe (Map ExamPartNumber ExamResultPoints)
                       newResults = sequence (csvEUserExamPartResults dbCsvNew)
-                               <|> sequence (toMapOf (resultExamParts .> ito (over _1 $ examPartNumber) <. to (fmap $ examPartResultResult . entityVal)) dbCsvOld)
+                               <|> sequence (toMapOf (resultExamParts .> ito (over _1 examPartNumber) <. to (fmap $ examPartResultResult . entityVal)) dbCsvOld)
 
                       newBonus, oldBonus :: Maybe Points
                       newBonus = join (csvEUserBonus dbCsvNew)
@@ -702,7 +702,7 @@ postEUsersR tid ssh csh examn = do
                       newResult, oldResult :: Maybe ExamResultPassedGrade
                       newResult = fmap (fmap $ bool Right (Left . view passingGrade) $ is _ExamGradingGrades examGradingMode) . examGrade examVal (newBonus <|> oldBonus) =<< newResults
                       oldResult = dbCsvOld ^? (resultExamResult . _entityVal . _examResultResult <> resultAutomaticExamResult')
-                  
+
                   when doBonus $
                     case newBonus of
                       _ | newBonus == oldBonus
@@ -715,7 +715,7 @@ postEUsersR tid ssh csh examn = do
                         -> yield $ ExamUserCsvSetBonusData False uid newBonus
                       Just _
                         -> yield $ ExamUserCsvSetBonusData True uid newBonus
-            
+
                   case newResult of
                     _ | csvEUserExamResult dbCsvNew == oldResult
                         -> return ()
@@ -964,15 +964,15 @@ postEUsersR tid ssh csh examn = do
                     | is (_ExamAttended . _Left) res -> ExamGradingPass
                     | otherwise -> ExamGradingGrades
                 | otherwise = return ()
-              
+
               registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget
               registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
                 where
                   Entity _ User{..} = view resultUser $ existing ! registration
-    
+
               guessUser' :: ExamUserTableCsv -> DB (Bool, UserId)
               guessUser' ExamUserTableCsv{..} = do
-                let criteria = Set.fromList $ catMaybes 
+                let criteria = Set.fromList $ catMaybes
                       [ GuessUserMatrikelnummer <$> csvEUserMatriculation
                       , GuessUserDisplayName <$> csvEUserName
                       , GuessUserSurname <$> csvEUserSurname
@@ -1088,7 +1088,7 @@ postEUsersR tid ssh csh examn = do
                   audit $ TransactionExamBonusEdit eId uid
                 | otherwise
                 -> return ()
-              
+
               insert_ ExamResult
                 { examResultExam = eId
                 , examResultUser = uid

src/Handler/ExamOffice/Course.hs

@@ -28,7 +28,7 @@ getCExamOfficeR = postCExamOfficeR
 postCExamOfficeR tid ssh csh = do
   uid <- requireAuthId
   isModal <- hasCustomHeader HeaderIsModal
-  
+
   (cid, optOuts, hasForced) <- runDB $ do
     cid <- getKeyBy404 (TermSchoolCourseShort tid ssh csh)
     optOuts <- selectList [ CourseUserExamOfficeOptOutCourse ==. cid, CourseUserExamOfficeOptOutUser ==. uid ] []
@@ -65,7 +65,7 @@ postCExamOfficeR tid ssh csh = do
     setTitleI MsgMenuCourseExamOffice
 
     let explanation = $(i18nWidgetFile "course-exam-office-explanation")
-  
+
     [whamlet|
       $newline never
       <section>

src/Handler/ExamOffice/Exam.hs

@@ -34,7 +34,7 @@ embedRenderMessage ''UniWorX ''ButtonCloseExam id
 instance Button UniWorX ButtonCloseExam where
   btnClasses BtnCloseExam = [BCIsButton]
 
-  
+
 examCloseWidget :: SomeRoute UniWorX -> ExamId -> Handler Widget
 examCloseWidget dest eId = do
   Exam{..} <- runDB $ get404 eId
@@ -47,7 +47,7 @@ examCloseWidget dest eId = do
 
       unless (is _Nothing examClosed) $
         invalidArgs ["Exam is already closed"]
-  
+
       runDB $ update eId [ ExamClosed =. Just now ]
       addMessageI Success MsgExamDidClose
       redirect dest
@@ -189,7 +189,7 @@ newtype ExamUserCsvExportData = ExamUserCsvExportData
   { csvEUserMarkSynchronised :: Bool
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
-  
+
 -- | View a list of all users' grades that the current user has access to
 getEGradesR, postEGradesR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html
 getEGradesR = postEGradesR
@@ -271,7 +271,7 @@ postEGradesR tid ssh csh examn = do
 
               E.where_ $ examResult E.^. ExamResultExam E.==. E.val eid
 
-              unless isLecturer $ 
+              unless isLecturer $
                 E.where_ $ Exam.examOfficeExamResultAuth (E.val uid) examResult
 
             return (examResult, user, occurrence, studyFeatures, studyDegree, studyField, examRegistration, isSynced)
@@ -314,9 +314,9 @@ postEGradesR tid ssh csh examn = do
               syncs' = [ Right sync | sync@(_, _, t, _) <- syncs, t >  lastChange]
                     ++ [ Left lastChange ]
                     ++ [ Right sync | sync@(_, _, t, _) <- syncs, t <= lastChange]
-              
+
               syncIcon :: Widget
-              syncIcon 
+              syncIcon
                 | not isSynced
                 , not hasSyncs
                 = mempty
@@ -324,7 +324,7 @@ postEGradesR tid ssh csh examn = do
                 = toWidget iconNotOK
                 | otherwise
                 = toWidget iconOK
-            
+
               syncsModal :: Widget
               syncsModal = $(widgetFile "exam-office/exam-result-synced")
             lift $ bool id (flip modal $ Right syncsModal) hasSyncs syncIcon

src/Handler/ExamOffice/Exams.hs

@@ -30,7 +30,7 @@ queryExam = to $ $(E.sqlIJproj 2 1) . $(E.sqlFOJproj 2 1)
 
 queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Course)))
 queryCourse = to $ $(E.sqlIJproj 2 2) . $(E.sqlFOJproj 2 1)
-  
+
 queryExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExternalExam)))
 queryExternalExam = to $(E.sqlFOJproj 2 2)
 
@@ -48,7 +48,7 @@ querySynchronised office = to . runReader $ do
       E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
       E.where_ $ ExternalExam.resultIsSynced office externalExamResult
   return $ E.maybe (E.val 0) examSynchronised (exam' E.?. ExamId) E.+. E.maybe (E.val 0) externalExamSynchronised (externalExam' E.?. ExternalExamId)
-  
+
 queryResults :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Natural))
 queryResults office = to . runReader $ do
   exam' <- view queryExam
@@ -75,7 +75,7 @@ queryIsSynced now office = to . runReader $ do
       E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
       E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
       E.where_ . E.not_ $ ExternalExam.resultIsSynced office externalExamResult
-    open examClosed' = E.maybe E.true (E.>. E.val now) $ examClosed'
+    open examClosed' = E.maybe E.true (E.>. E.val now) examClosed'
   return $ E.maybe E.false examSynchronised (exam' E.?. ExamId) E.||. E.maybe E.false open (exam' E.?. ExamClosed) E.||. E.maybe E.false externalExamSynchronised (externalExam' E.?. ExternalExamId)
 
 
@@ -95,7 +95,7 @@ resultResults = _dbrOutput . _3
 resultIsSynced :: Getter ExamsTableData Bool
 resultIsSynced = to $ (>=) <$> view resultSynchronised <*> view resultResults
 
-  
+
 -- | List of all exams where the current user may (in her function as
 --   exam-office) access users grades
 getEOExamsR :: Handler Html
@@ -106,15 +106,15 @@ getEOExamsR = do
   examsTable <- runDB $ do
     let
       examLink :: Course -> Exam -> SomeRoute UniWorX
-      examLink Course{..} Exam{..} 
+      examLink Course{..} Exam{..}
         = SomeRoute $ CExamR courseTerm courseSchool courseShorthand examName EGradesR
 
       courseLink :: Course -> SomeRoute UniWorX
       courseLink Course{..}
         = SomeRoute $ CourseR courseTerm courseSchool courseShorthand CShowR
-    
+
       externalExamLink :: ExternalExam -> SomeRoute UniWorX
-      externalExamLink ExternalExam{..} 
+      externalExamLink ExternalExam{..}
         = SomeRoute $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEGradesR
 
       querySynchronised' = querySynchronised $ E.val uid
@@ -150,11 +150,9 @@ getEOExamsR = do
 
             case (exam, course, externalExam) of
               (Just exam', Just course', Nothing) ->
-                (,,)
+                (Right (exam', course'),,) <$> view (_4 . _Value) <*> view (_5 . _Value)
-                  <$> pure (Right (exam', course')) <*> view (_4 . _Value) <*> view (_5 . _Value)
               (Nothing, Nothing, Just externalExam') ->
-                (,,)
+                (Left externalExam',,) <$> view (_4 . _Value) <*> view (_5 . _Value)
-                  <$> pure (Left externalExam') <*> view (_4 . _Value) <*> view (_5 . _Value)
               _other -> return $ error "Got exam & externalExam in same result"
 
 
@@ -182,7 +180,7 @@ getEOExamsR = do
                      & cellAttrs <>~ [ ("class", "heated")
                                      , ("style", [st|--hotness: #{tshow (heat results synced)}|])
                                      ]
-        
+
 
           dbtColonnade :: Colonnade Sortable _ _
           dbtColonnade = mconcat
@@ -192,7 +190,7 @@ getEOExamsR = do
                                    )
                 $ emptyOpticColonnade (resultExam . _entityVal . _examName <> resultExternalExam . _entityVal . _externalExamExamName) colExamName
             , emptyOpticColonnade (resultExam . _entityVal . $(multifocusG 2) _examStart _examEnd) colExamTime
-            , emptyOpticColonnade (resultExam . _entityVal . _examFinished) colExamFinishedOffice 
+            , emptyOpticColonnade (resultExam . _entityVal . _examFinished) colExamFinishedOffice
             , emptyOpticColonnade (resultExam . _entityVal . _examClosed) colExamClosed
             , maybeAnchorColonnade (previews (resultCourse . _entityVal) courseLink)
                 $ emptyOpticColonnade (resultCourse . _entityVal . _courseName <> resultExternalExam . _entityVal . _externalExamCourseName) colCourseName

src/Handler/ExamOffice/ExternalExam.hs

@@ -7,7 +7,7 @@ import Import
 import Handler.Utils
 
 import Handler.Utils.ExternalExam.Users
-  
+
 getEEGradesR, postEEGradesR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
 getEEGradesR = postEEGradesR
 postEEGradesR tid ssh coursen examn = do

src/Handler/ExamOffice/Fields.hs

@@ -11,7 +11,7 @@ import qualified Database.Esqueleto as E
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 
-  
+
 data ExamOfficeFieldMode
   = EOFNotSubscribed
   | EOFSubscribed
@@ -78,7 +78,7 @@ postEOFieldsR = do
   oldFields <- runDB $ do
     fields <- E.select . E.from $ \examOfficeField -> do
       E.where_ $ examOfficeField E.^. ExamOfficeFieldOffice E.==. E.val uid
-      return $ (examOfficeField E.^. ExamOfficeFieldField, examOfficeField E.^. ExamOfficeFieldForced)
+      return (examOfficeField E.^. ExamOfficeFieldField, examOfficeField E.^. ExamOfficeFieldForced)
     return $ toMapOf (folded .> ito (over _1 E.unValue . over _2 E.unValue)) fields
 
   ((fieldsRes, fieldsView), fieldsEnc) <- runFormPost . makeExamOfficeFieldsForm uid $ Just oldFields

src/Handler/ExamOffice/Users.hs

@@ -21,7 +21,7 @@ import qualified Data.Map as Map
 import Data.Map ((!), (!?))
 
 import qualified Data.HashSet as HashSet
-  
+
 
 instance IsInvitableJunction ExamOfficeUser where
   type InvitationFor ExamOfficeUser = User
@@ -84,11 +84,11 @@ examOfficeUserInvitationConfig = InvitationConfig{..}
       return $ SomeMessage MsgExamOfficeUserInvitationAccepted
     invitationUltDest _ _ = return $ SomeRoute NewsR
 
-  
+
 makeExamOfficeUsersForm :: Maybe (Set (Either UserEmail UserId)) -> Form (Set (Either UserEmail UserId))
 makeExamOfficeUsersForm template = renderWForm FormStandard $ do
   cRoute <- fromMaybe (error "makeExamOfficeUsersForm called from 404-handler") <$> getCurrentRoute
-  
+
   let
     miAdd' :: (Text -> Text)
            -> FieldView UniWorX
@@ -132,7 +132,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do
     return $ map Left invitations ++ map Right knownUsers'
 
   fmap Set.fromList <$> massInputAccumW miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired template'
-    
+
 
 -- | Manage the list of users this user (in her function as exam-office)
 --   has an interest in, i.e. that authorize her to view their grades

src/Handler/ExternalExam/Edit.hs

@@ -39,7 +39,7 @@ postEEEditR tid ssh coursen examn = do
       , eefOfficeSchools = schools
       , eefStaff         = staff
       }
-  
+
   ((examResult, examWidget'), examEnctype) <- runFormPost . externalExamForm $ Just template
 
   formResult examResult $ \ExternalExamForm{..} -> do
@@ -54,7 +54,7 @@ postEEEditR tid ssh coursen examn = do
         }
       when (is _Nothing replaceRes) $ do
         audit $ TransactionExternalExamEdit eeId
-        
+
         forM_ (eefStaff `setSymmDiff` staff) $ \change -> if
           | change `Set.member` eefStaff -> case change of
               Left invEmail -> do

src/Handler/ExternalExam/Form.hs

@@ -5,7 +5,7 @@ module Handler.ExternalExam.Form
 
 import Import
 import Handler.Utils
-  
+
 import Handler.ExternalExam.StaffInvite ()
 
 import qualified Data.Set as Set
@@ -104,7 +104,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
 validateExternalExam :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => FormValidator ExternalExamForm m ()
 validateExternalExam = do
   State.modify $ \eeForm -> eeForm & over _eefOfficeSchools (Set.delete $ eeForm ^. _eefSchool)
-  
+
   ExternalExamForm{..} <- State.get
 
   isAdmin <- hasWriteAccessTo $ SchoolR eefSchool SchoolEditR

src/Handler/ExternalExam/List.hs

@@ -3,7 +3,7 @@ module Handler.ExternalExam.List
   ) where
 
 import Import
-  
+
 import Handler.Utils
 
 import qualified Database.Esqueleto as E
@@ -24,7 +24,7 @@ getEExamListR = do
 
         queryEExam = $(E.sqlIJproj 2 1)
         querySchool = $(E.sqlIJproj 2 2)
-        
+
         dbtSQLQuery (eexam `E.InnerJoin` school) = do
           E.on $ eexam E.^. ExternalExamSchool E.==. school E.^. SchoolId
           let

src/Handler/ExternalExam/New.hs

@@ -32,7 +32,7 @@ postEExamNewR = do
         }
       whenIsJust insertRes $ \eeId -> do
         audit $ TransactionExternalExamEdit eeId
-        
+
         let eefOfficeSchools' = do
               externalExamOfficeSchoolSchool <- Set.toList eefOfficeSchools
               guard $ externalExamOfficeSchoolSchool /= eefSchool
@@ -41,7 +41,7 @@ postEExamNewR = do
         insertMany_ eefOfficeSchools'
         forM_ eefOfficeSchools' $ \ExternalExamOfficeSchool{..} ->
           audit $ TransactionExternalExamOfficeSchoolEdit eeId externalExamOfficeSchoolSchool
-        
+
         let (invites, adds) = partitionEithers $ Set.toList eefStaff
             eefStaff' = do
               externalExamStaffUser <- adds
@@ -50,7 +50,7 @@ postEExamNewR = do
         insertMany_ eefStaff'
         forM_ eefStaff' $ \ExternalExamStaff{..} ->
           audit $ TransactionExternalExamStaffEdit eeId externalExamStaffUser
-        
+
         sinkInvitationsF externalExamStaffInvitationConfig $ map (, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff)) invites
         forM_ invites $ \invEmail ->
           audit $ TransactionExternalExamStaffInviteEdit eeId invEmail

src/Handler/Help.hs

@@ -10,7 +10,7 @@ import qualified Data.Map as Map
 import qualified Data.Yaml as Yaml
 
 import qualified Control.Monad.State.Class as State
-  
+
 
 data HelpIdentOptions = HIUser | HIEmail | HIAnonymous
   deriving (Eq, Ord, Bounded, Enum, Show, Read)
@@ -58,7 +58,7 @@ helpForm mReferer mUid = renderWForm FormStandard $ do
     Nothing -> return $ pure Nothing
     Just err ->
       let prettyErr = decodeUtf8 $ Yaml.encode err
-       in optionalActionW 
+       in optionalActionW
             (err <$ aforced textareaField (fslI MsgHelpError) (Textarea prettyErr))
             (fslI MsgHelpSendLastError)
             (Just True)
@@ -69,7 +69,7 @@ helpForm mReferer mUid = renderWForm FormStandard $ do
     <*> hfSubject'
     <*> hfRequest'
     <*> hfError'
-    
+
 validateHelpForm :: FormValidator HelpForm Handler ()
 validateHelpForm = do
   HelpForm{..} <- State.get
@@ -99,7 +99,7 @@ postHelpR = do
 
     whenIsJust hfError $ \error' ->
       modifySessionJson SessionError $ assertM (/= error')
-    
+
     tell . pure =<< messageI Success MsgHelpSent
 
   defaultLayout $ do
@@ -111,5 +111,5 @@ postHelpR = do
           }
 
     mFaqs <- (>>= \(mWgt, truncated) -> (, truncated) <$> mWgt) <$> traverse (faqsWidget $ Just 5) (Just <$> mReferer)
-    
+
     $(widgetFile "help")

src/Handler/Info.hs

@@ -53,7 +53,7 @@ getInfoLecturerR =
     $(i18nWidgetFile "info-lecturer")
   where
     allocationInfo = $(i18nWidgetFile "allocation-info")
-    
+
     tooltipNew, tooltipProblem, tooltipPlanned, tooltipNewU2W :: WidgetFor UniWorX ()
     tooltipNew     = [whamlet| _{MsgLecturerInfoTooltipNew} |]
     tooltipProblem = [whamlet| _{MsgLecturerInfoTooltipProblem} |]
@@ -64,7 +64,7 @@ getInfoLecturerR =
     probFeatInline    = [whamlet| ^{iconTooltip tooltipProblem (Just IconProblem) True} |]  -- to be used inside text blocks
     plannedFeat       = [whamlet| ^{iconTooltip tooltipPlanned (Just IconPlanned) False} |]
     plannedFeatInline = [whamlet| ^{iconTooltip tooltipPlanned (Just IconPlanned) True} |]  -- to be used inside text blocks
-    
+
     -- new feature with given introduction date
     newFeat :: Integer -> Int -> Int -> WidgetFor UniWorX ()
     newFeat year month day = do

src/Handler/Material.hs

@@ -21,7 +21,7 @@ data MaterialForm = MaterialForm
       , mfType         :: Maybe (CI Text)
       , mfDescription  :: Maybe Html
       , mfVisibleFrom  :: Maybe UTCTime
-      , mfFiles        :: Maybe FileUploads 
+      , mfFiles        :: Maybe FileUploads
       }
 
 makeMaterialForm :: CourseId -> Maybe MaterialForm -> Form MaterialForm
@@ -135,7 +135,7 @@ getMaterialListR tid ssh csh = do
             , ( "last-edit"    , SortColumn (E.^. MaterialLastEdit)    )
             ]
       , dbtFilter    = mconcat
-        [ singletonMap "may-access" . FilterProjected $ \(Any b) dbr 
+        [ singletonMap "may-access" . FilterProjected $ \(Any b) dbr
             -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool
         ]
       , dbtFilterUI  = mempty
@@ -347,4 +347,4 @@ getMArchiveR tid ssh csh mnm = do
           return materialFile
 
   serveSomeFiles archiveName getMatQuery
-    
+

src/Handler/Metrics.hs

@@ -28,7 +28,7 @@ getMetricsR = selectRep $ do
         guardM . lift . existsBy $ UniqueUserGroupMember UserGroupMetrics uid
 
         encodeBearer =<< bearerToken (HashSet.singleton . Left $ toJSON UserGroupMetrics) (Just $ HashSet.singleton MetricsR) Nothing (Just Nothing) Nothing
-  
+
       defaultLayout $ do
         setTitleI MsgTitleMetrics
         $(widgetFile "metrics")

src/Handler/News.hs

@@ -29,7 +29,7 @@ getNewsR = do
 
     when (is _Nothing muid) $
       notificationWidget NotificationBroad Info $(i18nWidgetFile "pitch")
-  
+
     case muid of
       Just uid -> do
         newsUpcomingExams uid
@@ -51,7 +51,7 @@ newsSystemMessages = do
       mkHideForm smId SystemMessage{..} = liftHandler $ do
         cID <- encrypt smId
         hidden <- getSystemMessageState smId <&> \UserSystemMessageState{..} -> userSystemMessageHidden > Just systemMessageLastUnhide
-  
+
         (btnView, btnEnctype) <- generateFormPost . buttonForm' $ bool [BtnSystemMessageHide] [BtnSystemMessageUnhide] hidden
         return $ wrapForm btnView def
           { formSubmit = FormNoSubmit
@@ -65,7 +65,7 @@ newsSystemMessages = do
         tell $ Any hidden
 
         return $ guardOn (not hidden || showHidden) (smId, sm, trans, hidden)
-  
+
   (messages', Any anyHidden) <- liftHandler . runDB . runConduit . C.runWriterLC $
        transPipe lift (selectKeys [] [])
     .| C.filterM (hasReadAccessTo . MessageR <=< encrypt)
@@ -87,7 +87,7 @@ newsUpcomingSheets :: UserId -> Widget
 newsUpcomingSheets uid = do
   cTime <- liftIO getCurrentTime
   let noActiveToCutoff = toMidnight . addGregorianDurationRollOver (scaleCalendarDiffDays (-1) calendarMonth) $ utctDay cTime
-    
+
   let tableData :: E.LeftOuterJoin
                         (E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) (E.SqlExpr (Entity Course))) (E.SqlExpr (Entity Sheet)))
                         (E.InnerJoin (E.SqlExpr (Maybe (Entity Submission))) (E.SqlExpr (Maybe (Entity SubmissionUser))))
@@ -104,12 +104,12 @@ newsUpcomingSheets uid = do
         E.on $ course     E.^. CourseId        E.==. sheet        E.^. SheetCourse
         E.on $ course     E.^. CourseId        E.==. participant  E.^. CourseParticipantCourse
 
-        let showSheetNoActiveTo = 
+        let showSheetNoActiveTo =
                     E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetActiveFrom)
               E.||. E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetVisibleFrom)
               E.||. E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetHintFrom)
               E.||. E.maybe E.false (E.>=. E.val noActiveToCutoff) (sheet E.^. SheetSolutionFrom)
-  
+
         E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
              E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
              E.&&. E.maybe showSheetNoActiveTo (E.>=. E.val cTime) (sheet E.^. SheetActiveTo)

src/Handler/Participants.hs

@@ -35,7 +35,7 @@ instance ToNamedRecord ParticipantEntry where
 
 instance DefaultOrdered ParticipantEntry where
   headerOrder _ = Csv.header ["course", "email"]
-  
+
 
 getParticipantsListR :: Handler Html
 getParticipantsListR = do
@@ -52,10 +52,10 @@ getParticipantsListR = do
 
   schoolTerms' <- flip filterM schoolTerms'' $ \(E.Value ssh, E.Value tid) ->
     hasReadAccessTo $ ParticipantsR tid ssh
-  
+
   let schoolTerms :: Set (SchoolId, TermId)
       schoolTerms = setOf (folded . $(multifocusG 2) (_1 . _Value) (_2 . _Value)) schoolTerms'
-  
+
   siteLayoutMsg MsgMenuParticipantsList $ do
     setTitleI MsgMenuParticipantsList
 

src/Handler/Profile.hs

@@ -227,7 +227,7 @@ notificationForm template = wFormToAForm $ do
 validateSettings :: User -> FormValidator SettingsForm Handler ()
 validateSettings User{..} = do
   userDisplayName' <- use _stgDisplayName
-  
+
   guardValidation MsgUserDisplayNameInvalid $
     validDisplayName userTitle userFirstName userSurname userDisplayName'
 
@@ -812,7 +812,7 @@ postSetDisplayEmailR = do
       siteLayoutMsg MsgTitleChangeUserDisplayEmail $ do
         setTitleI MsgTitleChangeUserDisplayEmail
         $(i18nWidgetFile "set-display-email")
-  
+
 getCsvOptionsR, postCsvOptionsR :: Handler Html
 getCsvOptionsR = postCsvOptionsR
 postCsvOptionsR = do

src/Handler/School.hs

@@ -8,14 +8,14 @@ import qualified Database.Esqueleto as E
 import qualified Data.Set as Set
 import qualified Data.CaseInsensitive as CI
 import qualified Data.Text as Text
-  
+
 
 getSchoolListR :: Handler Html
 getSchoolListR = do
   let
     schoolLink :: SchoolId -> SomeRoute UniWorX
     schoolLink ssh = SomeRoute $ SchoolR ssh SchoolEditR
-    
+
     dbtSQLQuery :: E.SqlExpr (Entity School) -> E.SqlQuery _
     dbtSQLQuery = return
 
@@ -49,7 +49,7 @@ getSchoolListR = do
 
     psValidator = def
       & defaultSorting [SortAscBy "school-name"]
-    
+
 
   table <- runDB $ dbTableWidget' psValidator DBTable{..}
 
@@ -89,7 +89,7 @@ getSchoolEditR, postSchoolEditR :: SchoolId -> Handler Html
 getSchoolEditR = postSchoolEditR
 postSchoolEditR ssh = do
   sForm <- runDB $ schoolToForm ssh
-  
+
   ((sfResult, sfView), sfEnctype) <- runFormPost sForm
 
   formResult sfResult $ \SchoolForm{..} -> do

src/Handler/Sheet.hs

@@ -20,7 +20,7 @@ import Handler.Sheet.New as Handler.Sheet
 import Handler.Sheet.Show as Handler.Sheet
 import Handler.Sheet.PersonalisedFiles as Handler.Sheet (getSPersonalFilesR)
 
-  
+
 getSIsCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 -- NOTE: The route SIsCorrR is only used to verfify corrector access rights to given sheet!
 getSIsCorrR _ _ _ shn =

src/Handler/Sheet/Current.hs

@@ -6,7 +6,7 @@ module Handler.Sheet.Current
 import Import
 
 import Utils.Sheet
-  
+
 
 getSheetCurrentR :: TermId -> SchoolId -> CourseShorthand -> Handler Void
 getSheetCurrentR tid ssh csh = do

src/Handler/Sheet/Edit.hs

@@ -86,7 +86,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
               , sheetAutoDistribute = sfAutoDistribute
               , sheetAnonymousCorrection = sfAnonymousCorrection
               , sheetRequireExamRegistration = sfRequireExamRegistration
-              , sheetAllowNonPersonalisedSubmission = fromMaybe True $ spffAllowNonPersonalisedSubmission <$> sfPersonalF
+              , sheetAllowNonPersonalisedSubmission = maybe True spffAllowNonPersonalisedSubmission sfPersonalF
               }
         mbsid <- dbAction newSheet
         case mbsid of
@@ -98,7 +98,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
             insertSheetFile' sid SheetMarking  $ fromMaybe (return ()) sfMarkingF
             runConduit $
                  maybe (return ()) (transPipe liftHandler) (spffFiles =<< sfPersonalF)
-              .| sinkPersonalisedSheetFiles cid sid (fromMaybe False $ spffFilesKeepExisting <$> sfPersonalF)
+              .| sinkPersonalisedSheetFiles cid sid (maybe False spffFilesKeepExisting sfPersonalF)
             insert_ $ SheetEdit aid actTime sid
             addMessageI Success $ MsgSheetEditOk tid ssh csh sfName
             -- Sanity checks generating warnings only, but not errors!
@@ -123,11 +123,11 @@ handleSheetEdit tid ssh csh msId template dbAction = do
 
             deleteWhere [InvitationFor ==. invRef @SheetCorrector sid, InvitationEmail /<-. toListOf (folded . _1) invites]
             sinkInvitationsF correctorInvitationConfig invites
-  
+
             return True
       when saveOkay $
         redirect $ CSheetR tid ssh csh sfName SShowR -- redirect must happen outside of runDB
-    (FormFailure msgs) -> forM_ msgs $ (addMessage Error) . toHtml
+    (FormFailure msgs) -> forM_ msgs $ addMessage Error . toHtml
     _ -> runDB $ warnTermDays tid $ Map.fromList [ (date,name) | (Just date, name) <-
             [(sfVisibleFrom  =<< template, MsgSheetVisibleFrom)
             ,(sfActiveFrom   =<< template, MsgSheetActiveFrom)

src/Handler/Sheet/Form.hs

@@ -1,7 +1,7 @@
 module Handler.Sheet.Form
   ( SheetForm(..), SheetPersonalisedFilesForm(..), Loads
   , makeSheetForm
-  , getFtIdMap  
+  , getFtIdMap
   ) where
 
 import Import
@@ -97,7 +97,7 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
       <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
       <*> aopt htmlField    (fslI MsgSheetMarking) (sfMarkingText <$> template)
       <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
-      <*> correctorForm (fromMaybe mempty $ sfCorrectors <$> template)
+      <*> correctorForm (maybe mempty sfCorrectors template)
   where
     makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm)
     makeSheetPersonalisedFilesForm template' = do
@@ -143,10 +143,10 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
     validateSheet = do
       SheetForm{..} <- State.get
 
-      guardValidation MsgSheetErrVisibility    $ NTop sfVisibleFrom  <= NTop sfActiveFrom   
+      guardValidation MsgSheetErrVisibility    $ NTop sfVisibleFrom  <= NTop sfActiveFrom
-      guardValidation MsgSheetErrDeadlineEarly $ NTop sfActiveFrom   <= NTop sfActiveTo   
+      guardValidation MsgSheetErrDeadlineEarly $ NTop sfActiveFrom   <= NTop sfActiveTo
-      guardValidation MsgSheetErrHintEarly     $ NTop sfHintFrom     >= NTop sfActiveFrom       
+      guardValidation MsgSheetErrHintEarly     $ NTop sfHintFrom     >= NTop sfActiveFrom
-      guardValidation MsgSheetErrSolutionEarly $ NTop sfSolutionFrom >= NTop sfActiveTo 
+      guardValidation MsgSheetErrSolutionEarly $ NTop sfSolutionFrom >= NTop sfActiveTo
 
       guardValidation MsgSheetErrVisibleWithoutActive $ is _Just sfActiveFrom || is _Nothing sfVisibleFrom
 
@@ -162,7 +162,7 @@ correctorForm loads' = wFormToAForm $ do
     loads :: Map (Either UserEmail UserId) (CorrectorState, Load)
     loads = loads' <&> \(InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector) -> (cState, load)
 
-  countTutRes <- wpopt checkBoxField (fslI MsgCountTutProp & setTooltip MsgCountTutPropTip) . Just . any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads
+  countTutRes <- wpopt checkBoxField (fslI MsgCountTutProp & setTooltip MsgCountTutPropTip) . Just . any (\(_, Load{..}) -> Just True == byTutorial) $ Map.elems loads
 
 
   let
@@ -173,7 +173,7 @@ correctorForm loads' = wFormToAForm $ do
       E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
       E.on $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
       E.where_ $ lecturer E.^. LecturerUser E.==. E.val userId
-      E.orderBy $ [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
+      E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
       return user
 
     miAdd :: ListPosition
@@ -199,7 +199,7 @@ correctorForm loads' = wFormToAForm $ do
     miCell _ userIdent initRes nudge csrf = do
       (stateRes, stateView) <- mreq (selectField optionsFinite) (fslI MsgSheetCorrectorState & addName (nudge "state")) $ (fst <$> initRes) <|> Just CorrectorNormal
       (byTutRes, byTutView) <- mreq checkBoxField ("" & addName (nudge "bytut")) $ (isJust . byTutorial . snd <$> initRes) <|> Just False
-      (propRes, propView) <- mreq (checkBool (>= 0) MsgProportionNegative $ rationalField) (fslI MsgSheetCorrectorProportion & addName (nudge "prop")) $ (byProportion . snd <$> initRes) <|> Just 0
+      (propRes, propView) <- mreq (checkBool (>= 0) MsgProportionNegative rationalField) (fslI MsgSheetCorrectorProportion & addName (nudge "prop")) $ (byProportion . snd <$> initRes) <|> Just 0
       let
         res :: FormResult (CorrectorState, Load)
         res = (,) <$> stateRes <*> (Load <$> tutRes' <*> propRes)
@@ -251,7 +251,7 @@ correctorForm loads' = wFormToAForm $ do
 
     postProcess :: Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)) -> Loads
     postProcess = Map.fromList . map postProcess' . Map.elems
-      where 
+      where
         postProcess' :: (Either UserEmail UserId, (CorrectorState, Load)) -> (Either UserEmail UserId, (InvitationDBData SheetCorrector, InvitationTokenData SheetCorrector))
         postProcess' = over _2 $ \(cState, load) -> (InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector)
 

src/Handler/Sheet/List.hs

@@ -69,14 +69,14 @@ getSheetListR tid ssh csh = do
       , sortable Nothing (i18nCell MsgSubmission)
           $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub, _)} -> case mbSub of
               Nothing -> mempty
-              (Just (Entity sid Submission{..})) ->
+              (Just (Entity sid Submission{})) ->
                 let mkCid = encrypt sid -- TODO: executed twice
                     mkRoute = do
                       cid' <- mkCid
                       return $ CSubmissionR tid ssh csh sheetName cid' SubShowR
                 in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{cid2}|])
       , sortable (Just "rating") (i18nCell MsgRating)
-          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub,_)} -> 
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub,_)} ->
             let stats = sheetTypeSum sheetType in -- for statistics over all shown rows
             case mbSub of
               Nothing -> cellTell mempty $ stats Nothing

src/Handler/StorageKey.hs

@@ -11,6 +11,8 @@ import qualified Data.ByteString.Base64 as Base64 (encode, decodeLenient)
 import qualified Data.Binary as Binary (encode)
 import qualified Crypto.KDF.HKDF as HKDF
 
+{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
+
 
 data StorageKeyType
   = SKTExamCorrect
@@ -64,7 +66,7 @@ postStorageKeyR = do
     timestamp = if
       | Just ts <- skReqTimestamp, timestampInBounds -> ts
       | otherwise -> now
-  
+
   salt <- let sltSize = hashDigestSize SHA3_256 in if
     | Just slt <- Base64.decodeLenient . encodeUtf8 <$> skReqSalt
     , timestampInBounds

src/Handler/Submission.hs

@@ -30,7 +30,7 @@ import Import
 
 import qualified Database.Esqueleto as E
 
-  
+
 getSubmissionOwnR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 -- For security reasons (unauthorized users not being allowed to have
 -- guesses about which sheets/courses exist confirmed) this handlers

src/Handler/Submission/Assign.hs

@@ -3,7 +3,7 @@ module Handler.Submission.Assign
   , getCAssignR, postCAssignR
   , getSAssignR, postSAssignR
   ) where
- 
+
 import Import hiding (link, unzip)
 
 import Handler.Utils hiding (colSchool)
@@ -74,7 +74,7 @@ postSAssignR tid ssh csh shn = do
 assignHandler :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
 assignHandler tid ssh csh cid assignSids = do
   currentRoute <- fromMaybe (error "assignHandler called from 404-handler") <$> liftHandler getCurrentRoute
-  
+
   -- gather data
   (orderedSheetNames, assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment, ((btnViews, btnCsrf), btnEncoding)) <- runDB $ do
       -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
@@ -97,7 +97,7 @@ assignHandler tid ssh csh cid assignSids = do
           assignSheetNames' = sheetName <$> mapMaybe (`Map.lookup` sheets) assignSids'
 
           assignButtons = Map.fromSet (maybe BtnSubmissionsAssignAll BtnSubmissionsAssign) $ Set.fromList . bool (Nothing :) id (null sheetList) $ map Just assignSheetNames'
-      
+
       ((btnResult, btnViews'), btnEncoding) <- runFormPost . identifyForm FIDAssignSubmissions $ \csrf ->
         fmap (over _1 (asum . fmap (hoistMaybe =<<)) . over _2 (, csrf) . unzip) . for assignButtons $ \btn -> mopt (buttonField btn) "" Nothing
 
@@ -132,7 +132,7 @@ assignHandler tid ssh csh cid assignSids = do
                  | otherwise -> do
                      addMessageI Error $ MsgSheetsUnassignable $ CI.original shn
                      return Nothing
-            if | null sub_ok && null sub_fail -> 
+            if | null sub_ok && null sub_fail ->
                    return $ Map.insert shn (status, countMapElems plan, deficit) acc
                | otherwise -> do
                    (plan', deficit') <- lift $ handle ignoreExceptions $ planSubmissions sid Nothing
@@ -280,7 +280,7 @@ assignHandler tid ssh csh cid assignSids = do
 
     doWrap $(widgetFile "corrections-overview")
 
-  
+
 data ButtonSubmissionsAssign
   = BtnSubmissionsAssign SheetName
   | BtnSubmissionsAssignAll

src/Handler/Submission/Correction.hs

@@ -51,7 +51,7 @@ postCorrectionR tid ssh csh shn cid = do
   MsgRenderer mr <- getMsgRenderer
   case results of
     [(Entity cId Course{..}, Entity shId Sheet{..}, Entity _ subm@Submission{..}, corrector, E.Value filesCorrected)] -> do
-      let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
+      let ratingComment = submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) . Text.strip
           pointsForm = case sheetType of
             NotGraded
               -> pure Nothing
@@ -67,7 +67,7 @@ postCorrectionR tid ssh csh shn cid = do
             | not isLecturer = wFormToAForm $ pure . Just <$> requireAuthId
             | otherwise = wFormToAForm $ do
                 let correctors = E.from $ \user -> do
-                      let isCorrector = E.exists . E.from $ \sheetCorrector -> 
+                      let isCorrector = E.exists . E.from $ \sheetCorrector ->
                             E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
                                  E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. E.val shId
                           isLecturer'  = E.exists . E.from $ \lecturer ->
@@ -151,7 +151,7 @@ postCorrectionR tid ssh csh shn cid = do
 
 getCorrectionUserR tid ssh csh shn cid = do
 
-  
+
   sub <- decrypt cid
 
   results <- runDB $ correctionData tid ssh csh shn sub

src/Handler/Submission/Helper.hs

@@ -104,9 +104,9 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
     submittorsForm' = maybeT submittorsForm $ do
       restr <- MaybeT (maybeCurrentBearerRestrictions @Value) >>= hoistMaybe . preview (_Object . ix "submittors" . _Array)
       let _Submittor = prism (either toJSON toJSON) $ \x -> first (const x) $ JSON.parseEither (\x' -> fmap Right (parseJSON x') <|> fmap Left (parseJSON x')) x
-      submittors <- fmap (pure @FormResult @([Either UserEmail CryptoUUIDUser])) . forM (toList restr) $ hoistMaybe . preview _Submittor
+      submittors <- fmap (pure @FormResult @[Either UserEmail CryptoUUIDUser]) . forM (toList restr) $ hoistMaybe . preview _Submittor
       fmap Set.fromList <$> forMOf (traverse . traverse . _Right) submittors decrypt
-      
+
 
     submittorsForm
       | isLecturer = do -- Form is being used by lecturer; allow Everything™
@@ -165,7 +165,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
             guard $ Map.size dat > 1
 
             -- User may drop from submission only if it already exists; no directly creating submissions for other people
-            guard $ maybe True (/= Right uid) (dat !? delPos) || isJust msmid
+            guard $ Just (Right uid) /= dat !? delPos || isJust msmid
 
             miDeleteList dat delPos
 
@@ -304,7 +304,7 @@ submissionHelper tid ssh csh shn mcid = do
                 return (userName, submissionEdit E.^. SubmissionEditTime)
               forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
 
-          corrector <- fmap join $ traverse getEntity submissionRatingBy
+          corrector <- join <$> traverse getEntity submissionRatingBy
 
           return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner,Just sub,corrector)
 
@@ -336,9 +336,9 @@ submissionHelper tid ssh csh shn mcid = do
     when (    is _Nothing muid
            && is _Nothing msubmission
            && not isLecturer
-         ) 
+         )
       notAuthenticated
-    
+
     -- Determine old submission users
     subUsersOld <- if
       | Just smid <- msmid -> Set.union
@@ -411,7 +411,7 @@ submissionHelper tid ssh csh shn mcid = do
                   }
                 audit $ TransactionSubmissionEdit sid shid
                 return sid
-          
+
           -- Determine new submission users
           subUsers <- if
             | isLecturer -> return adhocMembers
@@ -461,7 +461,7 @@ submissionHelper tid ssh csh shn mcid = do
                 audit $ TransactionSubmissionUserDelete smid subUid
                 unless (Just subUid == muid) $
                   queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid
-          
+
           addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated
                                    | otherwise        -> MsgSubmissionUpdated
           return smid
@@ -558,7 +558,7 @@ submissionHelper tid ssh csh shn mcid = do
             courseSchool = ssh
             courseShorthand = csh
          in $(widgetFile "correction-user")
-        
+
 
   defaultLayout $ do
     setTitleI $ MsgSubmissionEditHead tid ssh csh shn

src/Handler/Submission/List.hs

@@ -122,7 +122,7 @@ colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnad
 colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(_, _, _, _, _, _, cid, _) } -> return cid
 
 colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, course, _, _, users, _, hasAccess) } ->
+colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users, _, hasAccess) } ->
   let
     csh = course ^. _2
     tid = course ^. _3
@@ -136,8 +136,8 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB
         | otherwise -> mempty
 
 colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSMatrikel = sortable (Just "submittors-matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, (_, csh, tid, ssh), _, _, users, _, hasAccess) } ->
+colSMatrikel = sortable (Just "submittors-matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, (_, csh, tid, ssh), _, _, users, _, hasAccess) } ->
-  let protoCell = listCell (Map.toList $ Map.mapMaybe (\x@(User{..}, _, _) -> (x,) <$> assertM (not . null) userMatrikelnummer) users) $ \(userId, ((User{..}, _, _), matr)) -> anchorCellCM $cacheIdentHere (CourseR tid ssh csh . CUserR <$> encrypt userId) matr 
+  let protoCell = listCell (Map.toList $ Map.mapMaybe (\x@(User{userMatrikelnummer}, _, _) -> (x,) <$> assertM (not . null) userMatrikelnummer) users) $ \(userId, (_, matr)) -> anchorCellCM $cacheIdentHere (CourseR tid ssh csh . CUserR <$> encrypt userId) matr 
   in if | hasAccess -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
         | otherwise -> mempty
 
@@ -193,7 +193,7 @@ colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (
 colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id
   (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
   (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _, _, _) } mkUnique -> case sheetType of
-      NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
+      NotGraded -> pure $ over (_1.mapped) (_2 .~) (FormSuccess Nothing, mempty)
       _other -> over (_1.mapped) (_2 .~) . over _2 fvWidget <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints)
   )
 
@@ -201,7 +201,7 @@ colMaxPointsField :: _ => Colonnade Sortable CorrectionTableData (DBCell m (Form
 colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nCell . (\DBRow{ dbrOutput=(_, Entity _ Sheet{sheetType}, _, _, _, _, _, _) } -> sheetType)
 
 colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
-colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ fmap (cellAttrs <>~ [("style","width:60%")]) $ formCell id
+colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id
   (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
   (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
 
@@ -398,11 +398,11 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams
         , FilterProjected $ \(DBRow{..} :: CorrectionTableData) (criteria :: Set Text) ->
             let cid = map CI.mk . unpack . toPathPiece $ dbrOutput ^. _7
                 criteria' = map CI.mk . unpack <$> Set.toList criteria
-             in any (\c -> c `isInfixOf` cid) criteria'
+             in any (`isInfixOf` cid) criteria'
         )
       ]
     , dbtFilterUI  = fromMaybe mempty dbtFilterUI
-    , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
+    , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (const defaultDBSFilterLayout) dbtFilterUI }
     , dbtParams
     , dbtIdent     = "corrections" :: Text
     , dbtCsvEncode = noCsvEncode
@@ -465,8 +465,8 @@ correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
     -- let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary
     -- return (tableRes, statistics)
 
-  let actionRes = actionRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False)
+  let actionRes = actionRes' <&> _2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False)
-                             & mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast
+                             <&> _1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast
       auditAllSubEdit = mapM_ $ \sId -> getJust sId >>= \sub -> audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet
 
   formResult actionRes $ \case
@@ -610,7 +610,7 @@ assignAction selId = ( CorrSetCorrector
 
                            E.where_ $ either (\cId -> course E.^. CourseId E.==. E.val cId) (\shId -> sheet E.^. SheetId E.==. E.val shId) selId
 
-                           E.orderBy $ [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
+                           E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
 
                            E.distinct $ return user
 

src/Handler/Submission/SubmissionUserInvite.hs

@@ -15,7 +15,7 @@ import Text.Hamlet (ihamlet)
 
 import qualified Data.HashSet as HashSet
 
-  
+
 instance IsInvitableJunction SubmissionUser where
   type InvitationFor SubmissionUser = Submission
   data InvitableJunction SubmissionUser = JunctionSubmissionUser

src/Handler/Submission/Upload.hs

@@ -31,7 +31,7 @@ explainSubmissionDoneMode SubmissionDoneNever  = return $(i18nWidgetFile "submis
 explainSubmissionDoneMode SubmissionDoneAlways = return $(i18nWidgetFile "submission-done-tip/always")
 explainSubmissionDoneMode SubmissionDoneByFile = return $(i18nWidgetFile "submission-done-tip/by-file")
 
-  
+
 getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
 getCorrectionsUploadR = postCorrectionsUploadR
 postCorrectionsUploadR = do

src/Handler/SystemMessage.hs

@@ -57,9 +57,8 @@ postMessageR cID = do
         runFormPost . identifyForm (FIDSystemMessageModifyTranslation $ ciphertext cID') . renderAForm FormStandard
           $ (,)
           <$> fmap (Entity tId)
-              ( SystemMessageTranslation
+              ( SystemMessageTranslation systemMessageTranslationMessage
-                  <$> pure systemMessageTranslationMessage
+                  <$> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageTranslationLanguage)
-                  <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageTranslationLanguage)
                   <*> areq htmlField (fslI MsgSystemMessageContent) (Just systemMessageTranslationContent)
                   <*> aopt htmlField (fslI MsgSystemMessageSummary) (Just systemMessageTranslationSummary)
               )
@@ -71,9 +70,8 @@ postMessageR cID = do
             & filter (\l -> none (`langMatches` l) $ Map.keys ts')
 
       ((addTransRes, addTransView), addTransEnctype) <- runFormPost . identifyForm FIDSystemMessageAddTranslation . renderAForm FormStandard
-        $ SystemMessageTranslation
+        $ SystemMessageTranslation smId
-          <$> pure smId
+          <$> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (listToMaybe nextLang)
-          <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (listToMaybe nextLang)
           <*> areq htmlField (fslI MsgSystemMessageContent) Nothing
           <*> aopt htmlField (fslI MsgSystemMessageSummary) Nothing
 

src/Handler/Term.hs

@@ -44,13 +44,13 @@ guessDay tid@TermIdentifier{ year, season = Winter } TermDayLectureStart
 guessDay tid@TermIdentifier{ year, season = Winter } TermDayLectureEnd
   = fromWeekDate (succ year) ((wWeekStart + 21) `div` bool 53 54 longYear) 5
   where longYear = is _Just $ fromWeekDateValid year 53 1
-        (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart 
+        (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart
 guessDay tid@TermIdentifier{ year, season = Summer } TermDayLectureStart
   = fromWeekDate year (wWeekStart + 2) 1
-  where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart 
+  where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart
 guessDay tid@TermIdentifier{ year, season = Summer } TermDayLectureEnd
   = fromWeekDate year (wWeekStart + 17) 5
-  where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart 
+  where (_, wWeekStart, _) = toWeekDate $ guessDay tid TermDayStart
 
 
 validateTerm :: (MonadHandler m, HandlerSite m ~ UniWorX)