Merge branch 'master' into 85-entfernen-von-vorigen-aufgabenstellungen-eines-ubungsblattes-funktioniert-nicht

package.yaml

@@ -111,6 +111,54 @@ dependencies:
 - mmorph
 - clientsession
 
+other-extensions:
+  - GeneralizedNewtypeDeriving
+  - IncoherentInstances
+  - OverloadedLists
+  - UndecidableInstances
+
+default-extensions:
+  - OverloadedStrings
+  - PartialTypeSignatures
+  - ScopedTypeVariables
+  - TemplateHaskell
+  - QuasiQuotes
+  - CPP
+  - TypeSynonymInstances
+  - KindSignatures
+  - ConstraintKinds
+  - ViewPatterns
+  - TypeOperators
+  - TupleSections
+  - TypeFamilies
+  - GADTs
+  - StandaloneDeriving
+  - RecordWildCards
+  - RankNTypes
+  - PatternGuards
+  - PatternSynonyms
+  - ParallelListComp
+  - NumDecimals
+  - MultiWayIf
+  - NamedFieldPuns
+  - NoImplicitPrelude
+  - LambdaCase
+  - MultiParamTypeClasses
+  - FlexibleContexts
+  - FlexibleInstances
+  - FunctionalDependencies
+  - EmptyDataDecls
+  - ExistentialQuantification
+  - DefaultSignatures
+  - DeriveDataTypeable
+  - DeriveGeneric
+  - DeriveLift
+  - DeriveFunctor
+  - DerivingStrategies
+  - DataKinds
+  - BinaryLiterals
+  - PolyKinds
+
 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.
 library:

src/Application.hs

@@ -1,15 +1,5 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Application
     ( getApplicationDev, getAppDevSettings
     , appMain
@@ -29,7 +19,7 @@ module Application
 import Control.Monad.Logger                 (liftLoc, LoggingT(..), MonadLoggerIO(..))
 import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
                                              pgPoolSize, runSqlPool)
-import Import hiding (Proxy)
+import Import
 import Language.Haskell.TH.Syntax           (qLocation)
 import Network.Wai (Middleware)
 import Network.Wai.Handler.Warp             (Settings, defaultSettings,

src/Auth/Dummy.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , TemplateHaskell
-           , FlexibleContexts
-           , TypeFamilies
-           , OverloadedStrings
-  #-}
-
 module Auth.Dummy
   ( dummyLogin
   , DummyMessage(..)

src/Auth/LDAP.hs

@@ -1,14 +1,3 @@
-{-# LANGUAGE RecordWildCards
-           , OverloadedStrings
-           , TemplateHaskell
-           , ViewPatterns
-           , TypeFamilies
-           , FlexibleContexts
-           , FlexibleInstances
-           , NoImplicitPrelude
-           , ScopedTypeVariables
-  #-}
-
 module Auth.LDAP
   ( campusLogin
   , CampusUserException(..)

src/Auth/PWHash.hs

@@ -1,13 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , QuasiQuotes
-           , TemplateHaskell
-           , ViewPatterns
-           , RecordWildCards
-           , OverloadedStrings
-           , FlexibleContexts
-           , TypeFamilies
-  #-}
-
 module Auth.PWHash
   ( hashLogin
   , PWHashMessage(..)

src/Cron.hs

@@ -1,12 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , PatternGuards
-           , ViewPatterns
-           , DeriveFunctor
-           , TemplateHaskell
-           , NamedFieldPuns
-  #-}
-
 module Cron
   ( CronNextMatch(..)
   , nextCronMatch

src/Cron/Types.hs

@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , DuplicateRecordFields
-  #-}
-
 module Cron.Types
   ( Cron(..), Crontab
   , CronMatch(..)

src/CryptoID.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module CryptoID

src/CryptoID/TH.hs

@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
-
 module CryptoID.TH where
 
 import ClassyPrelude

src/Data/CaseInsensitive/Instances.hs

@@ -1,11 +1,8 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.CaseInsensitive.Instances
-  () where
+  (
+  ) where
 
 import ClassyPrelude.Yesod
 

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

@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ScopedTypeVariables
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.Universe.Instances.Reverse.Hashable

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

@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ScopedTypeVariables
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.Universe.Instances.Reverse.JSON

src/Foundation.hs

@@ -1,17 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE PatternGuards, MultiWayIf #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, FlexibleContexts #-}
 
 module Foundation where
 

src/Handler/Admin.hs

@@ -1,14 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-
 module Handler.Admin where
 
 import Import

src/Handler/Common.hs

@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
 -- | Common handler functions.
 module Handler.Common where
 

src/Handler/Corrections.hs

@@ -1,20 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MultiWayIf, LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE MultiWayIf #-}
-
 module Handler.Corrections where
 
 import Import

src/Handler/Course.hs

@@ -1,18 +1,3 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Handler.Course where
 
 import Import hiding (catMaybes)

src/Handler/CryptoIDDispatch.hs

@@ -1,23 +1,9 @@
-{-# LANGUAGE NoImplicitPrelude
-           , DataKinds
-           , KindSignatures
-           , TypeFamilies
-           , FlexibleInstances
-           , TypeOperators
-           , RankNTypes
-           , PolyKinds
-           , RecordWildCards
-           , MultiParamTypeClasses
-           , ScopedTypeVariables
-           , ViewPatterns
-  #-}
-
 module Handler.CryptoIDDispatch
   ( getCryptoUUIDDispatchR
   , getCryptoFileNameDispatchR
   ) where
 
-import Import hiding (Proxy)
+import Import
 
 import Data.Proxy
 

src/Handler/Home.hs

@@ -1,16 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE IncoherentInstances #-} -- why is this needed? Instance for "display deadline" ought to be clear
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-
 module Handler.Home where
 
 import Import

src/Handler/Profile.hs

@@ -1,17 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MultiWayIf, LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleInstances #-}
-
 module Handler.Profile where
 
 import Import

src/Handler/School.hs

@@ -1,18 +1,3 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Handler.School where
 
 import Import

src/Handler/Sheet.hs

@@ -1,20 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE MultiWayIf, LambdaCase #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
 module Handler.Sheet where
 
 import Import

src/Handler/Submission.hs

@@ -1,21 +1,3 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE ParallelListComp #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE MultiWayIf #-}
-
 module Handler.Submission where
 
 import Import hiding (joinPath)
@@ -314,14 +296,15 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
         , dbtProj = return . dbrOutput
         , dbtStyle = def
         , dbtIdent = "files" :: Text
-        , dbtSorting =  [ ( "path"
+        , dbtSorting = Map.fromList
-                          , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle]
+          [ ( "path"
-                          )
+            , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle]
-                        , ( "time"
+            )
-                          , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
+          , ( "time"
-                          )
+            , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
-                        ]
+            )
-        , dbtFilter = []
+          ]
+        , dbtFilter = Map.empty
         }
   mFileTable <- traverse (fmap snd . dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
 

src/Handler/SystemMessage.hs

@@ -1,17 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , TemplateHaskell
-           , NamedFieldPuns
-           , RecordWildCards
-           , OverloadedStrings
-           , TypeFamilies
-           , ViewPatterns
-           , FlexibleContexts
-           , LambdaCase
-           , MultiParamTypeClasses
-           , QuasiQuotes
-  #-}
-
 module Handler.SystemMessage where
 
 import Import

src/Handler/Term.hs

@@ -1,19 +1,8 @@
-{-# LANGUAGE NoImplicitPrelude
-           , OverloadedStrings
-           , OverloadedLists
-           , RecordWildCards
-           , TemplateHaskell
-           , QuasiQuotes
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , FlexibleContexts
-           , PartialTypeSignatures
-  #-}
-
 module Handler.Term where
 
 import Import
 import Handler.Utils
+import qualified Data.Map as Map
 
 -- import qualified Data.Text as T
 import Yesod.Form.Bootstrap3
@@ -111,30 +100,32 @@ getTermShowR = do
         { dbtSQLQuery = termData
         , dbtColonnade = colonnadeTerms
         , dbtProj = return . dbrOutput
-        , dbtSorting = [ ( "start"
+        , dbtSorting = Map.fromList
-                         , SortColumn $ \term -> term E.^. TermStart
+            [ ( "start"
-                         )
+              , SortColumn $ \term -> term E.^. TermStart
-                       , ( "end"
+              )
-                         , SortColumn $ \term -> term E.^. TermEnd
+            , ( "end"
-                         )
+              , SortColumn $ \term -> term E.^. TermEnd
-                       , ( "lecture-start"
+              )
-                         , SortColumn $ \term -> term E.^. TermLectureStart
+            , ( "lecture-start"
-                         )
+              , SortColumn $ \term -> term E.^. TermLectureStart
-                       , ( "lecture-end"
+              )
-                         , SortColumn $ \term -> term E.^. TermLectureEnd
+            , ( "lecture-end"
-                         )
+              , SortColumn $ \term -> term E.^. TermLectureEnd
-                       ]
+              )
-        , dbtFilter = [ ( "active"
+            ]
-                        , FilterColumn $ \term -> (term E.^. TermActive :: E.SqlExpr (E.Value Bool))
+        , dbtFilter = Map.fromList
-                        )
+            [ ( "active"
-                      , ( "course"
+              , FilterColumn $ \term -> (term E.^. TermActive :: E.SqlExpr (E.Value Bool))
-                        , FilterColumn $ \term csh -> case csh of -- FilterColumn-Lambdas are 
+              )
-                            []   -> E.val True :: E.SqlExpr (E.Value Bool)
+            , ( "course"
-                            cshs -> E.exists . E.from $ \course -> do
+              , FilterColumn $ \term csh -> case csh of -- FilterColumn-Lambdas are 
-                              E.where_ $ course E.^. CourseTerm E.==. term E.^. TermId
+                  []   -> E.val True :: E.SqlExpr (E.Value Bool)
-                                   E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
+                  cshs -> E.exists . E.from $ \course -> do
-                        )
+                    E.where_ $ course E.^. CourseTerm E.==. term E.^. TermId
-                      ]
+                         E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
+              )
+            ]
         , dbtStyle = def
         , dbtIdent = "terms" :: Text
         }

src/Handler/Users.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-
 module Handler.Users where
 
 import Import

src/Handler/Utils.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-
-
 module Handler.Utils
   ( module Handler.Utils
   ) where

src/Handler/Utils/DateTime.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , OverloadedStrings
-           , RecordWildCards
-           , TypeFamilies
-  #-}
-
 module Handler.Utils.DateTime
   ( utcToLocalTime
   , localTimeToUTC, TZ.LocalToUTCResult(..)

src/Handler/Utils/Form.hs

@@ -1,17 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE LambdaCase #-}
-
 module Handler.Utils.Form
   ( module Handler.Utils.Form
   , module Utils.Form

src/Handler/Utils/Form/Types.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-
 module Handler.Utils.Form.Types where
 
 import Import

src/Handler/Utils/Mail.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , NamedFieldPuns
-           , TypeFamilies
-           , FlexibleContexts
-           , ViewPatterns
-           , LambdaCase
-  #-}
-
 module Handler.Utils.Mail
   ( addRecipientsDB
   , userMailT

src/Handler/Utils/Rating.hs

@@ -1,16 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
-
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 module Handler.Utils.Rating
   ( Rating(..), Rating'(..)

src/Handler/Utils/Sheet.hs

@@ -1,13 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-
 module Handler.Utils.Sheet where
 
 import Import

src/Handler/Utils/StudyFeatures.hs

@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-  #-}
-
 module Handler.Utils.StudyFeatures
   ( parseStudyFeatures
   ) where

src/Handler/Utils/Submission.hs

@@ -1,19 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiWayIf #-}
-
-
 module Handler.Utils.Submission
   ( AssignSubmissionException(..)
   , assignSubmissions

src/Handler/Utils/Submission/TH.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , ViewPatterns
-           , OverloadedStrings
-           , StandaloneDeriving
-           , DeriveLift
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Handler.Utils.Submission.TH

src/Handler/Utils/Table.hs

@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies #-}
-
 module Handler.Utils.Table where
 -- General Utilities for Tables
 

src/Handler/Utils/Table/Cells.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Handler.Utils.Table.Cells where
 
 import Import

src/Handler/Utils/Table/Pagination.hs

@@ -1,23 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ExistentialQuantification
-           , RecordWildCards
-           , NamedFieldPuns
-           , OverloadedStrings
-           , TemplateHaskell
-           , QuasiQuotes
-           , LambdaCase
-           , ViewPatterns
-           , FlexibleContexts
-           , FlexibleInstances
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , ScopedTypeVariables
-           , TupleSections
-           , RankNTypes
-           , MultiWayIf
-           , FunctionalDependencies
-  #-}
-
 module Handler.Utils.Table.Pagination
   ( SortColumn(..), SortDirection(..)
   , FilterColumn(..), IsFilterColumn
@@ -47,7 +27,7 @@ module Handler.Utils.Table.Pagination
 import Handler.Utils.Table.Pagination.Types
 import Utils.Lens.TH
 
-import Import hiding (Proxy(..))
+import Import
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect,unsafeSqlValue)
 import qualified Database.Esqueleto.Internal.Language as E (From)

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

@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ExistentialQuantification
-           , RankNTypes
-           , RecordWildCards
-  #-}
-
 module Handler.Utils.Table.Pagination.Types where
 
 import Import hiding (singleton)

src/Handler/Utils/Templates.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude, TemplateHaskell, QuasiQuotes #-}
-
 module Handler.Utils.Templates where
 
 import Data.Either (isLeft)

src/Handler/Utils/Zip.hs

@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- This concerns zipEntrySize in produceZip
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 

src/Import/NoFoundation.hs

@@ -1,10 +1,9 @@
-{-# LANGUAGE CPP #-}
 module Import.NoFoundation
     ( module Import
     , MForm
     ) where
 
-import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm)
+import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy)
 import Model                  as Import
 import Model.Types.JSON       as Import
 import Model.Migration        as Import

src/Jobs.hs

@@ -1,29 +1,14 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , TemplateHaskell
-           , OverloadedStrings
-           , FlexibleContexts
-           , ViewPatterns
-           , TypeFamilies
-           , DeriveGeneric
-           , DeriveDataTypeable
-           , QuasiQuotes
-           , NamedFieldPuns
-           , MultiWayIf
-  #-}
-
 module Jobs
   ( module Types
   , module Jobs.Queue
   , handleJobs
   ) where
 
-import Import hiding (Proxy)
+import Import
 
 import Jobs.Types as Types hiding (JobCtl(JobCtlQueue))
 import Jobs.Types (JobCtl(JobCtlQueue))
 import Jobs.Queue
-import Jobs.TH
 import Jobs.Crontab
 
 import Data.Conduit.TMChan

src/Jobs/Crontab.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , FlexibleContexts
-           , MultiWayIf
-           , NamedFieldPuns
-           , TypeFamilies
-  #-}
-
 module Jobs.Crontab
   ( determineCrontab
   ) where

src/Jobs/Handler/HelpRequest.hs

@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , RecordWildCards
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.HelpRequest
   ( dispatchJobHelpRequest
   ) where

src/Jobs/Handler/QueueNotification.hs

@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-  #-}
-
 module Jobs.Handler.QueueNotification
   ( dispatchJobQueueNotification
   ) where

src/Jobs/Handler/SendNotification.hs

@@ -1,14 +1,9 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-  #-}
-
 module Jobs.Handler.SendNotification
   ( dispatchJobSendNotification
   ) where
 
 import Import
 
-import Jobs.TH
 import Jobs.Types
 
 

src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.CorrectionsAssigned
   ( dispatchNotificationCorrectionsAssigned
   ) where

src/Jobs/Handler/SendNotification/SheetActive.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.SheetActive
   ( dispatchNotificationSheetActive
   ) where

src/Jobs/Handler/SendNotification/SheetInactive.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.SheetInactive
   ( dispatchNotificationSheetSoonInactive
   , dispatchNotificationSheetInactive

src/Jobs/Handler/SendNotification/SubmissionRated.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.SubmissionRated
   ( dispatchNotificationSubmissionRated
   ) where

src/Jobs/Handler/SendTestEmail.hs

@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , QuasiQuotes
-  #-}
-
 module Jobs.Handler.SendTestEmail
   ( dispatchJobSendTestEmail
   ) where

src/Jobs/Handler/SetLogSettings.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-  #-}
-
 module Jobs.Handler.SetLogSettings
   ( dispatchJobSetLogSettings
   ) where

src/Jobs/Queue.hs

@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TypeFamilies
-  #-}
-
 module Jobs.Queue
   ( writeJobCtl, writeJobCtlBlock
   , queueJob, queueJob'

src/Jobs/TH.hs

@@ -1,29 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , QuasiQuotes
-           , RecordWildCards
-  #-}
-
-module Jobs.TH
-  ( dispatchTH
-  ) where
-
-import ClassyPrelude
-
-import Language.Haskell.TH
-import Language.Haskell.TH.Datatype
-
-import Data.List (foldl)
-
-
-dispatchTH :: Name -- ^ Datatype to pattern match
-           -> ExpQ
-dispatchTH dType = do
-  DatatypeInfo{..} <- reifyDatatype dType
-  let
-    matches = map mkMatch datatypeCons
-    mkMatch ConstructorInfo{..} = do
-      pats <- forM constructorFields $ \_ -> newName "x"
-      let fName = mkName $ "dispatch" <> nameBase constructorName
-      match (conP constructorName $ map varP pats) (normalB $ foldl (\e pat -> e `appE` varE pat) (varE fName) pats) []
-  lamCaseE matches

src/Jobs/Types.hs

@@ -1,9 +1,3 @@
-{-# LANGUAGE TemplateHaskell
-           , NoImplicitPrelude
-           , DeriveGeneric
-           , DeriveDataTypeable
-  #-}
-
 module Jobs.Types
   ( Job(..), Notification(..)
   , JobCtl(..)

src/Mail.hs

@@ -1,22 +1,5 @@
-{-# LANGUAGE NoImplicitPrelude
+{-# LANGUAGE GeneralizedNewtypeDeriving
-           , GeneralizedNewtypeDeriving
-           , DerivingStrategies
-           , FlexibleInstances
-           , MultiParamTypeClasses
            , UndecidableInstances
-           , DeriveGeneric
-           , TemplateHaskell
-           , OverloadedStrings
-           , RecordWildCards
-           , FlexibleContexts
-           , TypeFamilies
-           , ViewPatterns
-           , NamedFieldPuns
-           , MultiWayIf
-           , QuasiQuotes
-           , RankNTypes
-           , ScopedTypeVariables
-           , DeriveDataTypeable
   #-}
 
 module Mail

src/Model.hs

@@ -1,17 +1,4 @@
-{-# LANGUAGE EmptyDataDecls             #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE StandaloneDeriving         #-}
-
 
 module Model
   ( module Model
@@ -45,11 +32,5 @@ share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll
 -- (Eq Course) is impossible so we derive it for the Uniqueness Constraint only
 deriving instance Eq (Unique Course)
 
-data PWEntry = PWEntry
-  { pwUser :: User
-  , pwHash :: Text
-  } deriving (Show)
-$(deriveJSON defaultOptions ''PWEntry)
-
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime

src/Model/Migration.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
 module Model.Migration
   ( migrateAll
   ) where

src/Model/Migration/Version.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveLift, DeriveGeneric, DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Migration.Version

src/Model/Types.hs

@@ -1,16 +1,6 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving
-{-# LANGUAGE PatternGuards #-}
+           , UndecidableInstances
-{-# LANGUAGE LambdaCase #-}
+  #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE BinaryLiterals #-}
-{-# LANGUAGE MultiWayIf #-}
-{-- # LANGUAGE ExistentialQuantification #-} -- for DA type
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- for instance PathPiece (CI Text)
 
 module Model.Types

src/Model/Types/JSON.hs

@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-
 module Model.Types.JSON
   ( derivePersistFieldJSON
   ) where

src/Model/Types/Wordlist.hs

@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , ViewPatterns
-           , OverloadedStrings
-  #-}
-
 module Model.Types.Wordlist (wordlist) where
 
 import ClassyPrelude hiding (lift)

src/Settings.hs

@@ -1,17 +1,5 @@
-{-# LANGUAGE CPP                #-}
-{-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RecordWildCards    #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE MultiWayIf         #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 -- | Settings are centralized, as much as possible, into this file. This
 -- includes database connection settings, static file locations, etc.
 -- In addition, you can configure a number of different aspects of Yesod
@@ -22,7 +10,7 @@ module Settings
   , module Settings.Cluster
   ) where
 
-import           ClassyPrelude.Yesod hiding (Proxy)
+import           ClassyPrelude.Yesod
 import Data.UUID (UUID)
 import qualified Control.Exception           as Exception
 import           Data.Aeson                  (Result (..), fromJSON, withObject

src/Settings/Cluster.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , DataKinds
-           , TypeFamilies
-           , ScopedTypeVariables
-           , TemplateHaskell
-           , OverloadedStrings
-           , FlexibleContexts
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Settings.Cluster

src/Settings/StaticFiles.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
 module Settings.StaticFiles where
 
 import Settings     (appStaticDir, compileTimeAppSettings)

src/Utils.hs

@@ -1,12 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
-{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- Monad FormResult
 
 module Utils

src/Utils/DB.hs

@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
-{-# LANGUAGE QuasiQuotes #-}
-
 module Utils.DB where
 
 import ClassyPrelude.Yesod

src/Utils/DateTime.hs

@@ -1,15 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-           , TemplateHaskell
-           , QuasiQuotes
-           , StandaloneDeriving
-           , DerivingStrategies
-           , DeriveLift
-           , DeriveDataTypeable
-           , DeriveGeneric
-           , GeneralizedNewtypeDeriving
-           , OverloadedStrings
-           , FlexibleInstances
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Utils.DateTime

src/Utils/Form.hs

@@ -1,18 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , ViewPatterns
-           , OverloadedStrings
-           , QuasiQuotes
-           , TemplateHaskell
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , FlexibleContexts
-           , NamedFieldPuns
-           , ScopedTypeVariables
-           , MultiWayIf
-           , RecordWildCards
-#-}
-
 module Utils.Form where
 
 import ClassyPrelude.Yesod hiding (addMessage)

src/Utils/Lang.hs

@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
 module Utils.Lang where
 
 import ClassyPrelude.Yesod

src/Utils/Lens.hs

@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
 module Utils.Lens ( module Utils.Lens ) where
 
 import Import.NoFoundation

src/Utils/Message.hs

@@ -1,10 +1,3 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DeriveLift #-}
-
-
 module Utils.Message
   ( MessageClass(..)
   , addMessage, addMessageI, addMessageIHamlet, addMessageFile

src/Utils/PathPiece.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-  #-}
-
 module Utils.PathPiece
   ( finiteFromPathPiece
   , nullaryToPathPiece

src/Utils/Sql.hs

@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NumDecimals #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Utils.Sql
   ( setSerializable
   ) where

src/Utils/SystemMessage.hs

@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-  #-}
-
 module Utils.SystemMessage where
 
 import Import.NoFoundation

src/Utils/TH.hs

@@ -1,9 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
 module Utils.TH where
 -- Common Utility Functions that require TemplateHaskell
 
@@ -142,3 +136,16 @@ embedRenderMessageVariant f newT mangle = do
       ]
     ]
   
+
+dispatchTH :: Name -- ^ Datatype to pattern match
+           -> ExpQ
+-- ^ Produces a lambda-case-expression matching all constructors of the named datatype and calling a function (named after the constructor prefixed with @dispatch@) on the fields of each constructor
+dispatchTH dType = do
+  DatatypeInfo{..} <- reifyDatatype dType
+  let
+    matches = map mkMatch datatypeCons
+    mkMatch ConstructorInfo{..} = do
+      pats <- forM constructorFields $ \_ -> newName "x"
+      let fName = mkName $ "dispatch" <> nameBase constructorName
+      match (conP constructorName $ map varP pats) (normalB $ foldl (\e pat -> e `appE` varE pat) (varE fName) pats) []
+  lamCaseE matches