chore: bump to lts-15.0

BREAKING CHANGE: major version bumps

.gitlab-ci.yml

@@ -1,6 +1,6 @@
 default:
   image:
-    name: fpco/stack-build:lts-13.21
+    name: fpco/stack-build:lts-15.0
   cache:
     paths:
       - node_modules

.hlint.yaml

@@ -5,6 +5,7 @@
   - ignore: { name: "Parse error" }
   - ignore: { name: "Reduce duplication" }
   - ignore: { name: "Redundant lambda" }
+  - ignore: { name: "Redundant multi-way if" }
   - ignore: { name: "Use ||" }
   - ignore: { name: "Use &&" }
   - ignore: { name: "Use ++" }

ghci.sh

@@ -20,4 +20,4 @@ if [[ -d .stack-work-ghci ]]; then
     trap move-back EXIT
 fi
 
-stack ghci --flag uniworx:dev --flag uniworx:library-only --ghci-options -fobject-code ${@:-uniworx:lib}
+stack ghci --flag uniworx:dev --flag uniworx:library-only --ghci-options ${@:-uniworx:lib}

package.yaml

@@ -120,7 +120,6 @@ dependencies:
   - lens-aeson
   - systemd
   - streaming-commons
-  - hourglass
   - unix
   - stm-delay
   - cassava
@@ -201,6 +200,8 @@ ghc-options:
   - -Wall
   - -Wmissing-home-modules
   - -Wredundant-constraints
+  - -Widentities
+  - -Wincomplete-uni-patterns
   - -fno-warn-type-defaults
   - -fno-warn-unrecognised-pragmas
   - -fno-warn-partial-type-signatures

src/Application.hs

@@ -86,8 +86,6 @@ import Control.Monad.Trans.Cont (runContT, callCC)
 
 import qualified Data.Set as Set
 
-import Data.Semigroup (Min(..))
-
 import Handler.Utils.Routes (classifyHandler)
 
 -- Import all relevant handler modules here.
@@ -511,6 +509,8 @@ shutdownApp app = do
     destroyAllResources $ appConnPool app
   release . fst $ appLogger app
 
+  liftIO $ threadDelay 2e4
+
 
 ---------------------------------------------
 -- Functions for use in development with GHCi

src/Auth/Dummy.hs

@@ -8,7 +8,6 @@ import Database.Persist.Sql (SqlBackendCanRead)
 
 import Utils.Form
 
-import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
 
@@ -22,7 +21,6 @@ dummyForm :: ( RenderMessage (HandlerSite m) FormMessage
              , RenderMessage (HandlerSite m) DummyMessage
              , YesodPersist (HandlerSite m)
              , SqlBackendCanRead (YesodPersistBackend (HandlerSite m))
-             , Button (HandlerSite m) ButtonSubmit
              , MonadHandler m
              ) => AForm m (CI Text)
 dummyForm = wFormToAForm $ do

src/Auth/LDAP.hs

@@ -14,14 +14,12 @@ module Auth.LDAP
 import Import.NoFoundation
 import Network.Connection
 
-import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
 import qualified Control.Monad.Catch as Exc
 
 import Utils.Form
 
-import Ldap.Client (Ldap)
 import qualified Ldap.Client as Ldap
 
 import qualified Data.Text.Encoding as Text

src/Auth/PWHash.hs

@@ -8,7 +8,6 @@ import Database.Persist.Sql (SqlBackendCanRead)
 
 import Utils.Form
 
-import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
 import Yesod.Auth.Util.PasswordStore (verifyPasswordWith)

src/Cron.hs

@@ -296,20 +296,21 @@ nextCronMatch tz mPrev prec now c@Cron{..} = onlyOnceWithinPrec $ case notAfter
                <*> genMatch 60 True True cdMinute cronMinute
                <*> genMatch 60 True True cdSecond cronSecond
 
-        let toGregorian' = over _1 fromIntegral . over _2 fromIntegral . over _3 fromIntegral . toGregorian
+        let toGregorian' :: Day -> (Natural, Natural, Natural)
+            toGregorian' = over _1 fromIntegral . over _2 fromIntegral . over _3 fromIntegral . toGregorian
         (mCronYear, mCronMonth, mCronDayOfMonth) <- if
             | Just (year, month, dayOfMonth) <- mCronGregorianDate
               -> return (year, month, dayOfMonth)
-            | Just (weekYear, week, dayOfWeek) <- mCronWeekDate
+            | Just (weekYear, week, dow) <- mCronWeekDate
-              -> return . toGregorian' $ fromWeekDate (fromIntegral weekYear) (fromIntegral week) (fromIntegral dayOfWeek)
+              -> return . toGregorian' $ fromWeekDate (fromIntegral weekYear) (fromIntegral week) (fromIntegral dow)
             | Just (year, dayOfYear) <- mCronOrdinalDate
               -> maybeToList . fmap toGregorian' $ fromOrdinalDateValid (fromIntegral year) (fromIntegral dayOfYear)
-            | Just (weekYear, month, weekOfMonth, dayOfWeek) <- mCronWeekOfMonthDate
+            | Just (weekYear, month, weekOfMonth, dow) <- mCronWeekOfMonthDate
               -> do
                    year <- genMatch 400 False True cdYear cronYear
                    day <- genMatch 31 True False cdDayOfMonth cronDayOfMonth
                    jDay <- maybeToList $ fromGregorianValid (fromIntegral year) (fromIntegral month) (fromIntegral day)
-                   guard $ consistentCronDate (toCronDate localRef{ localDay = jDay }) { cdWeekYear = weekYear, cdMonth = month, cdWeekOfMonth = weekOfMonth, cdDayOfWeek = dayOfWeek }
+                   guard $ consistentCronDate (toCronDate localRef{ localDay = jDay }) { cdWeekYear = weekYear, cdMonth = month, cdWeekOfMonth = weekOfMonth, cdDayOfWeek = dow }
                    return (year, month, day)
             | otherwise
               -> fmap toGregorian' [localDay localRef, succ $ localDay localRef]
@@ -329,8 +330,8 @@ nextCronMatch tz mPrev prec now c@Cron{..} = onlyOnceWithinPrec $ case notAfter
               -> return . over _1 fromIntegral . over _2 fromIntegral . over _3 fromIntegral $ toWeekDate julDay
 
         mCronWeekOfMonth <- if
-            | Just (weekYear, month, weekOfMonth, dayOfWeek) <- mCronWeekOfMonthDate
+            | Just (weekYear, month, weekOfMonth, dow) <- mCronWeekOfMonthDate
-              -> weekOfMonth <$ guard (weekYear == mCronWeekYear && month == mCronMonth && dayOfWeek == mCronDayOfWeek)
+              -> weekOfMonth <$ guard (weekYear == mCronWeekYear && month == mCronMonth && dow == mCronDayOfWeek)
             | otherwise
               -> genMatch 5 True False cdWeekOfMonth cronWeekOfMonth
 

src/Cron/Types.hs

@@ -15,7 +15,6 @@ import Data.Time
 
 import Numeric.Natural
 
-import Data.HashMap.Strict (HashMap)
 import qualified Data.Set as Set
   
 

src/Crypto/Hash/Instances.hs

@@ -11,15 +11,12 @@ import Database.Persist
 import Database.Persist.Sql
 
 import Data.ByteArray (convert)
-import Data.ByteArray.Encoding
-
-import qualified Data.ByteString.Char8 as CBS
 
 import Web.PathPieces
 import Web.HttpApiData
 import Data.Aeson as Aeson
 
-import Text.Read as Read
+import Control.Monad.Fail
 
 
 instance HashAlgorithm hash => PersistField (Digest hash) where
@@ -31,12 +28,6 @@ instance HashAlgorithm hash => PersistField (Digest hash) where
 instance HashAlgorithm hash => PersistFieldSql (Digest hash) where
   sqlType _ = SqlBlob 
 
-instance HashAlgorithm hash => Read (Digest hash) where
-  readPrec = do
-    str <- replicateM (2 * hashDigestSize (error "Value of type hash forced" :: hash)) Read.get
-    bs <- either fail return . convertFromBase Base16 $ CBS.pack str
-    maybe (fail "Could not convert digestFromByteString") return $ digestFromByteString (bs :: ByteString)
-
 instance HashAlgorithm hash => PathPiece (Digest hash) where
   toPathPiece = showToPathPiece
   fromPathPiece = readFromPathPiece

src/CryptoID.hs

@@ -21,10 +21,9 @@ import System.FilePath.Cryptographic.ImplicitNamespace
 
 import qualified Data.Text as Text
 
-import           Data.CaseInsensitive   (CI)
 import qualified Data.CaseInsensitive as CI
 
-import Data.Aeson (ToJSON(..), ToJSONKey(..), ToJSONKeyFunction(..), FromJSON(..), FromJSONKey(..), FromJSONKeyFunction(..), Value(..), withText)
+import Data.Aeson (withText)
 import Data.Aeson.Encoding (text)
 
 import Text.Blaze (ToMarkup(..))

src/CryptoID/TH.hs

@@ -9,7 +9,6 @@ import Data.UUID.Types (UUID)
 import Data.Binary.SerializationLength
 
 import Data.CaseInsensitive (CI)
-import System.FilePath (FilePath)
 
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary

src/Data/Aeson/Types/Instances.hs

@@ -16,6 +16,8 @@ import Data.Vector.Instances ()
 
 import Model.Types.TH.JSON (derivePersistFieldJSON)
 
+import Control.Monad.Fail
+
 
 instance MonadThrow Parser where
   throwM = fail . show

src/Data/Bool/Instances.hs

@@ -12,6 +12,8 @@ import Data.CaseInsensitive.Instances ()
 
 import qualified Data.Text as Text
 
+import Control.Monad.Fail
+
 
 instance Csv.ToField Bool where
   toField True = "t"

src/Data/CaseInsensitive/Instances.hs

@@ -16,12 +16,11 @@ import Database.Persist.Sql
 import Text.Blaze (ToMarkup(..))
 import Text.Shakespeare.Text (ToText(..))
 
-import Data.Text (Text)
 import qualified Data.Text.Encoding as Text
 
 import Language.Haskell.TH.Syntax (Lift(..))
 
-import Data.Aeson (ToJSON(..), FromJSON(..), ToJSONKey(..), FromJSONKey(..), ToJSONKeyFunction(..))
+import Data.Aeson (ToJSONKey(..), FromJSONKey(..), ToJSONKeyFunction(..))
 
 import qualified Database.Esqueleto as E
 

src/Data/Encoding/Instances.hs

@@ -6,13 +6,14 @@ module Data.Encoding.Instances
 
 import ClassyPrelude
 import Utils.PathPiece
-import Data.String (IsString(..))
 import Text.Read
 
 import Web.PathPieces
 
 import Data.Encoding
 
+import Control.Monad.Fail
+
 
 instance PathPiece DynEncoding where
   toPathPiece = showToPathPiece

src/Data/HashMap/Strict/Instances.hs

@@ -7,7 +7,6 @@ module Data.HashMap.Strict.Instances
 import ClassyPrelude
 
 import Data.Binary (Binary(..))
-import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 
 

src/Data/HashSet/Instances.hs

@@ -6,7 +6,6 @@ module Data.HashSet.Instances
 
 import ClassyPrelude
 
-import Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
 
 import Data.Binary (Binary(..))

src/Data/NonNull/Instances.hs

@@ -11,6 +11,8 @@ import Data.Aeson
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary
 
+import Control.Monad.Fail
+
 
 instance ToJSON a => ToJSON (NonNull a) where
   toJSON = toJSON . toNullable

src/Data/Set/Instances.hs

@@ -6,7 +6,6 @@ module Data.Set.Instances
 
 import ClassyPrelude
 
-import Data.Set (Set)
 import qualified Data.Set as Set
 
 

src/Data/Time/Calendar/Instances.hs

@@ -7,12 +7,16 @@ module Data.Time.Calendar.Instances
 
 import ClassyPrelude
 import Data.Binary (Binary)
-import qualified Data.Binary as Binary
+
+import Data.Time.Calendar
+
+import Data.Universe
 
 
 deriving newtype instance Hashable Day
+deriving newtype instance Binary Day
 
-instance Binary Day where
+deriving instance Ord DayOfWeek
-  get = ModifiedJulianDay <$> Binary.get
+instance Universe DayOfWeek where
-  put = Binary.put . toModifiedJulianDay
+  universe = [Monday .. Sunday]
-
+instance Finite DayOfWeek

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

@@ -15,6 +15,8 @@ import Data.HashMap.Strict ((!))
 
 import Data.Universe
 
+import Control.Monad.Fail
+
 
 instance (Eq a, Hashable a, Finite a, ToJSON b, ToJSONKey a) => ToJSON (a -> b) where
   toJSON f = toJSON $ HashMap.fromList [(k, f k) | k <- universeF]

src/Data/Universe/TH.hs

@@ -17,12 +17,21 @@ import Control.Monad (unless)
 import Data.List (elemIndex)
 
 
+-- | Get type var bind name
+--
+-- Stolen from https://hackage.haskell.org/package/template-haskell-util-0.1.1.0
+getTVBName :: TyVarBndr -> Name
+getTVBName (PlainTV  name  ) = name
+getTVBName (KindedTV name _) = name
+  
+
+
 finiteEnum :: Name -> DecsQ
 -- ^ Declare generic `Enum`- and `Bounded`-Instances given `Finite`- and `Eq`-Instances
 finiteEnum tName = do
   DatatypeInfo{..} <- reifyDatatype tName
 
-  let datatype = foldl appT (conT datatypeName) $ map pure datatypeVars
+  let datatype = foldl appT (conT datatypeName) $ map (varT . getTVBName) datatypeVars
       tUniverse = [e|universeF :: [$(datatype)]|]
   
   [d|
@@ -48,14 +57,14 @@ deriveFinite tName = fmap concat . sequence $
   [ deriveUniverse' [e|concat|] [e|universeF|] tName
   , do
       DatatypeInfo{..} <- reifyDatatype tName
-      [d|instance Finite $(foldl appT (conT datatypeName) $ map pure datatypeVars)|]
+      [d|instance Finite $(foldl appT (conT datatypeName) $ map (varT . getTVBName) datatypeVars)|]
   ]
 
 deriveUniverse' :: ExpQ -> ExpQ -> Name -> DecsQ
 deriveUniverse' interleaveExp universeExp tName = do
   DatatypeInfo{..} <- reifyDatatype tName
 
-  let datatype = foldl appT (conT datatypeName) $ map pure datatypeVars
+  let datatype = foldl appT (conT datatypeName) $ map (varT . getTVBName) datatypeVars
       consUniverse ConstructorInfo{..} = do
         unless (null constructorVars) $
           fail "Constructors with variables no supported"

src/Data/Vector/Instances.hs

@@ -6,7 +6,6 @@ module Data.Vector.Instances
 
 import ClassyPrelude
 
-import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 
 import Data.Binary (Binary)

src/Database/Persist/Class/Instances.hs

@@ -8,7 +8,6 @@ module Database.Persist.Class.Instances
 import ClassyPrelude
 
 import Database.Persist.Class
-import Database.Persist.Types (HaskellName, DBName, PersistValue)
 import Database.Persist.Types.Instances ()
 import Database.Persist.Sql
 
@@ -19,6 +18,8 @@ import qualified Data.Map as Map
 
 import Data.Aeson (ToJSONKey, FromJSONKey)
 
+import Control.Monad.Fail
+
 
 instance PersistEntity record => Hashable (Key record) where
   hashWithSalt s = hashWithSalt s . toPersistValue

src/Foundation.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedLabels #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- MonadCrypto
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-incomplete-uni-patterns #-} -- MonadCrypto
 
 module Foundation
   ( module Foundation
@@ -29,43 +29,36 @@ import qualified Yesod.Core.Unsafe as Unsafe
 import qualified Data.CaseInsensitive as CI
 
 import Data.ByteArray (convert)
-import Crypto.Hash (Digest, SHAKE256, SHAKE128)
+import Crypto.Hash (SHAKE256, SHAKE128)
 import Crypto.Hash.Conduit (sinkHash)
 import qualified Data.UUID as UUID
 import qualified Data.Binary as Binary
 
 import qualified Data.ByteString.Base64.URL as Base64 (encode)
 
-import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as Lazy.ByteString
 import qualified Data.ByteString as ByteString
 
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 
-import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Map (Map, (!?))
+import Data.Map ((!?))
 import qualified Data.Map as Map
 import qualified Data.HashSet as HashSet
 import qualified Data.List.NonEmpty as NonEmpty
 
-import Data.List (nubBy, (!!), findIndex, inits)
+import Data.List ((!!), findIndex, inits)
 import qualified Data.List as List
 
 import Web.Cookie
 
-import Data.Monoid (Any(..))
-
 import Data.Conduit.List (sourceList)
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 
 import Control.Monad.Except (MonadError(..), ExceptT)
-import Control.Monad.Trans.Maybe (MaybeT(..))
-import Control.Monad.Trans.Reader (runReader, mapReaderT)
-import Control.Monad.Trans.Writer (WriterT(..), runWriterT)
 import Control.Monad.Trans.State (execStateT)
 import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Memo.Class (MonadMemo(..), for4)
@@ -82,7 +75,6 @@ import Utils.Form
 import Utils.Sheet
 import Utils.SystemMessage
 
-import Text.Shakespeare.Text (st)
 import Text.Cassius (cassiusFile)
 
 import Yesod.Form.I18n.German
@@ -1121,12 +1113,12 @@ tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
   CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do
     cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
     Entity tutId Tutorial{..} <- $cachedHereBinary (cid, tutn) . MaybeT . getBy $ UniqueTutorial cid tutn
-    registered <- $cachedHereBinary tutId . lift $ fromIntegral <$> count [ TutorialParticipantTutorial ==. tutId ]
+    registered <- $cachedHereBinary tutId . lift $ count [ TutorialParticipantTutorial ==. tutId ]
     guard $ NTop tutorialCapacity > NTop (Just registered)
     return Authorized
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
     Entity cid Course{..} <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
-    registered <- $cachedHereBinary cid . lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
+    registered <- $cachedHereBinary cid . lift $ count [ CourseParticipantCourse ==. cid ]
     guard $ NTop courseCapacity > NTop (Just registered)
     return Authorized
   r -> $unsupportedAuthPredicate AuthCapacity r
@@ -1298,7 +1290,7 @@ routeAuthTags = fmap (PredDNF . Set.mapMonotonic impureNonNull) . ofoldM partiti
       | otherwise
         = Left $ InvalidAuthTag t
 
-evalAuthTags :: forall m. (MonadAP m, MonadLogger m) => AuthTagActive -> AuthDNF -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> WriterT (Set AuthTag) m AuthResult
+evalAuthTags :: forall m. MonadAP m => AuthTagActive -> AuthDNF -> Maybe (AuthId UniWorX) -> Route UniWorX -> Bool -> WriterT (Set AuthTag) m AuthResult
 -- ^ `tell`s disabled predicates, identified as pivots
 evalAuthTags AuthTagActive{..} (map (Set.toList . toNullable) . Set.toList . dnfTerms -> authDNF') mAuthId route isWrite
   = do

src/Foundation/I18n.hs

@@ -32,8 +32,6 @@ import qualified Data.Text as Text
 
 import Utils.Form
 
-import Text.Shakespeare.Text (st)
-
 import GHC.Exts (IsList(..))
 
 

src/Foundation/Type.hs

@@ -13,8 +13,6 @@ import Jobs.Types
 
 import Yesod.Core.Types (Logger)
 
-import Data.Set (Set)
-
 import qualified Crypto.Saltine.Core.SecretBox as SecretBox
 import qualified Jose.Jwk as Jose
 

src/Handler/Admin/StudyFeatures.hs

@@ -250,7 +250,7 @@ postAdminFeaturesR = do
                   -> DBRow r 
                   -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
     textInputCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
-      (\row _mkUnique -> (\(res,fieldView) -> (set lensRes . assertM (not . Text.null) <$> res, fvInput fieldView))
+      (\row _mkUnique -> bimap (fmap $ set lensRes . assertM (not . Text.null)) fvInput
         <$> mopt (textField & cfStrip) "" (Just $ row ^. lensDefault)
       )
   
@@ -261,7 +261,7 @@ postAdminFeaturesR = do
                  -> DBRow r 
                  -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) 
     checkboxCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
-      ( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvInput fieldView))
+      ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput
         <$> mpopt checkBoxField "" (Just $ row ^. lensDefault)
       )
 
@@ -283,7 +283,7 @@ postAdminFeaturesR = do
                 -> DBRow r
                 -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
     parentsCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
-      ( \row mkUnique -> (\(res, fieldView) -> (set lensRes . Set.fromList <$> res, fvInput fieldView))
+      ( \row mkUnique -> bimap (fmap $ set lensRes . Set.fromList) fvInput
         <$> massInputList
               (intField & isoField (from _StudyTermsId))
               (const "")
@@ -302,7 +302,7 @@ postAdminFeaturesR = do
                -> DBRow r
                -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
     degreeCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
-      ( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvInput fieldView))
+      ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput
         <$> mopt degreeField "" (Just $ row ^. lensDefault)
       )
   
@@ -313,7 +313,7 @@ postAdminFeaturesR = do
                   -> DBRow r
                   -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
     fieldTypeCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
-      ( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvInput fieldView))
+      ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput
         <$> mopt (selectField optionsFinite) "" (Just $ row ^. lensDefault)
       )
 

src/Handler/Admin/Test.hs

@@ -7,16 +7,12 @@ import Import
 import Handler.Utils
 import Jobs
 
-import Control.Monad.Trans.Writer (mapWriterT)
-
 import Data.Char (isDigit)
 import qualified Data.Text as Text
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 
-import Database.Persist.Sql (fromSqlKey)
-
 
 -- BEGIN - Buttons needed only here
 data ButtonCreate = CreateMath | CreateInf  -- Dummy for Example
@@ -158,7 +154,7 @@ postAdminTestR = do
     mkAddForm 0 0 nudge submitBtn = Just $ \csrf -> do
       (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration
       let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done
-          addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data
+          addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 (succ . fst) $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data
       return (addRes'', toWidget csrf >> fvInput addView >> fvInput submitBtn)
     mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
 

src/Handler/Corrections.hs

@@ -11,18 +11,13 @@ import Handler.Utils.SheetType
 import Handler.Utils.Delete
 -- import Handler.Utils.Zip
 
-import Data.List as List (nub, foldl, foldr)
+import Data.List as List (foldl, foldr)
-import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Map.Strict (Map, (!))
+import Data.Map.Strict ((!))
 import qualified Data.Map.Strict as Map
 
 import qualified Data.Text as Text
 import qualified Data.CaseInsensitive as CI
-import Data.CaseInsensitive (CI)
-
-import Data.Semigroup (Sum(..))
-import Data.Monoid (All(..))
 
 -- import Data.Time
 -- import Data.Function ((&))
@@ -49,14 +44,8 @@ import Database.Persist.Sql (updateWhereCount)
 
 import Data.List (genericLength)
 
-import Control.Monad.Trans.Writer (WriterT(..), runWriter, execWriterT)
-import Control.Monad.Trans.Reader (mapReaderT)
-
-import Control.Monad.Trans.State (State, runState)
 import qualified Control.Monad.State.Class as State
 
-import Data.Foldable (foldrM)
-
 import qualified Data.Conduit.List as C
 
 

src/Handler/Course/Application/Files.hs

@@ -8,8 +8,6 @@ module Handler.Course.Application.Files
 import Import
 import Handler.Utils
 
-import System.FilePath (addExtension, (</>))
-
 import qualified Data.Conduit.List as C
 
 import qualified Database.Esqueleto as E

src/Handler/Course/Application/List.hs

@@ -18,7 +18,6 @@ import qualified Data.Csv as Csv
 import qualified Data.Text as Text
 import qualified Data.Text.Lens as Text
 
-import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
 import qualified Data.Map as Map

src/Handler/Course/Edit.hs

@@ -10,14 +10,12 @@ import Handler.Utils
 import Handler.Utils.Invitations
 
 import qualified Data.CaseInsensitive as CI
-import Data.Function ((&))
 
 import Data.Maybe (fromJust)
 import qualified Data.Set as Set
 import Data.Map ((!))
 import qualified Data.Map as Map
 
-import Control.Monad.Trans.Writer (execWriterT)
 import qualified Control.Monad.State.Class as State
 
 import qualified Database.Esqueleto as E

src/Handler/Course/LecturerInvite.hs

@@ -12,7 +12,6 @@ import Utils.Form
 import Handler.Utils.Invitations
 
 import qualified Data.CaseInsensitive as CI
-import Data.Function ((&))
 
 import Data.Aeson hiding (Result(..))
 
@@ -74,6 +73,7 @@ lecturerInvitationConfig = InvitationConfig{..}
       Just lType -> aforced (selectField optionsFinite) lFs lType
       where
         toJunction jLecturerType = (JunctionLecturer{..}, ())
+        lFs :: FieldSettings UniWorX
         lFs = fslI MsgLecturerType & setTooltip MsgCourseLecturerRightsIdentical
     invitationInsertHook _ _ _ _ _ = id
     invitationSuccessMsg (Entity _ Course{..}) (Entity _ Lecturer{..}) = do

src/Handler/Course/List.hs

@@ -14,8 +14,6 @@ import Utils.Form
 -- import Utils.DB
 import Handler.Utils hiding (colSchoolShort)
 
-import Data.Function ((&))
-
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 

src/Handler/Course/News/Show.hs

@@ -5,6 +5,8 @@ module Handler.Course.News.Show
 import Import
 import Handler.Utils
 
+{-# ANN module ("HLint: ignore Too strict maybe"::String) #-}
+
 
 getCNShowR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDCourseNews -> Handler Html
 getCNShowR tid ssh csh cID = do

src/Handler/Course/ParticipantInvite.hs

@@ -16,7 +16,6 @@ import Handler.Utils
 import Handler.Utils.Invitations
 
 import qualified Data.CaseInsensitive as CI
-import Data.Function ((&))
 
 import qualified Data.Set as Set
 
@@ -26,7 +25,6 @@ import Data.Aeson hiding (Result(..))
 
 import Text.Hamlet (ihamlet)
 
-import Control.Monad.Trans.Writer (WriterT, execWriterT)
 import Control.Monad.Except (MonadError(..))
 
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)

src/Handler/Course/Register.hs

@@ -10,8 +10,6 @@ import Import
 
 import Handler.Utils
 
-import Data.Function ((&))
-
 import qualified Data.Text as Text
 
 import qualified Data.Conduit.List as C

src/Handler/Course/Show.hs

@@ -18,8 +18,6 @@ import qualified Database.Esqueleto as E
 
 import Handler.Course.Register
 
-import System.FilePath (addExtension, pathSeparator)
-
 import qualified Data.Conduit.List as C
 
 

src/Handler/Course/User.hs

@@ -8,8 +8,6 @@ import Utils.Form
 import Handler.Utils
 import Database.Esqueleto.Utils.TH
 
-import Data.Function ((&))
-
 import qualified Database.Esqueleto as E
 
 import Text.Blaze.Html.Renderer.Text (renderHtml)

src/Handler/Course/Users.hs

@@ -16,8 +16,6 @@ import Database.Esqueleto.Utils.TH
 
 import Handler.Course.Register (deregisterParticipant)
 
-import Data.Function ((&))
-
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.Text as Text

src/Handler/CryptoIDDispatch.hs

@@ -7,11 +7,10 @@ import Import
 
 import qualified Data.Text as Text
 
-import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
+import Yesod.Core.Types (HandlerContents(..))
 
 import qualified Control.Monad.Catch as E (Handler(..))
 
-import           Data.CaseInsensitive   (CI)
 import qualified Data.CaseInsensitive as CI
 
 

src/Handler/Exam/AddUser.hs

@@ -13,7 +13,6 @@ import qualified Data.Set as Set
 
 import Data.Semigroup (Option(..))
   
-import Control.Monad.Trans.Writer (WriterT, execWriterT)
 import Control.Monad.Error.Class (MonadError(..))
 
 import Jobs.Queue

src/Handler/Exam/New.hs

@@ -71,8 +71,8 @@ postCExamNewR tid ssh csh = do
 
         let (invites, adds) = partitionEithers $ Set.toList efCorrectors
         insertMany_ [ ExamCorrector{..}
-                    | examCorrectorUser <- adds
+                    | let examCorrectorExam = examid
-                    , let examCorrectorExam = examid
+                    , examCorrectorUser <- adds
                     ]
         sinkInvitationsF examCorrectorInvitationConfig $ map (, examid, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
       return insertRes

src/Handler/Health.hs

@@ -7,8 +7,6 @@ import qualified Data.Text.Lazy.Builder as Builder
 
 import qualified Data.UUID as UUID
 
-import Data.Semigroup (Min(..), Max(..))
-
 import qualified Data.Set as Set
 
 import Control.Concurrent.STM.Delay

src/Handler/Material.hs

@@ -2,8 +2,6 @@ module Handler.Material where
 
 import Import
 
-import Data.Monoid (Any(..))
-import Data.Set (Set)
 import qualified Data.Set as Set
 -- import Data.Map (Map)
 import qualified Data.Map as Map
@@ -18,10 +16,6 @@ import Utils.Form
 import Handler.Utils
 import Handler.Utils.Delete
 
-import Control.Monad.Writer (MonadWriter(..), execWriterT)
-
-import System.FilePath (addExtension)
-
 
 data MaterialForm = MaterialForm
       { mfName         :: MaterialName

src/Handler/Participants.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints -fno-warn-incomplete-uni-patterns #-}
 module Handler.Participants
   ( getParticipantsListR
   , getParticipantsR

src/Handler/Profile.hs

@@ -16,7 +16,6 @@ import Handler.Utils.Tokens
 
 -- import Colonnade hiding (fromMaybe, singleton)
 -- import Yesod.Colonnade
-import Data.Monoid (Any(..))
 import Data.Map ((!))
 import qualified Data.Map as Map
 import qualified Data.Set as Set

src/Handler/Sheet.hs

@@ -30,31 +30,18 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 -- import qualified Database.Esqueleto.Internal.Sql as E
 
-import Control.Monad.Writer (MonadWriter(..), execWriterT)
--- import Control.Monad.Trans.RWS.Lazy (RWST, local)
-
--- import qualified Text.Email.Validate as Email
-
--- import qualified Data.List as List
-
 import Control.Monad.Trans.Except (runExceptT, mapExceptT, throwE)
 
-import Data.Set (Set)
 import qualified Data.Set as Set
 import qualified Data.Map as Map
 
-import Data.Map (Map, (!))
+import Data.Map ((!))
 
-import Data.Monoid (Any(..))
-
-import Control.Monad.Random.Class (MonadRandom(..))
 import Utils.Sql
 
 import Data.Aeson hiding (Result(..))
 import Text.Hamlet (ihamlet)
 
-import System.FilePath (addExtension)
-
 import Data.Time.Clock.System (systemEpochDay)
 
 

src/Handler/Submission.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-incomplete-uni-patterns #-}
 
 module Handler.Submission where
 
@@ -17,7 +17,6 @@ import Handler.Utils.Invitations
 -- import Control.Monad.State.Class
 -- import Control.Monad.Trans.State.Strict (StateT)
 
-import Data.Monoid (Any(..))
 import Data.Maybe (fromJust)
 -- import qualified Data.Maybe
 import qualified Data.Text.Encoding as Text
@@ -30,7 +29,7 @@ import qualified Data.Conduit.List as Conduit
 
 -- import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Map (Map, (!), (!?))
+import Data.Map ((!), (!?))
 import qualified Data.Map as Map
 -- import Data.Bifunctor
 
@@ -42,8 +41,6 @@ import Text.Hamlet (ihamlet)
 -- import qualified Yesod.Colonnade as Yesod
 -- import qualified Text.Blaze.Html5.Attributes as HA
 
-import System.FilePath (addExtension)
-
 -- DEPRECATED: We always show all edits!
 -- numberOfSubmissionEditDates :: Int64
 -- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.

src/Handler/Tutorial/Users.hs

@@ -11,7 +11,6 @@ import Handler.Utils.Tutorial
 import Database.Persist.Sql (deleteWhereCount)
 
 import qualified Data.CaseInsensitive as CI
-import Data.Function ((&))
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map

src/Handler/Utils.hs

@@ -25,8 +25,6 @@ import Handler.Utils.Widgets    as Handler.Utils
 import Handler.Utils.Database   as Handler.Utils
 import Handler.Utils.Occurrences as Handler.Utils
 
-import System.FilePath.Posix (takeFileName)
-
 import Control.Monad.Logger
 
 

src/Handler/Utils/Allocation.hs

@@ -27,7 +27,6 @@ import System.Random (mkStdGen)
 import Utils.Allocation
 
 import qualified Data.Conduit.List as C
-import Data.Conduit.Lift (evalStateC)
 
 import Data.Generics.Product.Param
 
@@ -176,12 +175,14 @@ doAllocation allocId regs = do
     mField <- (courseApplicationField . entityVal =<<) . listToMaybe <$> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Just allocId] []
     void . insertUnique $ CourseParticipant cid uid now mField (Just allocId)
 
-ppMatchingLog :: ( MonoFoldable mono
+ppMatchingLog :: forall mono.
+                 ( MonoFoldable mono
                  , Element mono ~ MatchingLog UserId CourseId Natural
                  )
               => mono -> Text
 ppMatchingLog = unlines . map (tshow . pretty) . otoList
   where
+    pretty :: MatchingLog UserId CourseId Natural -> MatchingLog Int64 Int64 Natural
     pretty = over (param @1) fromSqlKey
            . over (param @2) fromSqlKey
 

src/Handler/Utils/Communication.hs

@@ -11,7 +11,6 @@ import Import
 import Handler.Utils
 
 import Jobs.Queue
-import Control.Monad.Trans.Reader (mapReaderT)
 
 import qualified Database.Esqueleto as E
 import qualified Data.CaseInsensitive as CI

src/Handler/Utils/Csv.hs

@@ -20,7 +20,6 @@ import Import hiding (Header, mapM_)
 import Data.Csv
 import Data.Csv.Conduit
 
-import Data.Function ((&))
 import Control.Monad (mapM_)
 
 -- import qualified Data.Csv.Util as Csv
@@ -75,6 +74,7 @@ decodeCsv' fromCsv' = do
       $logInfoS "decodeCsv" [st|Guessed Csv.DecodeOptions from buffer of size #{tshow (LBS.length testBuffer)}/#{tshow testBufferSize}: #{tshow decodeOptions}|]
 
       fromCsv' decodeOptions
+    testBufferSize :: Num a => a
     testBufferSize = 4096
     accumTestBuffer acc
       | LBS.length acc >= testBufferSize = return acc

src/Handler/Utils/DateTime.hs

@@ -24,7 +24,6 @@ import Data.Time hiding (formatTime, localTimeToUTC, utcToLocalTime, utcToZonedT
 -- import Data.Time.Clock (addUTCTime,nominalDay)
 import qualified Data.Time.Format as Time
 
-import Data.Set (Set)
 import qualified Data.Set as Set
 
 import Data.Time.Clock.System (systemEpochDay)

src/Handler/Utils/Delete.hs

@@ -27,10 +27,11 @@ import Data.Char (isAlphaNum)
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect)
-import qualified Database.Esqueleto.Internal.Language as E (From)
 
 import Jobs.Queue
 
+{-# ANN deleteR ("HLint: ignore Use const" :: String) #-}
+
 
 data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr info, E.From tables) => DeleteRoute
   { drRecords :: Set (Key record) -- ^ Records to be deleted

src/Handler/Utils/Exam.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
+{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-incomplete-uni-patterns #-}
 
 module Handler.Utils.Exam
   ( fetchExamAux
@@ -24,7 +24,6 @@ import qualified Data.Conduit.List as C
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
-import Data.Fixed (Fixed(..))
 import qualified Data.Foldable as F
 
 import qualified Data.CaseInsensitive as CI

src/Handler/Utils/Form.hs

@@ -14,6 +14,8 @@ import Handler.Utils.Pandoc
 
 import Handler.Utils.DateTime
 
+import Handler.Utils.Widgets
+
 import Import
 import Data.Char (chr, ord)
 import qualified Data.Char as Char
@@ -31,19 +33,15 @@ import qualified Data.Conduit.List as C
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 
-import Data.Set (Set)
 import qualified Data.Set as Set
 
-import Data.Map (Map, (!))
+import Data.Map ((!))
 import qualified Data.Map as Map
 
-import Control.Monad.Trans.Writer (execWriterT, WriterT)
 import Control.Monad.Trans.Except (throwE, runExceptT)
 import Control.Monad.Writer.Class
 import Control.Monad.Error.Class (MonadError(..))
 
-import Data.Either (partitionEithers)
-
 import Data.Aeson (eitherDecodeStrict')
 import Data.Aeson.Text (encodeToLazyText)
 
@@ -51,7 +49,6 @@ import qualified Text.Email.Validate as Email
 
 import Yesod.Core.Types (FileInfo(..))
 
-import System.FilePath (isExtensionOf)
 import Data.Text.Lens (unpacked)
 
 import Data.Char (isDigit)
@@ -548,6 +545,7 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
           return (addRes', formWidget')
         miCell _ initFile _ nudge csrf =
           sFileForm nudge (Just initFile) csrf
+        miDelete :: MassInputDelete ListLength
         miDelete = miDeleteList
         miAllowAdd _ _ _ = True
         miAddEmpty _ _ _ = Set.empty
@@ -815,7 +813,8 @@ multiFileField permittedFiles' = Field{..}
                 | Right sentVals' <- sentVals = fuiId' `elem` sentVals'
                 | otherwise = True
           return FileUploadInfo{..}
-        autoUnzipInfo = [whamlet| _{MsgAutoUnzipInfo} |]
+        autoUnzipInfo :: Widget
+        autoUnzipInfo = i18n MsgAutoUnzipInfo
       fileInfos' <- mapM toFUI <=< handlerToWidget . runDB . E.select . E.from $ \file -> do
           E.where_ $ file E.^. FileId `E.in_` E.valList (setToList pVals)
           E.orderBy [E.asc $ file E.^. FileTitle]

src/Handler/Utils/Form/MassInput.hs

@@ -1,8 +1,8 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-} -- tupleBoxCoord
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-incomplete-record-updates #-} -- tupleBoxCoord
 {-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-}
 
 module Handler.Utils.Form.MassInput
-  ( MassInput(..), MassInputLayout
+  ( MassInput(..), MassInputLayout, MassInputDelete
   , defaultMiLayout, listMiLayout
   , massInput
   , module Handler.Utils.Form.MassInput.Liveliness
@@ -34,6 +34,8 @@ import Control.Monad.Reader.Class (MonadReader(local))
 
 import Text.Hamlet (hamletFile)
 
+import Algebra.Lattice.Ordered (Ordered(..))
+
 
 $(mapM tupleBoxCoord [2..4])
 
@@ -44,11 +46,8 @@ newtype ListLength = ListLength { unListLength :: Natural }
 
 makeWrapped ''ListLength
 
-instance JoinSemiLattice ListLength where
+deriving via Ordered ListLength instance Lattice ListLength
-  (\/) = max
+
-instance MeetSemiLattice ListLength where
-  (/\) = min
-instance Lattice ListLength
 instance BoundedJoinSemiLattice ListLength where
   bottom = 0
 
@@ -85,16 +84,13 @@ newtype EnumLiveliness enum = EnumLiveliness { unEnumLiveliness :: IntSet }
 
 makeWrapped ''EnumLiveliness
 
-instance JoinSemiLattice (EnumLiveliness enum) where
+instance Lattice (EnumLiveliness enum) where
   (EnumLiveliness a) \/ (EnumLiveliness b) = EnumLiveliness $ a `IntSet.union` b
-instance MeetSemiLattice (EnumLiveliness enum) where
   (EnumLiveliness a) /\ (EnumLiveliness b) = EnumLiveliness $ a `IntSet.intersection` b
-instance Lattice (EnumLiveliness enum)
 instance BoundedJoinSemiLattice (EnumLiveliness enum) where
   bottom = EnumLiveliness IntSet.empty
 instance (Enum enum, Bounded enum) => BoundedMeetSemiLattice (EnumLiveliness enum) where
   top = EnumLiveliness . IntSet.fromList $ map (fromEnum :: enum -> Int) [minBound..maxBound]
-instance (Enum enum, Bounded enum) => BoundedLattice (EnumLiveliness enum)
 
 
 newtype EnumPosition enum = EnumPosition { unEnumPosition :: enum }
@@ -111,7 +107,9 @@ instance (Enum enum, Bounded enum, PathPiece enum, ToJSON enum, FromJSON enum, T
   type BoxCoord (EnumLiveliness enum) = EnumPosition enum
   liveCoords = iso fromSet toSet
     where
+      toSet :: EnumLiveliness enum -> Set (EnumPosition enum)
       toSet = Set.fromList . map toEnum . IntSet.toList . unEnumLiveliness
+      fromSet :: Set (EnumPosition enum) -> EnumLiveliness enum
       fromSet = EnumLiveliness . IntSet.fromList . map fromEnum . Set.toList
 
 
@@ -120,12 +118,9 @@ newtype MapLiveliness l1 l2 = MapLiveliness { unMapLiveliness :: Map (BoxCoord l
 
 makeWrapped ''MapLiveliness
 
-deriving instance (Ord (BoxCoord l1), JoinSemiLattice l2) => JoinSemiLattice (MapLiveliness l1 l2)
-deriving instance (Ord (BoxCoord l1), MeetSemiLattice l2) => MeetSemiLattice (MapLiveliness l1 l2)
 deriving instance (Ord (BoxCoord l1), Lattice l2) => Lattice (MapLiveliness l1 l2)
 deriving instance (Ord (BoxCoord l1), BoundedJoinSemiLattice l2) => BoundedJoinSemiLattice (MapLiveliness l1 l2)
 deriving instance (Ord (BoxCoord l1), Finite (BoxCoord l1), BoundedMeetSemiLattice l2) => BoundedMeetSemiLattice (MapLiveliness l1 l2)
-deriving instance (Ord (BoxCoord l1), Finite (BoxCoord l1), BoundedLattice l2) => BoundedLattice (MapLiveliness l1 l2)
 deriving instance (Eq (BoxCoord l1), Eq l2) => Eq (MapLiveliness l1 l2)
 deriving instance (Ord (BoxCoord l1), Ord l2) => Ord (MapLiveliness l1 l2)
 deriving instance (Ord (BoxCoord l1), Read (BoxCoord l1), Read l2) => Read (MapLiveliness l1 l2)
@@ -138,8 +133,10 @@ instance (Liveliness l1, Liveliness l2) => Liveliness (MapLiveliness l1 l2) wher
     (\ts -> let ks = Set.mapMonotonic fst ts in fmap MapLiveliness . sequence $ Map.fromSet (\k -> preview liveCoords . Set.mapMonotonic snd $ Set.filter ((== k) . fst) ts) ks)
 
 
+type MassInputDelete liveliness = forall m a. Applicative m => Map (BoxCoord liveliness) a -> (BoxCoord liveliness) -> m (Map (BoxCoord liveliness) (BoxCoord liveliness))
 
-miDeleteList :: Applicative m => Map ListPosition a -> ListPosition -> m (Map ListPosition ListPosition)
+
+miDeleteList :: MassInputDelete ListLength
 miDeleteList dat pos
     -- Close gap left by deleted position with values from further down the list; try prohibiting certain deletions by utilising `guard`
   | Just l <- preview liveCoords $ Map.keysSet dat :: Maybe ListLength
@@ -289,6 +286,7 @@ massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvR
   let
     shapeName :: MassInputFieldName (BoxCoord liveliness)
     shapeName = MassInputShape{..}
+    shapeField :: Field handler (Map (BoxCoord liveliness) cellData)
     shapeField = secretJsonField
   sentShape <- runMaybeT $ do
     ts <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askParams
@@ -536,6 +534,7 @@ massInputAccum miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequire
            -> (Markup -> MForm handler (FormResult (), Widget))
     miCell _pos dat _mPrev _nudge csrf' = return (FormSuccess (), toWidget csrf' <> miCell' dat)
 
+    miDelete :: MassInputDelete ListLength
     miDelete = miDeleteList
 
     miAllowAdd _ _ _ = True
@@ -613,6 +612,7 @@ massInputAccumEdit miAdd' miCell' miButtonAction miLayout miIdent fSettings fReq
            -> (Markup -> MForm handler (FormResult cellData, Widget))
     miCell _pos dat _mPrev nudge = miCell' nudge dat
 
+    miDelete :: MassInputDelete ListLength
     miDelete = miDeleteList
 
     miAllowAdd _ _ _ = True

src/Handler/Utils/Form/MassInput/Liveliness.hs

@@ -26,11 +26,12 @@ class (ToJSON x, FromJSON x, ToJSONKey x, FromJSONKey x, PathPiece x, Eq x, Ord
   boxDimensions :: [BoxDimension x]
   boxOrigin :: x
 
-boxDimension :: IsBoxCoord x => Natural -> BoxDimension x
+boxDimension :: forall x. IsBoxCoord x => Natural -> BoxDimension x
 boxDimension n
   | n < genericLength dims = genericIndex dims n
   | otherwise = error "boxDimension: insufficient dimensions"
   where
+    dims :: [BoxDimension x]
     dims = boxDimensions
 
 -- zeroDimension :: IsBoxCoord x => Natural -> x -> x

src/Handler/Utils/Form/MassInput/TH.hs

@@ -11,8 +11,6 @@ import Language.Haskell.TH
 
 import Control.Lens
 
-import Data.List ((!!))
-
 import Control.Monad (replicateM)
 
 

src/Handler/Utils/I18n.hs

@@ -20,7 +20,6 @@ import qualified Data.Map as Map
 import qualified Data.Text as Text
 
 import System.Directory (listDirectory)
-import System.FilePath.Posix (takeBaseName)
 
 
 -- | Add language dependent template files

src/Handler/Utils/Invitations.hs

@@ -25,9 +25,6 @@ import Handler.Utils.Tokens
 
 import Text.Hamlet
 
-import Control.Monad.Trans.Writer (WriterT) 
-import Control.Monad.Trans.Reader (mapReaderT, withReaderT)
-
 import qualified Data.Conduit.List as C
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.HashSet as HashSet
@@ -36,7 +33,6 @@ import qualified Data.Set as Set
 import Data.Aeson (fromJSON)
 import qualified Data.Aeson as JSON
 
-import Data.Proxy (Proxy(..))
 import Data.Typeable
 
 import Database.Persist.Sql (SqlBackendCanWrite)

src/Handler/Utils/Mail.hs

@@ -15,10 +15,6 @@ import qualified Data.ByteString.Lazy as LBS
 
 import qualified Data.Conduit.List as C
 
-import System.FilePath (takeBaseName)
-
-import Control.Monad.Trans.State (StateT)
-
 import qualified Text.Pandoc as P
 
 import qualified Text.Hamlet as Hamlet (Translate)
@@ -79,8 +75,8 @@ addFileDB fId = runMaybeT $ do
   lift . addPart $ do
     _partType .= decodeUtf8 (mimeLookup fileName)
     _partEncoding .= Base64
-    _partFilename .= Just fileName
+    _partDisposition .= AttachmentDisposition fileName
-    _partContent .= LBS.fromStrict fileContent
+    _partContent .= PartContent (LBS.fromStrict fileContent)
     setMailObjectIdCrypto fId :: StateT Part (HandlerFor UniWorX) MailObjectId
 
 

src/Handler/Utils/Rating.hs

@@ -20,11 +20,9 @@ import Text.PrettyPrint.Leijen.Text hiding ((<$>))
 
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
-import Data.Text.Encoding.Error (UnicodeException(..))
 
 import qualified Data.Text.Lazy.Encoding as Lazy.Text
 
-import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
@@ -138,8 +136,10 @@ parseRating File{ fileContent = Just input, .. } = do
     (headerLines', commentLines) = break (commentSep `Text.isInfixOf`) $ Text.lines inputText
     (reverse -> ratingLines, reverse -> _headerLines) = break (sep' `Text.isInfixOf`) $ reverse headerLines'
     ratingLines' = filter (rating `Text.isInfixOf`) ratingLines
+    commentSep :: Text
     commentSep = "Beginn der Kommentare"
     sep' = Text.pack $ replicate 40 '='
+    rating :: Text
     rating = "Bewertung:"
   comment' <- case commentLines of
     (_:commentLines') -> return . Text.strip $ Text.unlines commentLines'

src/Handler/Utils/SchoolLdap.hs

@@ -7,7 +7,6 @@ import Import.NoFoundation hiding (try, (<|>), choice)
 import Text.Parsec
 import Text.Parsec.Text
 
-import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
 import qualified Data.Set as Set

src/Handler/Utils/SheetType.hs

@@ -4,7 +4,6 @@ module Handler.Utils.SheetType
   ) where
 
 import Import
-import Data.Monoid (Sum(..))
 
 addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary
 addBonusToPoints sts =

src/Handler/Utils/Submission.hs

@@ -13,24 +13,20 @@ module Handler.Utils.Submission
 
 import Import hiding (joinPath)
 import Jobs.Queue
-import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
+import Yesod.Core.Types (HandlerContents(..))
 
-import Control.Monad.State as State (StateT)
 import Control.Monad.State.Class as State
-import Control.Monad.Writer (MonadWriter(..), execWriterT, execWriter)
 import Control.Monad.RWS.Lazy (MonadRWS, RWST, execRWST)
 import qualified Control.Monad.Random as Rand
 
 import Data.Maybe ()
 
-import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Map (Map, (!), (!?))
+import Data.Map ((!), (!?))
 import qualified Data.Map as Map
 
 import qualified Data.Text as Text
 
-import Data.Monoid (Monoid, Any(..), Sum(..))
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
 import Handler.Utils

src/Handler/Utils/Submission/TH.hs

@@ -10,7 +10,6 @@ import Language.Haskell.TH.Syntax (qAddDependentFile, Lift(..))
 
 import System.FilePath.Glob
 
-import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
 

src/Handler/Utils/Table/Cells.hs

@@ -2,12 +2,7 @@ module Handler.Utils.Table.Cells where
 
 import Import hiding (link)
 
-import Data.CaseInsensitive (CI)
--- import qualified Data.CaseInsensitive as CI
-
-import Data.Monoid (Any(..))
 import Control.Monad.Writer.Class (MonadWriter(..))
-import Control.Monad.Trans.Writer (WriterT)
 
 import Text.Blaze (ToMarkup(..))
 

src/Handler/Utils/Table/Pagination.hs

@@ -61,21 +61,18 @@ import qualified Yesod.Form.Functions as Yesod
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect,unsafeSqlValue)
-import qualified Database.Esqueleto.Internal.Language as E (From)
 
 import qualified Network.Wai as Wai
 
 import Control.Monad.RWS (RWST(..), execRWS)
-import Control.Monad.Writer (WriterT(..))
+import Control.Monad.State (evalStateT)
-import Control.Monad.Reader (ReaderT(..), mapReaderT)
-import Control.Monad.State (StateT(..), evalStateT)
 import Control.Monad.Trans.Maybe
 import Control.Monad.State.Class (modify)
 import qualified Control.Monad.State.Class as State
 
 import Data.Foldable (Foldable(foldMap))
 
-import Data.Map (Map, (!))
+import Data.Map ((!))
 import qualified Data.Map as Map
 
 import qualified Data.Set as Set
@@ -90,20 +87,14 @@ import Colonnade.Encode hiding (row)
 
 import Text.Hamlet (hamletFile)
 
-import Data.Ratio ((%))
-
 import Data.List (elemIndex)
 
 import Data.Maybe (fromJust)
 
-import Data.Aeson (Options(..), SumEncoding(..), defaultOptions)
 import Data.Aeson.Text
-import Data.Aeson.TH (deriveJSON)
 
 import qualified Data.Text as Text
 
-import Data.Proxy (Proxy(..))
-
 import qualified Data.Binary as B
 import qualified Data.ByteArray as BA (convert)
 import Crypto.MAC.HMAC (hmac, HMAC)
@@ -140,7 +131,8 @@ instance PathPiece x => PathPiece (WithIdent x) where
     | not . null $ toPathPiece ident = toPathPiece ident <> "-" <> toPathPiece x
     | otherwise = toPathPiece x
   fromPathPiece txt = do
-    let sep = "-"
+    let sep :: Text
+        sep = "-"
     (ident, (Text.stripSuffix sep -> Just rest)) <- return $ Text.breakOn sep txt
     WithIdent <$> pure ident <*> fromPathPiece rest
 
@@ -188,7 +180,8 @@ deriveJSON defaultOptions
 instance PathPiece SortingSetting where
   toPathPiece SortingSetting{..} = toPathPiece sortKey <> "-" <> toPathPiece sortDir
   fromPathPiece str = do
-    let sep = "-"
+    let sep :: Text
+        sep = "-"
     let (Text.dropEnd (Text.length sep) -> key, dir) = Text.breakOnEnd sep str
     SortingSetting <$> fromPathPiece key <*> fromPathPiece dir
 
@@ -829,8 +822,9 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     dbsAttrs'
       | not $ null dbtIdent = ("id", dbtIdent) : dbsAttrs
       | otherwise           = dbsAttrs
+    multiTextField :: forall m'. Applicative m' => Field m' [Text]
     multiTextField = Field
-      { fieldParse = \ts _ -> return . Right $ Just ts
+      { fieldParse = \ts _ -> pure . Right $ Just ts
       , fieldView = error "multiTextField: should not be rendered"
       , fieldEnctype = UrlEncoded
       }
@@ -939,6 +933,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
       , formSubmit = FormSubmit
       , formAnchor = Just $ wIdent "csv-import"
       }
+    csvImportExplanation :: Widget
     csvImportExplanation = modal [whamlet|_{MsgCsvImportExplanationLabel}|] $ Right $(i18nWidgetFile "table/csv-import-explanation")
     csvColExplanations = case dbtCsvEncode of
       Just (DBTCsvEncode{} :: DBTCsvEncode r' k' csv) -> assertM' (not . null) . Map.toList . csvColumnsExplanations $ Proxy @csv
@@ -1246,6 +1241,7 @@ pagesizeOptions psLim = impureNonNull . Set.toAscList . Set.fromList $ psLim : P
     opts :: [Int64]
     opts = filter (> 0) $ opts' <> map (`div` 2) opts'
 
+    opts' :: [Int64]
     opts' = [ 10^n | n <- [1..3]]
 
 pagesizeField :: PagesizeLimit -> Field Handler PagesizeLimit

src/Handler/Utils/Table/Pagination/Types.hs

@@ -14,10 +14,6 @@ import Import hiding (singleton)
 import Colonnade
 import Colonnade.Encode
 
-import Data.CaseInsensitive (CI)
-
-import Data.Aeson (FromJSON, ToJSON, FromJSONKey, ToJSONKey)
-
 {-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
 
 newtype FilterKey = FilterKey { _unFilterKey :: CI Text }

src/Handler/Utils/TermCandidates.hs

@@ -17,10 +17,8 @@ import Import
 -- import qualified Data.UUID.Cryptographic as UUID
 -- import Control.Monad.Trans.Writer (mapWriterT)
 -- import Database.Persist.Sql (fromSqlKey)
-import Data.Set (Set)
 import qualified Data.Set as Set
 import qualified Data.List as List
-import Data.Map (Map)
 import qualified Data.Map as Map
 
 

src/Handler/Utils/Tokens.hs

@@ -5,8 +5,6 @@ module Handler.Utils.Tokens
 
 import Import
 
-import Control.Monad.Trans.Maybe (runMaybeT)
-
 
 maybeBearerToken :: (MonadHandler m, HandlerSite m ~ UniWorX, MonadCatch m) => m (Maybe (BearerToken UniWorX))
 maybeBearerToken = runMaybeT $ catchIfMaybeT cPred requireBearerToken

src/Handler/Utils/Users.hs

@@ -9,7 +9,7 @@ module Handler.Utils.Users
 import Import
 import Auth.LDAP (campusUserMatr')
 
-import Crypto.Hash (Digest, SHA3_256, hashlazy)
+import Crypto.Hash (hashlazy)
 
 import Data.ByteArray (constEq)
 

src/Handler/Utils/Widgets.hs

@@ -109,6 +109,7 @@ i18n = toWidget . (SomeMessage :: msg -> SomeMessage (HandlerSite m))
 examOccurrenceMappingDescriptionWidget :: ExamOccurrenceRule -> Set ExamOccurrenceMappingDescription -> Widget
 examOccurrenceMappingDescriptionWidget rule descriptions = $(widgetFile "widgets/exam-occurrence-mapping-description")
   where
+    titleCase :: [CI Char] -> String
     titleCase = over _head Char.toUpper . map CI.foldedCase
     doPrefix
       | ExamRoomMatriculation <- rule

src/Handler/Utils/Zip.hs

@@ -20,7 +20,6 @@ import Codec.Archive.Zip.Conduit.Zip
 -- import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy as Lazy.ByteString
 
-import Data.ByteString (ByteString)
 import qualified Data.ByteString as ByteString
 
 import System.FilePath

src/Import/NoModel.hs

@@ -1,6 +1,7 @@
 module Import.NoModel
   ( module Import
   , MForm
+  , WeekDay
   ) where
 
 import ClassyPrelude.Yesod    as Import
@@ -16,7 +17,6 @@ import ClassyPrelude.Yesod    as Import
          , HasHttpManager(..)
          , embed
          , try, embed, catches, handle, catch, bracket, bracketOnError, bracket_, catchJust, finally, handleJust, mask, mask_, onException, tryJust, uninterruptibleMask, uninterruptibleMask_
-         , fail
          , htmlField
          )
 
@@ -30,7 +30,6 @@ import Mail                   as Import
 import Yesod.Auth             as Import
 import Yesod.Core.Types       as Import (loggerSet)
 import Yesod.Default.Config2  as Import
-import Yesod.Core.Json        as Import (provideJson)
 import Yesod.Core.Types.Instances as Import
 
 import Utils                  as Import
@@ -53,15 +52,13 @@ import UnliftIO.Pool          as Import (Pool)
 import Network.HaskellNet.SMTP as Import (SMTPConnection)
 
 import Data.Data              as Import (Data)
-import Data.Typeable          as Import (Typeable)
-import GHC.Generics           as Import (Generic)
 import GHC.Exts               as Import (IsList)
 import Data.Ix                as Import (Ix)
 
 import Data.Hashable          as Import
 import Data.List.NonEmpty     as Import (NonEmpty(..), nonEmpty)
 import Data.Text.Encoding.Error as Import(UnicodeException(..))
-import Data.Semigroup         as Import (Semigroup, Min(..), Max(..))
+import Data.Semigroup         as Import (Min(..), Max(..))
 import Data.Monoid            as Import (Last(..), First(..), Any(..), All(..), Sum(..), Endo(..), Alt(..))
 import Data.Binary            as Import (Binary)
 
@@ -82,8 +79,8 @@ import Control.Monad.Random.Class as Import (MonadRandom(..))
 import Control.Monad.Morph as Import
 import Control.Monad.Trans.Resource as Import (ReleaseKey)
 import Control.Monad.Trans.Reader as Import
-  ( reader, Reader, runReader, mapReader, withReader
+  ( reader, runReader, mapReader, withReader
-  , ReaderT(..), mapReaderT, withReaderT
+  , mapReaderT, withReaderT
   )
 import Control.Monad.Trans.State as Import
   ( state, State, runState, mapState, withState
@@ -103,17 +100,15 @@ import Jose.Jwt as Import (Jwt)
 import Data.Time.Calendar as Import
 import Data.Time.Clock as Import
 import Data.Time.LocalTime as Import hiding (utcToLocalTime, utcToZonedTime, localTimeToUTC)
-import Time.Types as Import (WeekDay(..))
 
 import Network.Mime as Import
 
 import Data.Aeson.TH as Import
-import Data.Aeson.Types as Import (FromJSON(..), ToJSON(..), FromJSONKey(..), ToJSONKey(..), toJSONKeyText, FromJSONKeyFunction(..), ToJSONKeyFunction(..), Value)
+import Data.Aeson.Types as Import (FromJSONKey(..), ToJSONKey(..), toJSONKeyText, FromJSONKeyFunction(..), ToJSONKeyFunction(..))
 
 import Data.Constraint as Import (Dict(..))
-import Data.Void as Import (Void)
 
-import Algebra.Lattice as Import hiding (meet, join)
+import Algebra.Lattice as Import
 
 import Data.Proxy as Import (Proxy(..))
 
@@ -133,7 +128,6 @@ import Data.Time.Clock.Instances as Import ()
 import Data.Time.LocalTime.Instances as Import ()
 import Data.Time.Calendar.Instances as Import ()
 import Data.Time.Format.Instances as Import ()
-import Time.Types.Instances as Import ()
 import Network.Mail.Mime.Instances as Import ()
 import Yesod.Core.Instances as Import ()
 import Data.Aeson.Types.Instances as Import ()
@@ -177,3 +171,5 @@ import Data.Encoding.UTF8 as Import (UTF8(UTF8))
 import Control.Monad.Trans.RWS (RWST)
 
 type MForm m = RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m
+
+type WeekDay = DayOfWeek

src/Jobs.hs

@@ -7,7 +7,6 @@ module Jobs
 
 import Import
 import Jobs.Types as Types hiding (JobCtl(JobCtlQueue))
-import Jobs.Types (JobCtl(JobCtlQueue))
 import Jobs.Queue
 import Jobs.Crontab
 
@@ -18,17 +17,13 @@ import qualified Data.Text.Lazy as LT
 import Data.Aeson (fromJSON)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
-import Database.Persist.Sql (fromSqlKey)
-
-import Data.Semigroup (Max(..))
 
 import Utils.Sql
 
-import Control.Monad.Random (evalRand, mkStdGen, getRandomR, uniformMay)
+import Control.Monad.Random (evalRand, mkStdGen, uniformMay)
 
 import Cron
 import qualified Data.HashMap.Strict as HashMap
-import Data.HashMap.Strict (HashMap)
 import qualified Data.Set as Set
 
 import qualified Data.List.NonEmpty as NonEmpty
@@ -36,16 +31,9 @@ import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map.Strict as Map
 import Data.Map.Strict ((!))
 
-import Data.Foldable (foldrM)
-
-import Control.Monad.Trans.Reader (mapReaderT)
-import Control.Monad.Trans.Writer (execWriterT)
 import Control.Monad.Trans.RWS.Lazy (RWST, mapRWST, evalRWST)
 import qualified Control.Monad.State.Class as State
 import Control.Monad.Writer.Class (MonadWriter(..))
-import Control.Monad.Reader.Class (MonadReader(..))
-import Control.Monad.Trans.Resource (runResourceT)
-import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Trans.Cont (ContT(..), callCC)
 import Control.Monad.Random.Lazy (evalRandTIO, mapRandT)
 import Control.Monad.Logger

src/Jobs/Crontab.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-}
+
 module Jobs.Crontab
   ( determineCrontab
   ) where
@@ -9,7 +11,6 @@ import Jobs.Types
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
-import Data.Semigroup (Max(..))
 
 import Data.Time.Zones
 import Data.Time.Clock.POSIX
@@ -17,7 +18,6 @@ import Data.Time.Clock.POSIX
 import Handler.Utils.DateTime
 import Handler.Utils.Allocation (allocationDone)
 
-import Control.Monad.Trans.Writer (WriterT, execWriterT)
 import Control.Monad.Writer.Class (MonadWriter(..))
 
 import qualified Data.Conduit.List as C

src/Jobs/Handler/DistributeCorrections.hs

@@ -6,8 +6,6 @@ import Import
 
 import Jobs.Queue
 
-import Control.Monad.Trans.Reader (mapReaderT)
-
 import Handler.Utils.Submission
 
 import qualified Data.Set as Set

src/Jobs/Handler/QueueNotification.hs

@@ -4,8 +4,6 @@ module Jobs.Handler.QueueNotification
 
 import Import
 
-import Data.List (nub)
-
 import Jobs.Types
 
 import qualified Database.Esqueleto as E

src/Jobs/Handler/SendCourseCommunication.hs

@@ -12,6 +12,9 @@ import qualified Data.CaseInsensitive as CI
 import Handler.Utils.Csv (partIsAttachmentCsv)
 
 
+{-# ANN module ("HLint: ignore Too strict maybe"::String) #-}
+
+
 dispatchJobSendCourseCommunication :: Either UserEmail UserId
                                    -> Set Address
                                    -> CourseId

src/Jobs/Handler/SynchroniseLdap.hs

@@ -51,6 +51,7 @@ dispatchJobSynchroniseLdapUser jUser = do
     Nothing ->
       throwM SynchroniseLdapNoLdap
   where
+    handleExc :: MaybeT DB a -> MaybeT DB a
     handleExc
       = catchMPlus (Proxy @CampusUserException)
       . catchMPlus (Proxy @CampusUserConversionException)

src/Jobs/HealthReport.hs

@@ -10,7 +10,6 @@ import Data.List (genericLength)
 import qualified Data.Map.Strict as Map
 
 import qualified Data.Aeson as Aeson
-import Data.Proxy (Proxy(..))
 
 import qualified Data.ByteArray as ByteArray
 
@@ -124,7 +123,9 @@ dispatchHealthCheckWidgetMemcached :: Handler HealthReport
 dispatchHealthCheckWidgetMemcached = fmap HealthWidgetMemcached . yesodTimeout (^. _appHealthCheckActiveWidgetMemcachedTimeout) (Just False) $ do
   memcachedConn <- getsYesod appWidgetMemcached
   for memcachedConn $ \_memcachedConn' -> do
-    let ext = "bin"
+    let ext :: Text
+        ext = "bin"
+        mimeType :: Text
         mimeType = "application/octet-stream"
     content <- pack . take 256 <$> liftIO getRandoms
     staticLink <- addStaticContent ext mimeType content

src/Jobs/Queue.hs

@@ -14,9 +14,7 @@ import Import hiding ((<>))
 import Utils.Sql
 import Jobs.Types
 
-import Control.Monad.Trans.Writer (WriterT, runWriterT)
 import Control.Monad.Writer.Class (MonadWriter(..))
-import Control.Monad.Trans.Reader (ReaderT, mapReaderT)
 
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set

src/Jobs/Types.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Jobs.Types
@@ -19,13 +20,9 @@ module Jobs.Types
 import Import.NoFoundation hiding (Unique, state)
 
 import qualified Data.Aeson as Aeson
-import Data.Aeson (defaultOptions, Options(..), SumEncoding(..))
-import Data.Aeson.TH (deriveJSON)
 
 import qualified Data.HashMap.Strict as HashMap
 
-import Data.List.NonEmpty (NonEmpty)
-
 import Data.Unique
 
 import qualified Data.Map.Strict as Map

src/Ldap/Client/Pool.hs

@@ -35,8 +35,6 @@ data LdapExecutor = LdapExecutor
   , ldapAsync :: Async ()
   }
 
-instance Exception LdapError
-
 data LdapPoolError = LdapPoolTimeout | LdapError LdapError
   deriving (Eq, Show, Generic, Typeable)
 
@@ -93,7 +91,10 @@ createLdapPool host port stripes timeoutConn (round . (* 1e6) -> timeoutAct) lim
                 $logErrorS "LdapExecutor" "Could not return result"
               either throwM (const $ return ()) res
                 `catches`
-                [ Handler (\(Ldap.ResponseError _) -> return ())
+                [ Handler $ \case
+                    Ldap.ResponseError   _ -> return ()
+                    Ldap.DisconnectError _ -> return ()
+                    other                  -> throwM other
                 ]
               go Nothing ldap
 

src/Mail.hs

@@ -33,7 +33,7 @@ module Mail
   , setMailSmtpData
   , _addressName, _addressEmail
   , _mailFrom, _mailTo, _mailCc, _mailBcc, _mailHeaders, _mailHeader, _mailParts
-  , _partType, _partEncoding, _partFilename, _partHeaders, _partContent
+  , _partType, _partEncoding, _partDisposition, _partFilename, _partHeaders, _partContent
   ) where
 
 import ClassyPrelude.Yesod hiding (snoc, (.=), getMessageRender, derivePersistFieldJSON)
@@ -49,18 +49,15 @@ import Data.Monoid (Last(..))
 import Control.Monad.Trans.RWS (RWST(..))
 import Control.Monad.Trans.State (StateT(..), execStateT, mapStateT)
 import Control.Monad.Trans.Writer (execWriter, Writer)
-import Control.Monad.RWS.Class (MonadWriter(..), MonadReader(..), MonadState(..), modify)
+import Control.Monad.RWS.Class (MonadWriter(..), MonadState(..), modify)
 import Control.Monad.Fail
 import Control.Monad.Base
 import Control.Monad.Catch
 
-import GHC.Generics (Generic)
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
-import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
 
-import Data.Set (Set)
 import qualified Data.Set as Set
 
 import qualified Data.Text as Text
@@ -88,7 +85,7 @@ import qualified Data.Binary as Binary
 
 import "network-bsd" Network.BSD (getHostName)
 
-import Data.Time.Zones (TZ, utcTZ, utcToLocalTimeTZ, timeZoneForUTCTime)
+import Data.Time.Zones (utcTZ, utcToLocalTimeTZ, timeZoneForUTCTime)
 import Data.Time.LocalTime (ZonedTime(..), TimeZone(..))
 import Data.Time.Format (rfc822DateFormat)
 
@@ -100,7 +97,6 @@ import qualified Text.Shakespeare as Shakespeare (RenderUrl)
 
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
-import Data.Aeson (Options(..))
 import Data.Aeson.TH
 import Utils.PathPiece (splitCamel)
 import Utils.DateTime
@@ -125,6 +121,14 @@ makeLenses_ ''Address
 makeLenses_ ''Mail
 makeLenses_ ''Part
 
+_partFilename :: Traversal' Part Text
+_partFilename = _partDisposition . dispositionFilename
+  where
+    dispositionFilename :: Traversal' Disposition Text
+    dispositionFilename f (AttachmentDisposition t) = AttachmentDisposition <$> f t
+    dispositionFilename f (InlineDisposition     t) = InlineDisposition     <$> f t
+    dispositionFilename _  DefaultDisposition       = pure DefaultDisposition
+
 _mailHeader :: CI ByteString -> Traversal' Mail Text
 _mailHeader hdrName = _mailHeaders . traverse . filtered (views _1 $ (== hdrName) . CI.mk) . _2
 
@@ -328,7 +332,7 @@ instance YesodMail site => ToMailPart site LT.Text where
   toMailPart text = do
     _partType .= decodeUtf8 typePlain
     _partEncoding .= QuotedPrintableText
-    _partContent .= encodeUtf8 text
+    _partContent .= PartContent (encodeUtf8 text)
 
 instance YesodMail site => ToMailPart site Text where
   toMailPart = toMailPart . LT.fromStrict
@@ -340,7 +344,7 @@ instance YesodMail site => ToMailPart site Html where
   toMailPart html = do
     _partType .= decodeUtf8 typeHtml
     _partEncoding .= QuotedPrintableText
-    _partContent .= renderMarkup html
+    _partContent .= PartContent (renderMarkup html)
 
 instance (ToMailPart site a, RenderMessage site msg) => ToMailPart site (Hamlet.Translate msg -> a) where
   type MailPartReturn site (Hamlet.Translate msg -> a) = MailPartReturn site a
@@ -364,7 +368,7 @@ instance YesodMail site => ToMailPart site Aeson.Value where
   toMailPart val = do
     _partType .= decodeUtf8 typeJson
     _partEncoding .= QuotedPrintableText
-    _partContent .= Aeson.encodePretty val
+    _partContent .= PartContent (Aeson.encodePretty val)
 
 
 addAlternatives :: (MonadMail m)
@@ -400,9 +404,9 @@ initialPart :: Part
 initialPart = Part
   { partType = decodeUtf8 defaultMimeType
   , partEncoding = Base64
-  , partFilename = Nothing
+  , partDisposition = DefaultDisposition
   , partHeaders = []
-  , partContent = mempty
+  , partContent = PartContent mempty
   }
 
 modifyPart :: (MonadMail m, HandlerSite m ~ site, YesodMail site)
@@ -413,7 +417,7 @@ modifyPart = toMailPart
 partIsAttachment :: (Textual t, MonadMail m, HandlerSite m ~ site, YesodMail site)
                  => t
                  -> StateT Part m ()
-partIsAttachment (repack -> fName) = modifyPart $ _partFilename .= Just fName
+partIsAttachment (repack -> fName) = modifyPart $ _partDisposition .= AttachmentDisposition fName
 
 
 class MonadHandler m => MonadHeader m where

src/Model.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances, DeriveAnyClass #-}
 
 module Model
   ( module Model
@@ -14,13 +14,9 @@ import Database.Persist.TH.Directory
 import Model.Types hiding (_maxPoints, _passingPoints)
 import Cron.Types
 
-import Data.Aeson (Value)
+import Data.CaseInsensitive (original)
-
-import Data.CaseInsensitive (CI, original)
 import Data.CaseInsensitive.Instances ()
 
-import Utils.Message (MessageStatus)
-
 import Settings.Cluster (ClusterSettingsKey)
 
 import Text.Blaze (ToMarkup(..))

src/Model/Migration.hs

@@ -1,21 +1,17 @@
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableInstances, GeneralizedNewtypeDeriving #-}
 
 module Model.Migration
   ( migrateAll
   , requiresMigration
   ) where
 
-import Utils (lastMaybe)
-
 import Import.NoModel
 import Model
 import Audit.Types
 import Model.Migration.Version
 import qualified Model.Migration.Types as Legacy
-import Data.Map (Map)
 import qualified Data.Map as Map
 
-import Data.Set ()
 import qualified Data.Set as Set
 
 import qualified Data.Text as Text
@@ -26,25 +22,15 @@ import Database.Persist.Sql
 import Database.Persist.Sql.Raw.QQ
 import Database.Persist.Postgresql
 
-import Control.Monad.Trans.Maybe (MaybeT(..))
-
 import Text.Read (readMaybe)
-import Data.CaseInsensitive (CI)
 
-import Text.Shakespeare.Text (st)
-
-import Control.Monad.Trans.Reader (mapReaderT)
 import Control.Monad.Except (MonadError(..))
-import Utils (exceptT, allM, whenIsJust, guardM)
 import Utils.Lens (_NoUpload)
-import Utils.DB (getKeyBy)
 
 import qualified Net.IP as IP
 import qualified Net.IPv4 as IPv4
 import qualified Net.IPv6 as IPv6
 
-import Data.Aeson (toJSON)
-
 import qualified Data.Char as Char
 import qualified Data.CaseInsensitive as CI
 

src/Model/Migration/Types.hs

@@ -2,7 +2,7 @@ module Model.Migration.Types where
 
 import ClassyPrelude.Yesod
 import Data.Aeson
-import Data.Aeson.TH (deriveJSON, defaultOptions)
+import Data.Aeson.TH (deriveJSON)
 
 import Utils.PathPiece
 

src/Model/Rating.hs

@@ -4,8 +4,6 @@ import ClassyPrelude.Yesod
 import Model
 -- import Data.Text (Text)
 import Data.Text.Encoding.Error (UnicodeException(..))
-import GHC.Generics (Generic)
-import Data.Typeable (Typeable)
 
 
 data Rating = Rating

src/Model/Tokens.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Model.Tokens
@@ -23,14 +24,12 @@ import qualified Jose.Jwt as Jose
 import Jose.Jwt.Instances ()
 import Data.Aeson.Types.Instances ()
 
-import Data.HashSet (HashSet)
-
 import qualified Data.HashMap.Strict as HashMap
 import Data.HashMap.Strict.Instances ()
 import Data.HashSet.Instances ()
 import Data.Time.Clock.Instances ()
 
-import Data.Aeson.Types (Parser, (.:?), (.:), (.!=), (.=))
+import Data.Aeson.Types (Parser, (.:?), (.!=))
 import qualified Data.Aeson as JSON
 import qualified Data.Aeson.Types as JSON
 

src/Model/Types/Allocation.hs

@@ -14,7 +14,7 @@ import qualified Data.Vector as Vector
 
 import qualified Data.Map.Strict as Map
   
-import Crypto.Hash (Digest, SHAKE128)
+import Crypto.Hash (SHAKE128)
 
 {-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}
 

src/Model/Types/DateTime.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-|
 Module: Model.Types.DateTime
 Description: Time related types
@@ -20,9 +21,6 @@ import Web.HttpApiData
 
 import Data.Aeson.Types as Aeson
 
-import Time.Types (WeekDay(..))
-import Data.Time.LocalTime (LocalTime, TimeOfDay)
-
 
 ----
 --  Terms, Seaons, anything loosely related to time
@@ -42,6 +40,7 @@ seasonFromChar c
   | c ~= 'W'  = Right Winter
   | otherwise = Left $ "Invalid season character: ‘" <> tshow c <> "’"
   where
+    (~=) :: Char -> Char -> Bool
     (~=) = (==) `on` CI.mk
 
 data TermIdentifier = TermIdentifier
@@ -64,6 +63,7 @@ shortened :: Iso' Integer Integer
 -- ^ Year numbers shortened to two digits
 shortened = iso shorten expand
   where
+    century :: Integer
     century = ($currentYear `div` 100) * 100
     expand year
       | 0 <= year
@@ -189,3 +189,5 @@ deriveJSON defaultOptions
   } ''Occurrences
 derivePersistFieldJSON ''Occurrences
 
+
+nullaryPathPiece ''DayOfWeek camelToPathPiece

src/Model/Types/Exam.hs

@@ -231,6 +231,7 @@ instance Finite ExamGrade
 numberGrade :: Prism' Rational ExamGrade
 numberGrade = prism toNumberGrade fromNumberGrade
   where
+    toNumberGrade :: ExamGrade -> Rational
     toNumberGrade = \case
       Grade50 -> 5.0
       Grade40 -> 4.0
@@ -243,6 +244,7 @@ numberGrade = prism toNumberGrade fromNumberGrade
       Grade17 -> 1.7
       Grade13 -> 1.3
       Grade10 -> 1.0
+    fromNumberGrade :: Rational -> Either Rational ExamGrade
     fromNumberGrade = \case
       5.0 -> Right Grade50
       4.0 -> Right Grade40
@@ -271,7 +273,8 @@ instance Csv.FromField ExamGrade where
     [ parse =<< Csv.parseField x
     , parse . Text.replace "," "." =<< Csv.parseField x -- Ugh.
     ]
-    where parse = maybe (fail "Could not decode PathPiece") return . fromPathPiece
+    where parse :: Text -> Csv.Parser ExamGrade
+          parse = maybe (fail "Could not decode PathPiece") return . fromPathPiece
 
 instance PersistField ExamGrade where
   toPersistValue = PersistRational . review numberGrade