From eff7875c1c0cb2226283c14aac6f9cf85e915672 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 28 Oct 2018 19:11:40 +0100 Subject: [PATCH] Cleanup language extensions --- package.yaml | 48 ++++++++++++++ src/Application.hs | 14 +---- src/Auth/Dummy.hs | 8 --- src/Auth/LDAP.hs | 11 ---- src/Auth/PWHash.hs | 10 --- src/Cron.hs | 9 --- src/Cron/Types.hs | 5 -- src/CryptoID.hs | 8 --- src/CryptoID/TH.hs | 4 -- src/Data/CaseInsensitive/Instances.hs | 7 +-- .../Universe/Instances/Reverse/Hashable.hs | 3 - src/Data/Universe/Instances/Reverse/JSON.hs | 3 - src/Foundation.hs | 15 +---- src/Handler/Admin.hs | 11 ---- src/Handler/Common.hs | 5 -- src/Handler/Corrections.hs | 17 ----- src/Handler/Course.hs | 15 ----- src/Handler/CryptoIDDispatch.hs | 16 +---- src/Handler/Home.hs | 13 ---- src/Handler/Profile.hs | 14 ----- src/Handler/School.hs | 15 ----- src/Handler/Sheet.hs | 17 ----- src/Handler/Submission.hs | 35 +++-------- src/Handler/SystemMessage.hs | 14 ----- src/Handler/Term.hs | 63 ++++++++----------- src/Handler/Users.hs | 8 --- src/Handler/Utils.hs | 7 --- src/Handler/Utils/DateTime.hs | 7 --- src/Handler/Utils/Form.hs | 14 ----- src/Handler/Utils/Form/Types.hs | 2 - src/Handler/Utils/Mail.hs | 8 --- src/Handler/Utils/Rating.hs | 12 ---- src/Handler/Utils/Sheet.hs | 10 --- src/Handler/Utils/StudyFeatures.hs | 4 -- src/Handler/Utils/Submission.hs | 16 ----- src/Handler/Utils/Submission/TH.hs | 7 --- src/Handler/Utils/Table.hs | 5 -- src/Handler/Utils/Table/Cells.hs | 7 --- src/Handler/Utils/Table/Pagination.hs | 22 +------ src/Handler/Utils/Table/Pagination/Types.hs | 6 -- src/Handler/Utils/Templates.hs | 2 - src/Handler/Utils/Zip.hs | 4 -- src/Import/NoFoundation.hs | 3 +- src/Jobs.hs | 17 +---- src/Jobs/Crontab.hs | 8 --- src/Jobs/Handler/HelpRequest.hs | 6 -- src/Jobs/Handler/QueueNotification.hs | 5 -- src/Jobs/Handler/SendNotification.hs | 5 -- .../SendNotification/CorrectionsAssigned.hs | 7 --- .../Handler/SendNotification/SheetActive.hs | 7 --- .../Handler/SendNotification/SheetInactive.hs | 9 +-- .../SendNotification/SubmissionRated.hs | 7 --- src/Jobs/Handler/SendTestEmail.hs | 6 -- src/Jobs/Handler/SetLogSettings.hs | 3 - src/Jobs/Queue.hs | 4 -- src/Jobs/TH.hs | 29 --------- src/Jobs/Types.hs | 6 -- src/Mail.hs | 19 +----- src/Model.hs | 19 ------ src/Model/Migration.hs | 8 --- src/Model/Migration/Version.hs | 7 --- src/Model/Types.hs | 16 +---- src/Model/Types/JSON.hs | 4 -- src/Model/Types/Wordlist.hs | 6 -- src/Settings.hs | 16 +---- src/Settings/Cluster.hs | 8 --- src/Settings/StaticFiles.hs | 3 - src/Utils.hs | 9 --- src/Utils/DB.hs | 5 -- src/Utils/DateTime.hs | 13 +--- src/Utils/Form.hs | 15 ----- src/Utils/Lang.hs | 4 -- src/Utils/Lens.hs | 5 -- src/Utils/Message.hs | 7 --- src/Utils/PathPiece.hs | 3 - src/Utils/Sql.hs | 8 --- src/Utils/SystemMessage.hs | 4 -- src/Utils/TH.hs | 19 ++++-- 78 files changed, 114 insertions(+), 727 deletions(-) delete mode 100644 src/Jobs/TH.hs diff --git a/package.yaml b/package.yaml index 44695edb0..246f6bcf3 100644 --- a/package.yaml +++ b/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: diff --git a/src/Application.hs b/src/Application.hs index 0e7c7e211..3757d98f7 100644 --- a/src/Application.hs +++ b/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, diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index 809db8647..df4ab5e40 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , TemplateHaskell - , FlexibleContexts - , TypeFamilies - , OverloadedStrings - #-} - module Auth.Dummy ( dummyLogin , DummyMessage(..) diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 32c185519..2b053ce05 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -1,14 +1,3 @@ -{-# LANGUAGE RecordWildCards - , OverloadedStrings - , TemplateHaskell - , ViewPatterns - , TypeFamilies - , FlexibleContexts - , FlexibleInstances - , NoImplicitPrelude - , ScopedTypeVariables - #-} - module Auth.LDAP ( campusLogin , CampusUserException(..) diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index ba7198710..3efad0d32 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -1,13 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , QuasiQuotes - , TemplateHaskell - , ViewPatterns - , RecordWildCards - , OverloadedStrings - , FlexibleContexts - , TypeFamilies - #-} - module Auth.PWHash ( hashLogin , PWHashMessage(..) diff --git a/src/Cron.hs b/src/Cron.hs index 2620aec12..cb2d9a338 100644 --- a/src/Cron.hs +++ b/src/Cron.hs @@ -1,12 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , PatternGuards - , ViewPatterns - , DeriveFunctor - , TemplateHaskell - , NamedFieldPuns - #-} - module Cron ( CronNextMatch(..) , nextCronMatch diff --git a/src/Cron/Types.hs b/src/Cron/Types.hs index fa95477f0..ab3e92972 100644 --- a/src/Cron/Types.hs +++ b/src/Cron/Types.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , TemplateHaskell - , DuplicateRecordFields - #-} - module Cron.Types ( Cron(..), Crontab , CronMatch(..) diff --git a/src/CryptoID.hs b/src/CryptoID.hs index 58f68171e..6d4163982 100644 --- a/src/CryptoID.hs +++ b/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 diff --git a/src/CryptoID/TH.hs b/src/CryptoID/TH.hs index 23122dadf..589c30637 100644 --- a/src/CryptoID/TH.hs +++ b/src/CryptoID/TH.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ViewPatterns #-} - module CryptoID.TH where import ClassyPrelude diff --git a/src/Data/CaseInsensitive/Instances.hs b/src/Data/CaseInsensitive/Instances.hs index ea5253f44..214283124 100644 --- a/src/Data/CaseInsensitive/Instances.hs +++ b/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 diff --git a/src/Data/Universe/Instances/Reverse/Hashable.hs b/src/Data/Universe/Instances/Reverse/Hashable.hs index e7459f613..d264fa41f 100644 --- a/src/Data/Universe/Instances/Reverse/Hashable.hs +++ b/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 diff --git a/src/Data/Universe/Instances/Reverse/JSON.hs b/src/Data/Universe/Instances/Reverse/JSON.hs index 60b7ba6ae..14c7d04fa 100644 --- a/src/Data/Universe/Instances/Reverse/JSON.hs +++ b/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 diff --git a/src/Foundation.hs b/src/Foundation.hs index 78ff9dc21..10de66a02 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1,17 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# 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 #-} +{-# LANGUAGE UndecidableInstances #-} module Foundation where diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 46d65d29f..50b1963e7 100644 --- a/src/Handler/Admin.hs +++ b/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 diff --git a/src/Handler/Common.hs b/src/Handler/Common.hs index 2119bfb06..390b041e1 100644 --- a/src/Handler/Common.hs +++ b/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 diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 9814f6d75..c1961857e 100644 --- a/src/Handler/Corrections.hs +++ b/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 diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 044f9b391..c9262a2b6 100644 --- a/src/Handler/Course.hs +++ b/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) diff --git a/src/Handler/CryptoIDDispatch.hs b/src/Handler/CryptoIDDispatch.hs index 9a744f208..54c2ec760 100644 --- a/src/Handler/CryptoIDDispatch.hs +++ b/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 diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 458e3d766..8c93c4a17 100644 --- a/src/Handler/Home.hs +++ b/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 diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 86e03d26e..3b16c186d 100644 --- a/src/Handler/Profile.hs +++ b/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 diff --git a/src/Handler/School.hs b/src/Handler/School.hs index 9952a682d..92f0d2ec0 100644 --- a/src/Handler/School.hs +++ b/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 diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index e001b3a84..6150a1d54 100644 --- a/src/Handler/Sheet.hs +++ b/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 diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 5055f6f26..25cac807d 100644 --- a/src/Handler/Submission.hs +++ b/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" - , 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))) - ) - ] - , dbtFilter = [] + , dbtSorting = Map.fromList + [ ( "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))) + ) + ] + , dbtFilter = Map.empty } mFileTable <- traverse (fmap snd . dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs index 801b0b194..487b79331 100644 --- a/src/Handler/SystemMessage.hs +++ b/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 diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 1720eec1f..611a4cc9a 100644 --- a/src/Handler/Term.hs +++ b/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" - , SortColumn $ \term -> term E.^. TermStart - ) - , ( "end" - , SortColumn $ \term -> term E.^. TermEnd - ) - , ( "lecture-start" - , SortColumn $ \term -> term E.^. TermLectureStart - ) - , ( "lecture-end" - , SortColumn $ \term -> term E.^. TermLectureEnd - ) - ] - , dbtFilter = [ ( "active" - , FilterColumn $ \term -> (term E.^. TermActive :: E.SqlExpr (E.Value Bool)) - ) - , ( "course" - , FilterColumn $ \term csh -> case csh of -- FilterColumn-Lambdas are - [] -> E.val True :: E.SqlExpr (E.Value Bool) - 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 - ) - ] + , dbtSorting = Map.fromList + [ ( "start" + , SortColumn $ \term -> term E.^. TermStart + ) + , ( "end" + , SortColumn $ \term -> term E.^. TermEnd + ) + , ( "lecture-start" + , SortColumn $ \term -> term E.^. TermLectureStart + ) + , ( "lecture-end" + , SortColumn $ \term -> term E.^. TermLectureEnd + ) + ] + , dbtFilter = Map.fromList + [ ( "active" + , FilterColumn $ \term -> (term E.^. TermActive :: E.SqlExpr (E.Value Bool)) + ) + , ( "course" + , FilterColumn $ \term csh -> case csh of -- FilterColumn-Lambdas are + [] -> E.val True :: E.SqlExpr (E.Value Bool) + 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 } diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 8208d1a1f..0b6fb1c87 100644 --- a/src/Handler/Users.hs +++ b/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 diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 2a5c6a160..da07f0477 100644 --- a/src/Handler/Utils.hs +++ b/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 diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index 67acd6a32..dcacedadb 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , TemplateHaskell - , OverloadedStrings - , RecordWildCards - , TypeFamilies - #-} - module Handler.Utils.DateTime ( utcToLocalTime , localTimeToUTC, TZ.LocalToUTCResult(..) diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index c7b7aee21..fbfd9f8dc 100644 --- a/src/Handler/Utils/Form.hs +++ b/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 diff --git a/src/Handler/Utils/Form/Types.hs b/src/Handler/Utils/Form/Types.hs index 386f029a0..16c8f0af6 100644 --- a/src/Handler/Utils/Form/Types.hs +++ b/src/Handler/Utils/Form/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} - module Handler.Utils.Form.Types where import Import diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs index 96ef448e0..4ade0952d 100644 --- a/src/Handler/Utils/Mail.hs +++ b/src/Handler/Utils/Mail.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , NamedFieldPuns - , TypeFamilies - , FlexibleContexts - , ViewPatterns - , LambdaCase - #-} - module Handler.Utils.Mail ( addRecipientsDB , userMailT diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index 7702a7d52..b2b0d8a1e 100644 --- a/src/Handler/Utils/Rating.hs +++ b/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'(..) diff --git a/src/Handler/Utils/Sheet.hs b/src/Handler/Utils/Sheet.hs index d38d2e10a..e535eab8b 100644 --- a/src/Handler/Utils/Sheet.hs +++ b/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 diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs index e4e8b38c7..75a82053b 100644 --- a/src/Handler/Utils/StudyFeatures.hs +++ b/src/Handler/Utils/StudyFeatures.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - #-} - module Handler.Utils.StudyFeatures ( parseStudyFeatures ) where diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 9f67bf0e0..78f836f46 100644 --- a/src/Handler/Utils/Submission.hs +++ b/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 diff --git a/src/Handler/Utils/Submission/TH.hs b/src/Handler/Utils/Submission/TH.hs index 99de8a01f..0b24a4da1 100644 --- a/src/Handler/Utils/Submission/TH.hs +++ b/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 diff --git a/src/Handler/Utils/Table.hs b/src/Handler/Utils/Table.hs index 478bd58ff..d784d1cdc 100644 --- a/src/Handler/Utils/Table.hs +++ b/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 diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 65bc11452..8b7da8308 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index ff2e81f64..f36fba523 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/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) diff --git a/src/Handler/Utils/Table/Pagination/Types.hs b/src/Handler/Utils/Table/Pagination/Types.hs index 0a0b6c1c2..6bc9e1286 100644 --- a/src/Handler/Utils/Table/Pagination/Types.hs +++ b/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) diff --git a/src/Handler/Utils/Templates.hs b/src/Handler/Utils/Templates.hs index 57ab0f1d6..bdd82db86 100644 --- a/src/Handler/Utils/Templates.hs +++ b/src/Handler/Utils/Templates.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude, TemplateHaskell, QuasiQuotes #-} - module Handler.Utils.Templates where import Data.Either (isLeft) diff --git a/src/Handler/Utils/Zip.hs b/src/Handler/Utils/Zip.hs index fb196c933..f1e5f5d7e 100644 --- a/src/Handler/Utils/Zip.hs +++ b/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 #-} diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs index 45c6c2d6a..51f05a9cb 100644 --- a/src/Import/NoFoundation.hs +++ b/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 diff --git a/src/Jobs.hs b/src/Jobs.hs index f89265009..112a1376f 100644 --- a/src/Jobs.hs +++ b/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 diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index ad0fecc21..abee018f4 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , FlexibleContexts - , MultiWayIf - , NamedFieldPuns - , TypeFamilies - #-} - module Jobs.Crontab ( determineCrontab ) where diff --git a/src/Jobs/Handler/HelpRequest.hs b/src/Jobs/Handler/HelpRequest.hs index 0e03587a2..73642e90b 100644 --- a/src/Jobs/Handler/HelpRequest.hs +++ b/src/Jobs/Handler/HelpRequest.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , TemplateHaskell - , RecordWildCards - , OverloadedStrings - #-} - module Jobs.Handler.HelpRequest ( dispatchJobHelpRequest ) where diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 024d57682..444ffe935 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , NamedFieldPuns - #-} - module Jobs.Handler.QueueNotification ( dispatchJobQueueNotification ) where diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index a554bcfa8..529042a46 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/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 diff --git a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs index 6b7ed47d8..15f7a0289 100644 --- a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs +++ b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , NamedFieldPuns - , TemplateHaskell - , OverloadedStrings - #-} - module Jobs.Handler.SendNotification.CorrectionsAssigned ( dispatchNotificationCorrectionsAssigned ) where diff --git a/src/Jobs/Handler/SendNotification/SheetActive.hs b/src/Jobs/Handler/SendNotification/SheetActive.hs index aaedcb7a6..0de2ff787 100644 --- a/src/Jobs/Handler/SendNotification/SheetActive.hs +++ b/src/Jobs/Handler/SendNotification/SheetActive.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , NamedFieldPuns - , TemplateHaskell - , OverloadedStrings - #-} - module Jobs.Handler.SendNotification.SheetActive ( dispatchNotificationSheetActive ) where diff --git a/src/Jobs/Handler/SendNotification/SheetInactive.hs b/src/Jobs/Handler/SendNotification/SheetInactive.hs index 6873d2b28..99248e777 100644 --- a/src/Jobs/Handler/SendNotification/SheetInactive.hs +++ b/src/Jobs/Handler/SendNotification/SheetInactive.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , NamedFieldPuns - , TemplateHaskell - , OverloadedStrings - #-} - module Jobs.Handler.SendNotification.SheetInactive ( dispatchNotificationSheetSoonInactive , dispatchNotificationSheetInactive @@ -55,4 +48,4 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do addAlternatives $ do let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) - \ No newline at end of file + diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs index 885dc8bfe..fd7543f47 100644 --- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs +++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , NamedFieldPuns - , TemplateHaskell - , OverloadedStrings - #-} - module Jobs.Handler.SendNotification.SubmissionRated ( dispatchNotificationSubmissionRated ) where diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs index 4b2865fdd..b66bbb471 100644 --- a/src/Jobs/Handler/SendTestEmail.hs +++ b/src/Jobs/Handler/SendTestEmail.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - , NamedFieldPuns - , QuasiQuotes - #-} - module Jobs.Handler.SendTestEmail ( dispatchJobSendTestEmail ) where diff --git a/src/Jobs/Handler/SetLogSettings.hs b/src/Jobs/Handler/SetLogSettings.hs index 01c8d618f..a7bf40f6c 100644 --- a/src/Jobs/Handler/SetLogSettings.hs +++ b/src/Jobs/Handler/SetLogSettings.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - #-} - module Jobs.Handler.SetLogSettings ( dispatchJobSetLogSettings ) where diff --git a/src/Jobs/Queue.hs b/src/Jobs/Queue.hs index d72734aeb..db5f2d8e5 100644 --- a/src/Jobs/Queue.hs +++ b/src/Jobs/Queue.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , TypeFamilies - #-} - module Jobs.Queue ( writeJobCtl, writeJobCtlBlock , queueJob, queueJob' diff --git a/src/Jobs/TH.hs b/src/Jobs/TH.hs deleted file mode 100644 index 47e69f62d..000000000 --- a/src/Jobs/TH.hs +++ /dev/null @@ -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 diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 63b947a69..20af81933 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE TemplateHaskell - , NoImplicitPrelude - , DeriveGeneric - , DeriveDataTypeable - #-} - module Jobs.Types ( Job(..), Notification(..) , JobCtl(..) diff --git a/src/Mail.hs b/src/Mail.hs index c812bc583..cbbc1c933 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -1,22 +1,5 @@ -{-# LANGUAGE NoImplicitPrelude - , GeneralizedNewtypeDeriving - , DerivingStrategies - , FlexibleInstances - , MultiParamTypeClasses +{-# LANGUAGE GeneralizedNewtypeDeriving , UndecidableInstances - , DeriveGeneric - , TemplateHaskell - , OverloadedStrings - , RecordWildCards - , FlexibleContexts - , TypeFamilies - , ViewPatterns - , NamedFieldPuns - , MultiWayIf - , QuasiQuotes - , RankNTypes - , ScopedTypeVariables - , DeriveDataTypeable #-} module Mail diff --git a/src/Model.hs b/src/Model.hs index bd56ab5a2..15da993f1 100644 --- a/src/Model.hs +++ b/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 @@ -44,12 +31,6 @@ 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 diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index bd6be6098..bdc362560 100644 --- a/src/Model/Migration.hs +++ b/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 diff --git a/src/Model/Migration/Version.hs b/src/Model/Migration/Version.hs index 37bbd8f3f..2bc5579c9 100644 --- a/src/Model/Migration/Version.hs +++ b/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 diff --git a/src/Model/Types.hs b/src/Model/Types.hs index b4d3a41c5..0b10e1fb0 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -1,16 +1,6 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE PatternGuards #-} -{-# 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 +{-# LANGUAGE GeneralizedNewtypeDeriving + , UndecidableInstances + #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- for instance PathPiece (CI Text) module Model.Types diff --git a/src/Model/Types/JSON.hs b/src/Model/Types/JSON.hs index dc5a5eec6..4e2927edb 100644 --- a/src/Model/Types/JSON.hs +++ b/src/Model/Types/JSON.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} - module Model.Types.JSON ( derivePersistFieldJSON ) where diff --git a/src/Model/Types/Wordlist.hs b/src/Model/Types/Wordlist.hs index d4bab9e8c..5e35d7f25 100644 --- a/src/Model/Types/Wordlist.hs +++ b/src/Model/Types/Wordlist.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , TemplateHaskell - , ViewPatterns - , OverloadedStrings - #-} - module Model.Types.Wordlist (wordlist) where import ClassyPrelude hiding (lift) diff --git a/src/Settings.hs b/src/Settings.hs index da5fc9336..82b7f7ec0 100644 --- a/src/Settings.hs +++ b/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 diff --git a/src/Settings/Cluster.hs b/src/Settings/Cluster.hs index 94bce92e0..25552d4a6 100644 --- a/src/Settings/Cluster.hs +++ b/src/Settings/Cluster.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , DataKinds - , TypeFamilies - , ScopedTypeVariables - , TemplateHaskell - , OverloadedStrings - , FlexibleContexts - #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Settings.Cluster diff --git a/src/Settings/StaticFiles.hs b/src/Settings/StaticFiles.hs index 0cefeaa1d..c8021d3a5 100644 --- a/src/Settings/StaticFiles.hs +++ b/src/Settings/StaticFiles.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module Settings.StaticFiles where import Settings (appStaticDir, compileTimeAppSettings) diff --git a/src/Utils.hs b/src/Utils.hs index 17795138c..a95c79722 100644 --- a/src/Utils.hs +++ b/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 diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs index 69d230275..4e6c83a1c 100644 --- a/src/Utils/DB.hs +++ b/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 diff --git a/src/Utils/DateTime.hs b/src/Utils/DateTime.hs index 2d58788e3..0b5855566 100644 --- a/src/Utils/DateTime.hs +++ b/src/Utils/DateTime.hs @@ -1,15 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude - , TemplateHaskell - , QuasiQuotes - , StandaloneDeriving - , DerivingStrategies - , DeriveLift - , DeriveDataTypeable - , DeriveGeneric - , GeneralizedNewtypeDeriving - , OverloadedStrings - , FlexibleInstances - #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Utils.DateTime diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 6859eccea..e17678d06 100644 --- a/src/Utils/Form.hs +++ b/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) diff --git a/src/Utils/Lang.hs b/src/Utils/Lang.hs index 6556cede3..ab62d1baf 100644 --- a/src/Utils/Lang.hs +++ b/src/Utils/Lang.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE OverloadedStrings #-} - module Utils.Lang where import ClassyPrelude.Yesod diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 55f8d406c..d99d3c4a4 100644 --- a/src/Utils/Lens.hs +++ b/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 diff --git a/src/Utils/Message.hs b/src/Utils/Message.hs index d0d61e68a..62e337328 100644 --- a/src/Utils/Message.hs +++ b/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 diff --git a/src/Utils/PathPiece.hs b/src/Utils/PathPiece.hs index 0aa1a364c..f093ce22f 100644 --- a/src/Utils/PathPiece.hs +++ b/src/Utils/PathPiece.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - #-} - module Utils.PathPiece ( finiteFromPathPiece , nullaryToPathPiece diff --git a/src/Utils/Sql.hs b/src/Utils/Sql.hs index ef2d2c6ea..f56ac38a2 100644 --- a/src/Utils/Sql.hs +++ b/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 diff --git a/src/Utils/SystemMessage.hs b/src/Utils/SystemMessage.hs index 80a7b7e00..e5cff0496 100644 --- a/src/Utils/SystemMessage.hs +++ b/src/Utils/SystemMessage.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude - , RecordWildCards - #-} - module Utils.SystemMessage where import Import.NoFoundation diff --git a/src/Utils/TH.hs b/src/Utils/TH.hs index c2d050bde..501cfee12 100644 --- a/src/Utils/TH.hs +++ b/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