module Model.Migration.Definitions
  ( ManualMigration(..)
  , migrateManual
  , migrateAlwaysSafe
  , customMigrations
  , columnExists
  ) where

import Import.NoModel hiding (Max(..), Last(..))
import Model
import Model.Types.TH.PathPiece
import Settings
import Foundation.Type
import Jobs.Types
import Audit.Types
import qualified Model.Migration.Types as Legacy
import qualified Data.Map as Map

import qualified Data.Set as Set
import qualified Data.HashMap.Strict as HashMap

import qualified Data.Text as Text

import qualified Data.Conduit.List as C

import Data.Semigroup (Max(..), Last(..))


import Database.Persist.Sql
import Database.Persist.Sql.Raw.QQ

import Text.Read (readMaybe)

import Utils.Lens (_NoUpload)

import Network.IP.Addr

import qualified Data.Char as Char
import qualified Data.CaseInsensitive as CI

import qualified Data.Aeson as Aeson

import Data.Conduit.Algorithms.FastCDC (FastCDCParameters(fastCDCMinBlockSize))

import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Time.Format

import qualified Data.Time.Zones as TZ



data ManualMigration
  = Migration20180813SimplifyUserTheme
  | Migration20180813SheetJSONB
  | Migration20180823SchoolShorthandPrimaryKey
  | Migration20180918SheetCorrectorLoadJSON
  | Migration20180918UserSurnames
  | Migration20180918SheetUploadMode
  | Migration20180928UserAuthentication
  | Migration20181011UserNotificationSettings
  | Migration20181031SheetTypeRefactor
  | Migration20181129EncodedSecretBoxes
  | Migration20181130SheetTypeRefactor
  | Migration20190319CourseParticipantField
  | Migration20190320BetterStudyShorthands
  | Migration20190421MixedSheetSubmissions
  | Migration20190429Tutorials
  | Migration20190515Exams
  | Migration20190715ExamOccurrenceName
  | Migration20190726UserFirstNamesTitles
  | Migration20190806TransactionLogIds
  | Migration20190809AllocationIndependentApplication
  | Migration20190813Allocations
  | Migration20190828UserFunction
  | Migration20190912UserDisplayEmail
  | Migration20190916ExamPartNumber
  | Migration20190918ExamRulesRefactor
  | Migration20190919ExamBonusRounding
  | Migration20191002FavouriteReason
  | Migration20191003CourseParticipantAllocatedId
  | Migration20191013AllocationMatching
  | Migration20191125UserLanguages
  | Migration20191126ExamPartCorrector
  | Migration20191128StudyFeaturesSuperField
  | Migration20200111ExamOccurrenceRuleRefactor
  | Migration20200218ExamResultPassedGrade
  | Migration20200218ExamGradingModeMixed
  | Migration20200218ExternalExamGradingModeMixed
  | Migration20200311AllocationMatching
  | Migration20200424SubmissionGroups
  | Migration20200504CourseParticipantState
  | Migration20200506SessionFile
  | Migration20200627FileRefactor
  | Migration20200824AllocationNotifications
  | Migration20200825StudyFeaturesFirstObserved
  | Migration20200902FileChunking
  | Migration20200916ExamMode
  | Migration20201106StoredMarkup
  | Migration20201119RoomTypes
  | Migration20210115ExamPartsFrom
  | Migration20210208StudyFeaturesRelevanceCachedUUIDs
  | Migration20210318CrontabSubmissionRatedNotification
  | Migration20210608SeparateTermActive
    -- TODO: migration regarding authorship statements
    --         - apply desired non-default modes for IfI
    --         - set authorship statement texts for IfI
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''ManualMigration $ \t@(splitCamel -> verbs) -> case verbs of
  ("Migration" : dVerb : vs)
    | Just (d :: Day) <- parseTimeM False defaultTimeLocale "%Y%m%d" (unpack dVerb)
      -> pack (formatTime defaultTimeLocale "%Y-%m-%d" d) <> "--" <> intercalate "-" (map toLower vs)
  _other
    -> terror $ "Could not parse: “" <> t <> "” → " <> tshow verbs
pathPieceJSON ''ManualMigration
pathPieceJSONKey ''ManualMigration
pathPieceHttpApiData ''ManualMigration
derivePersistFieldPathPiece ''ManualMigration




migrateManual :: Migration
migrateManual = do
  mapM_ (uncurry addIndex)
    [ ("course_application_file_content",     "CREATE INDEX course_application_file_content ON course_application_file (content)"        )
    , ("material_file_content",               "CREATE INDEX material_file_content ON material_file (content)"                            )
    , ("course_news_file_content",            "CREATE INDEX course_news_file_content ON course_news_file (content)"                      )
    , ("sheet_file_content",                  "CREATE INDEX sheet_file_content ON sheet_file (content)"                                  )
    , ("course_app_instruction_file_content", "CREATE INDEX course_app_instruction_file_content ON course_app_instruction_file (content)")
    , ("allocation_matching_log",             "CREATE INDEX allocation_matching_log ON allocation_matching (log)"                        )
    , ("submission_file_content",             "CREATE INDEX submission_file_content ON submission_file (content)"                        )
    , ("session_file_content",                "CREATE INDEX session_file_content ON session_file (content)"                              )
    , ("file_lock_content",                   "CREATE INDEX file_lock_content ON file_lock (content)"                                    )
    , ("user_lower_display_email",            "CREATE INDEX user_lower_display_email ON \"user\" (lower(display_email))"                 )
    , ("user_lower_email",                    "CREATE INDEX user_lower_email ON \"user\" (lower(email))"                                 )
    , ("user_lower_ident",                    "CREATE INDEX user_lower_ident ON \"user\" (lower(ident))"                                 )
    , ("submission_sheet",                    "CREATE INDEX submission_sheet ON submission (sheet)"                                      )
    , ("submission_edit_submission",          "CREATE INDEX submission_edit_submission ON submission_edit (submission)"                  )
    , ("user_ldap_primary_key",               "CREATE INDEX user_ldap_primary_key ON \"user\" (ldap_primary_key)"                        )
    , ("file_content_entry_chunk_hash",       "CREATE INDEX file_content_entry_chunk_hash ON \"file_content_entry\" (chunk_hash)"        )
    , ("sent_mail_bounce_secret",             "CREATE INDEX sent_mail_bounce_secret ON \"sent_mail\" (bounce_secret) WHERE bounce_secret IS NOT NULL")
    , ("sent_mail_recipient",                 "CREATE INDEX sent_mail_recipient ON \"sent_mail\" (recipient) WHERE recipient IS NOT NULL")
    , ("study_features_relevance_cached",     "CREATE INDEX study_features_relevance_cached ON \"study_features\" (relevance_cached)")
    , ("submission_rating_by",                "CREATE INDEX submission_rating_by ON submission (rating_by) WHERE rating_by IS NOT NULL"  )
    , ("exam_corrector_user",                 "CREATE INDEX exam_corrector_user ON exam_corrector (\"user\")"                            )
    , ("submission_rating_time",              "CREATE INDEX submission_rating_time ON submission (rating_time)"                          )
    ]
  where
    addIndex :: Text -> Sql -> Migration
    addIndex ixName ixDef = do
      res <- lift $ lift [sqlQQ|SELECT EXISTS (SELECT 1 FROM pg_indexes WHERE schemaname = current_schema() AND indexname = #{ixName})|]
      alreadyDefined <- case res of
        [Single e] -> return e
        _other -> return True
      unless alreadyDefined $ addMigration False ixDef

migrateAlwaysSafe :: Migration
-- | Part of `migrateAll` but not checked in `requiresMigration`
migrateAlwaysSafe = do
  recordedChangelogItems <- lift . lift $ selectList [ ChangelogItemFirstSeenItem <-. universeF ] []
  let missingChangelogItems = Set.toList $ Set.fromList universeF `Set.difference` recordedChangelogItems'
        where recordedChangelogItems' = Set.fromList [ changelogItemFirstSeenItem | Entity _ ChangelogItemFirstSeen{..} <- recordedChangelogItems ]
  unless (null missingChangelogItems) $ do
    today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
    addMigration False $ do
      let sql = [st|INSERT INTO changelog_item_first_seen (item, first_seen) VALUES #{vals}|]
          vals = Text.intercalate ", " $ do
            item <- missingChangelogItems
            let itemDay = Map.findWithDefault today item changelogItemDays
            return [st|('#{toPathPiece item}', '#{iso8601Show itemDay}')|]
       in sql

{-
  Confusion about quotes, from the PostgreSQL Manual:
    Single quotes for string constants, double quotes for table/column names.

    QuasiQuoter: ^{TableName} @{ColumnName} (escaped as column/table-name; value determined from current model);
                  #{anything} (escaped as value);
-}

customMigrations :: forall m.
                    ( MonadResource m
                    , MonadReader UniWorX m
                    )
                 => Map ManualMigration (ReaderT SqlBackend m ())
customMigrations = mapF $ \case
  Migration20180813SimplifyUserTheme -> whenM (columnExists "user" "theme") $ do -- New theme format
    userThemes <- [sqlQQ| SELECT "id", "theme" FROM "user"; |]
    forM_ userThemes $ \(uid, Single str) -> case stripPrefix "theme--" str of
      Just v
        | Just theme <- fromPathPiece v -> update uid [UserTheme =. theme]
      other -> error $ "Could not parse theme: " <> show other

  Migration20180813SheetJSONB -> whenM (tableExists "sheet") -- Better JSON encoding
    [executeQQ|
      ALTER TABLE "sheet" ALTER COLUMN "type" TYPE jsonb USING "type"::jsonb;
      ALTER TABLE "sheet" ALTER COLUMN "grouping" TYPE jsonb USING "grouping"::jsonb;
    |]

  Migration20180823SchoolShorthandPrimaryKey -> whenM (columnExists "school" "id") $ do -- SchoolId is the Shorthand CI Text now
    -- Read old table into memory
    schoolTable <- [sqlQQ| SELECT "id", "shorthand" FROM "school"; |]
    let _sT = schoolTable :: [(Single Int64, Single (CI Text))] -- Types needed
    -- Convert columns containing SchoolId
    whenM (tableExists "user_admin") $ do
        [executeQQ|
          ALTER TABLE "user_admin" DROP CONSTRAINT "user_admin_school_fkey";
          ALTER TABLE "user_admin" ALTER COLUMN "school" TYPE citext USING "school"::citext;
          |]
        forM_ schoolTable $ \(Single idnr, Single ssh) ->
          [executeQQ|
            UPDATE "user_admin" SET "school" = #{ssh} WHERE "school" = #{tshow idnr};
          |]
        [executeQQ|
          ALTER TABLE "user_admin" ADD CONSTRAINT "user_admin_school_fkey"
            FOREIGN KEY (school) REFERENCES school(shorthand);
          |]
    whenM (tableExists "user_lecturer") $ do
        [executeQQ|
          ALTER TABLE "user_lecturer" DROP CONSTRAINT "user_lecturer_school_fkey";
          ALTER TABLE "user_lecturer" ALTER COLUMN "school" TYPE citext USING "school"::citext;
          |]
        forM_ schoolTable $ \(Single idnr, Single ssh) ->
          [executeQQ|
            UPDATE "user_lecturer" SET "school" = #{ssh} WHERE "school" = #{tshow idnr};
          |]
        [executeQQ|
          ALTER TABLE "user_lecturer" ADD CONSTRAINT "user_lecturer_school_fkey"
              FOREIGN KEY (school) REFERENCES school(shorthand);
          |]
    whenM (tableExists "course") $ do
        [executeQQ|
          ALTER TABLE "course" DROP CONSTRAINT "course_school_fkey";
          ALTER TABLE "course" ALTER COLUMN "school" TYPE citext USING "school"::citext;
          |]
        forM_ schoolTable $ \(Single idnr, Single ssh) ->
          [executeQQ|
            UPDATE "course" SET "school" = #{ssh} WHERE "school" = #{tshow idnr};
          |]
        [executeQQ|
          ALTER TABLE "course" ADD CONSTRAINT "course_school_fkey"
              FOREIGN KEY (school) REFERENCES school(shorthand);
          |]
    [executeQQ|
      ALTER TABLE "school" DROP COLUMN "id";
      ALTER TABLE "school" ADD PRIMARY KEY (shorthand);
    |]

  Migration20180918SheetCorrectorLoadJSON -> whenM (tableExists "sheet_corrector") $ do -- Load is encoded as JSON now.
    correctorLoads <- [sqlQQ| SELECT "id", "load" FROM "sheet_corrector"; |]
    forM_ correctorLoads $ \(uid, Single str) -> case readMaybe str of
      Just load -> update uid [SheetCorrectorLoad =. load]
      _other -> error $ "Could not parse Load: " <> show str
    [executeQQ|
      ALTER TABLE "sheet_corrector" ALTER COLUMN "load" TYPE jsonb USING "load"::jsonb;
    |]

  Migration20180918UserSurnames -> whenM (tableExists "user") $ do
    userDisplayNames <- [sqlQQ| SELECT "id", "display_name" FROM "user"; |]
    [executeQQ|
      ALTER TABLE "user" ADD COLUMN IF NOT EXISTS "surname" text DEFAULT '';
    |]
    forM_ userDisplayNames $ \(uid, Single str) -> case lastMaybe $ words str of
      Just name -> update uid [UserSurname =. name]
      _other    -> error "Empty userDisplayName found"

  Migration20180918SheetUploadMode -> whenM (tableExists "sheet")
    [executeQQ|
      ALTER TABLE "sheet" ADD COLUMN IF NOT EXISTS "upload_mode" jsonb DEFAULT '{ "tag": "Upload", "unpackZips": true }';
    |]

  Migration20180928UserAuthentication -> whenM (columnExists "user" "plugin")
    -- <> is standard sql for /=
    [executeQQ|
      DELETE FROM "user" WHERE "plugin" <> 'LDAP';
      ALTER TABLE "user" DROP COLUMN "plugin";
      ALTER TABLE "user" ADD COLUMN IF NOT EXISTS "authentication" jsonb DEFAULT '"ldap"';
    |]

  Migration20181011UserNotificationSettings -> whenM (tableExists "user")
    [executeQQ|
      ALTER TABLE "user" ADD COLUMN IF NOT EXISTS "notification_settings" jsonb NOT NULL DEFAULT '[]';
    |]

  Migration20181031SheetTypeRefactor -> whenM (tableExists "sheet") $ do
    sheets <- [sqlQQ| SELECT "id", "type" FROM "sheet"; |]
    forM_ sheets $ \(sid, Single lsty) -> update sid [SheetType =. Legacy.sheetType lsty]
  
  Migration20181129EncodedSecretBoxes -> whenM (tableExists "cluster_config")
    [executeQQ|
       UPDATE "cluster_config" SET "setting" = 'secret-box-key' WHERE "setting" = 'error-message-key';
    |]

  Migration20181130SheetTypeRefactor -> whenM (tableExists "sheet")
    [executeQQ|
       UPDATE "sheet" SET "type" = json_build_object('type', "type"->'type', 'grading', "type"->'') WHERE jsonb_exists("type", '');
       UPDATE "sheet" SET "type" = json_build_object('type', "type"->'type', 'grading', json_build_object('type', "type"->'grading'->'type', 'max', "type"->'grading'->'points')) WHERE ("type"->'grading'->'type') = '"points"' AND jsonb_exists("type"->'grading', 'points');
       UPDATE "sheet" SET "type" = json_build_object('type', "type"->'type', 'grading', json_build_object('type', "type"->'grading'->'type', 'max', "type"->'grading'->'points', 'passing', 0)) WHERE ("type"->'grading'->'type') = '"pass-points"' AND jsonb_exists("type"->'grading', 'points');
    |]

  Migration20190319CourseParticipantField -> whenM ((\a b c -> a && b && not c) <$> tableExists "study_features" <*> tableExists "course_participant" <*> columnExists "course_participant" "field") $ do
    [executeQQ|
      ALTER TABLE "course_participant" ADD COLUMN "field" bigint DEFAULT null REFERENCES study_features(id);
      ALTER TABLE "study_features" ADD COLUMN IF NOT EXISTS "valid" boolean NOT NULL DEFAULT true;
    |]
    users <- [sqlQQ| SELECT DISTINCT ON ("user"."id") "user"."id", "study_features"."id" FROM "user", "study_features" WHERE "study_features"."user" = "user"."id" AND "study_features"."valid" AND "study_features"."type" = 'FieldPrimary' ORDER BY "user"."id", random(); |]
    forM_ users $ \(uid :: UserId, sfid :: StudyFeaturesId) -> [executeQQ| UPDATE "course_participant" SET "field" = #{sfid} WHERE "user" = #{uid} AND "field" IS NULL; |]

  Migration20190320BetterStudyShorthands -> do
    whenM (columnExists "study_degree" "shorthand") [executeQQ| UPDATE "study_degree" SET "shorthand" = NULL WHERE "shorthand" = '' |]
    whenM (columnExists "study_degree" "name") [executeQQ| UPDATE "study_degree" SET "name" = NULL WHERE "shorthand" = '' |]
    whenM (columnExists "study_terms" "shorthand") [executeQQ| UPDATE "study_terms" SET "shorthand" = NULL WHERE "shorthand" = '' |]
    whenM (columnExists "study_terms" "name") [executeQQ| UPDATE "study_terms" SET "name" = NULL WHERE "shorthand" = '' |]

  Migration20190421MixedSheetSubmissions -> whenM ((&&) <$> columnExists "sheet" "upload_mode" <*> columnExists "sheet" "submission_mode") $ do
    sheetModes <- [sqlQQ| SELECT "id", "upload_mode", "submission_mode" FROM "sheet"; |]
    [executeQQ|
      ALTER TABLE "sheet" DROP COLUMN "upload_mode";
      ALTER TABLE "sheet" ALTER COLUMN "submission_mode" DROP DEFAULT;
      ALTER TABLE "sheet" ALTER COLUMN "submission_mode" TYPE jsonb USING 'null'::jsonb;
    |]
    forM_ sheetModes $ \(shid :: SheetId, unSingle -> uploadMode :: Legacy.UploadMode, unSingle -> submissionMode :: Legacy.SheetSubmissionMode ) -> do
      let submissionMode' = case (submissionMode, uploadMode) of
            ( Legacy.NoSubmissions       , _                   ) -> SubmissionMode False Nothing
            ( Legacy.CorrectorSubmissions, _                   ) -> SubmissionMode True Nothing
            ( Legacy.UserSubmissions     , Legacy.NoUpload     ) -> SubmissionMode False (Just NoUpload)
            ( Legacy.UserSubmissions     , Legacy.Upload True  ) -> SubmissionMode False (Just $ UploadAny True defaultExtensionRestriction True)
            ( Legacy.UserSubmissions     , Legacy.Upload False ) -> SubmissionMode False (Just $ UploadAny False defaultExtensionRestriction True)
      [executeQQ| UPDATE "sheet" SET "submission_mode" = #{submissionMode'} WHERE "id" = #{shid}; |]

  Migration20190429Tutorials -> whenM ((&&) <$> tableExists "tutorial" <*> tableExists "tutorial_user") $ do -- Tutorials were an unused stub before
    tableDropEmpty "tutorial"
    tableDropEmpty "tutorial_user"

  Migration20190515Exams -> whenM (tableExists "exam") $ -- Exams were an unused stub before
    tableDropEmpty "exam"

  Migration20190715ExamOccurrenceName -> whenM ((&&) <$> tableExists "exam_occurrence" <*> (not <$> columnExists "exam_occurrence" "name")) $ do
    examOccurrences <- [sqlQQ| SELECT "id" FROM "exam_occurrence" ORDER BY "exam"; |]
    [executeQQ|
      ALTER TABLE "exam_occurrence" ADD COLUMN "name" citext DEFAULT null;
    |]
    forM_ (zip [0..] examOccurrences) $ \(n :: Natural, Single eoId :: Single ExamOccurrenceId) -> do
      let name = [st|occ-#{tshow n}|]
      [executeQQ| UPDATE "exam_occurrence" SET "name" = #{name} WHERE "id" = #{eoId} |]
    [executeQQ|
      ALTER TABLE "exam_occurrence" ALTER COLUMN "name" DROP DEFAULT;
      ALTER TABLE "exam_occurrence" ALTER COLUMN "name" SET NOT NULL;
    |]

  Migration20190726UserFirstNamesTitles -> whenM (tableExists "user") $ do
    [executeQQ|
      ALTER TABLE "user" ADD COLUMN "first_name" text NOT NULL DEFAULT '';
      ALTER TABLE "user" ADD COLUMN "title" text DEFAULT null;
    |]
    let getUsers = rawQuery [st|SELECT "id", "display_name", "surname" FROM "user"|] []
        updateUser (uid, firstName) = [executeQQ|UPDATE "user" SET "first_name" = #{firstName} WHERE "id" = #{uid}|]
        splitFirstName :: [PersistValue] -> Maybe (UserId, Text)
        splitFirstName [fromPersistValue -> Right uid, fromPersistValue -> Right displayName, fromPersistValue -> Right surname] = Just . (uid, ) $ if
          | Just givenName <- Text.stripSuffix surname displayName
                          <|> Text.stripPrefix surname displayName
            -> Text.strip givenName
          | otherwise
            -> Text.replace surname "…" displayName
        splitFirstName _ = Nothing
    runConduit $ getUsers .| C.mapMaybe splitFirstName .| C.mapM_ updateUser

  Migration20190806TransactionLogIds -> whenM (tableExists "transaction_log") $ do
    [executeQQ|
      UPDATE transaction_log SET remote = null WHERE remote = #{IPv4 loopbackIP4 :: IP} OR remote = #{IPv6 loopbackIP6 :: IP}
    |]

    [executeQQ|
      ALTER TABLE transaction_log ADD COLUMN "initiator_id" bigint DEFAULT null;
    |]

    whenM (tableExists "user")
      [executeQQ|
        UPDATE transaction_log SET initiator_id = "user".id FROM "user" WHERE transaction_log.initiator = "user".ident;
      |]

    [executeQQ|
      ALTER TABLE transaction_log DROP COLUMN initiator;
      ALTER TABLE transaction_log RENAME COLUMN initiator_id TO initiator;
      ALTER TABLE transaction_log ALTER COLUMN initiator DROP DEFAULT;
    |]

    let getLogEntries = rawQuery [st|SELECT id, info FROM transaction_log|] []
        updateTransactionInfo [fromPersistValue -> Right lid, fromPersistValue -> Right (oldT :: Legacy.Transaction)] = do
          newT <- case oldT of
            Legacy.TransactionTermEdit tid
              -> return . Just . TransactionTermEdit $ TermKey tid
            Legacy.TransactionExamRegister (TermKey -> tid) (SchoolKey -> ssh) csh examn uident
              -> runMaybeT $ do
                guardM . lift $ tablesExist ["user", "exam", "course"]

                cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
                eid <- MaybeT . getKeyBy $ UniqueExam cid examn
                uid <- MaybeT . getKeyBy $ UniqueAuthentication uident
                return $ TransactionExamRegister eid uid
            Legacy.TransactionExamDeregister (TermKey -> tid) (SchoolKey -> ssh) csh examn uident
              -> runMaybeT $ do
                guardM . lift $ tablesExist ["user", "exam", "course"]

                cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
                eid <- MaybeT . getKeyBy $ UniqueExam cid examn
                uid <- MaybeT . getKeyBy $ UniqueAuthentication uident
                return $ TransactionExamRegister eid uid
          whenIsJust newT $ \newT' ->
            update lid [ TransactionLogInfo =. toJSON newT' ]
        updateTransactionInfo _ = return ()
    runConduit $ getLogEntries .| C.mapM_ updateTransactionInfo

  Migration20190809AllocationIndependentApplication -> do
    whenM (tableExists "allocation_course") $ do
      vals <- [sqlQQ| SELECT "course", "instructions", "application_text", "application_files", "ratings_visible" FROM "allocation_course"; |]

      whenM (tableExists "course") $ do
        [executeQQ|
          ALTER TABLE "course" ADD COLUMN "applications_required" boolean not null default #{False}, ADD COLUMN "applications_instructions" varchar null, ADD COLUMN "applications_text" boolean not null default #{False}, ADD COLUMN "applications_files" jsonb not null default #{NoUpload}, ADD COLUMN "applications_ratings_visible" boolean not null default #{False};
          ALTER TABLE "course" ALTER COLUMN "applications_required" DROP DEFAULT, ALTER COLUMN "applications_text" DROP DEFAULT, ALTER COLUMN "applications_files" DROP DEFAULT, ALTER COLUMN "applications_ratings_visible" DROP DEFAULT;
        |]

        forM_ vals $ \(cid :: CourseId, Single applicationsInstructions :: Single (Maybe Html), Single applicationsText :: Single Bool, Single applicationsFiles :: Single UploadMode, Single applicationsRatingsVisible :: Single Bool) -> do
          let appRequired = applicationsText || isn't _NoUpload applicationsFiles
          [executeQQ|
            UPDATE "course" SET ("applications_required", "applications_instructions", "applications_text", "applications_files", "applications_ratings_visible") = (#{appRequired}, #{applicationsInstructions}, #{applicationsText}, #{applicationsFiles}, #{applicationsRatingsVisible}) WHERE "id" = #{cid};
          |]

      [executeQQ|
        ALTER TABLE "allocation_course" DROP COLUMN "instructions", DROP COLUMN "application_text", DROP COLUMN "application_files", DROP COLUMN "ratings_visible";
      |]

    whenM ((&&) <$> tableExists "allocation_course_file" <*> (not <$> tableExists "course_app_instruction_file")) $ do
      [executeQQ|
        CREATe TABLE "course_app_instruction_file"("id" SERIAL8  PRIMARY KEY UNIQUE,"course" INT8 NOT NULL,"file" INT8 NOT NULL);
        ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "unique_course_app_instruction_file" UNIQUE("course","file");               
        ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "course_app_instruction_file_course_fkey" FOREIGN KEY("course") REFERENCES "course"("id");                               
        ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "course_app_instruction_file_file_fkey" FOREIGN KEY("file") REFERENCES "file"("id");
      |]

      let getFileEntries = rawQuery [st|SELECT "allocation_course_file"."id", "allocation_course"."course", "allocation_course_file"."file" FROM "allocation_course_file" INNER JOIN "allocation_course" ON "allocation_course"."id" = "allocation_course_file"."allocation_course"|] []
          moveFileEntry [fromPersistValue -> Right (acfId :: Int64), fromPersistValue -> Right (cid :: CourseId), fromPersistValue -> Right (fid :: Int64)] =
            [executeQQ|
              INSERT INTO "course_app_instruction_file" ("course", "file") VALUES (#{cid}, #{fid});
              DELETE FROM "allocation_course_file" WHERE "id" = #{acfId};
            |]
          moveFileEntry _ = return ()
      runConduit $ getFileEntries .| C.mapM_ moveFileEntry
      tableDropEmpty "allocation_course_file"

    whenM (tableExists "allocation_application") $
      tableDropEmpty "allocation_application"
    whenM (tableExists "allocation_application_file") $
      tableDropEmpty "allocation_application_file"

  Migration20190813Allocations -> do
    whenM (tableExists "allocation") $ do
      [executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS capacity;|]
      [executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS link_external;|]
      [executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS register_secret;|]
    whenM (tableExists "allocation_deregister") $ do
      [executeQQ|ALTER TABLE allocation_deregister DROP COLUMN IF EXISTS allocation;|]

  Migration20190828UserFunction -> do
    [executeQQ|
      CREATe TABLE IF NOT EXISTS "user_function" ( "id" serial8 primary key, "user" bigint, "school" citext, "function" text );
    |]

    whenM (tableExists "user_admin") $ do
      let getAdminEntries = rawQuery [st|SELECT user_admin.id, user_admin.user, user_admin.school FROM user_admin;|] []
          moveAdminEntry [fromPersistValue -> Right (eId :: Int64), fromPersistValue -> Right (uid :: UserId), fromPersistValue -> Right (sid :: SchoolId)] =
            [executeQQ|
              INSERT INTO "user_function" ("user", "school", "function") VALUES (#{uid}, #{sid}, #{SchoolAdmin});
              DELETE FROM "user_admin" WHERE "id" = #{eId};
            |]
          moveAdminEntry _ = return ()
      runConduit $ getAdminEntries .| C.mapM_ moveAdminEntry
      tableDropEmpty "user_admin"
    whenM (tableExists "user_lecturer") $ do
      let getLecturerEntries = rawQuery [st|SELECT user_lecturer.id, user_lecturer.user, user_lecturer.school FROM user_lecturer;|] []
          moveLecturerEntry [fromPersistValue -> Right (eId :: Int64), fromPersistValue -> Right (uid :: UserId), fromPersistValue -> Right (sid :: SchoolId)] =
            [executeQQ|
              INSERT INTO "user_function" ("user", "school", "function") VALUES (#{uid}, #{sid}, #{SchoolLecturer});
              DELETE FROM "user_lecturer" WHERE "id" = #{eId};
            |]
          moveLecturerEntry _ = return ()
      runConduit $ getLecturerEntries .| C.mapM_ moveLecturerEntry
      tableDropEmpty "user_lecturer"
    whenM (tableExists "invitation") $ do
      [executeQQ|
        DELETE FROM "invitation" WHERE "for"->'junction' = '"UserLecturer"';
      |]

  Migration20190912UserDisplayEmail -> whenM (tableExists "user") $ do
    [executeQQ|
      ALTER TABLE "user" ADD COLUMN IF NOT EXISTS "display_email" citext;
      UPDATE "user" SET "display_email" = "email" WHERE "display_email" IS NULL;
      ALTER TABLE "user" ALTER COLUMN "display_email" SET NOT NULL;
    |]

  Migration20190916ExamPartNumber -> whenM (tableExists "exam_part") $ do
    [executeQQ|
      ALTER TABLE "exam_part" ADD COLUMN IF NOT EXISTS "number" citext;
    |]

    let getExamEntries = rawQuery [st|SELECT DISTINCT exam FROM exam_part ORDER BY exam;|] []
        renameExamParts [fromPersistValue -> Right (eId :: ExamId)] = do
          partNames' <- [sqlQQ|SELECT id, name FROM "exam_part" WHERE exam = #{eId};|]
          let
            partNames :: [(ExamPartId, ExamPartName)]
            partNames = foldMap (\(Single epId, Single pName) -> singletonMap epId pName) partNames'

            partsSorted = partNames
              & sortOn ( map (\x -> maybe (Left x) Right (readMay x :: Maybe Integer))
                       . groupBy ((==) `on` Char.isDigit)
                       . CI.foldedCase
                       . snd
                       )
              & map fst
          forM_ (zip [_ExamPartNumber' # 1..] partsSorted) $ \(num :: ExamPartNumber, pId) ->
            [executeQQ|
              UPDATE "exam_part" SET "number" = #{num} WHERE "id" = #{pId};
            |]
        renameExamParts _ = return ()
    runConduit $ getExamEntries .| C.mapM_ renameExamParts

  Migration20190918ExamRulesRefactor -> whenM (tableExists "exam") $ do
    oldVersion <- columnExists "exam" "grading_key"
    if
      | oldVersion -> do
        -- Major changes happend to the structure of exams without appropriate
        -- migration, try to remedy that here
        tableDropEmpty "exam_part_corrector"
        tableDropEmpty "exam_corrector"
        tableDropEmpty "exam_result"
        tableDropEmpty "exam_registration"
        tableDropEmpty "exam_occurrence"
        tableDropEmpty "exam_part"
        tableDropEmpty "exam"
      | otherwise ->
        [executeQQ|
          ALTER TABLE "exam" ALTER COLUMN "grading_rule" DROP NOT NULL;
          ALTER TABLE "exam" ALTER COLUMN "bonus_rule" DROP NOT NULL;
          ALTER TABLE "exam" ALTER COLUMN "occurrence_rule" DROP NOT NULL;

          UPDATE "exam" SET "grading_rule" = NULL WHERE "grading_rule"->>'rule' = 'manual';
          UPDATE "exam" SET "bonus_rule" = NULL WHERE "bonus_rule"->>'rule' = 'no-bonus';
          UPDATE "exam" SET "occurrence_rule" = NULL WHERE "occurrence_rule" = '"manual"';

          UPDATE "exam" SET "occurrence_rule" = json_build_object('rule', "occurrence_rule");
        |]

  Migration20190919ExamBonusRounding -> whenM (tableExists "exam")
    [executeQQ|
      UPDATE "exam" SET "bonus_rule" = jsonb_insert("bonus_rule", '{round}' :: text[], '0.01' :: jsonb) WHERE "bonus_rule"->>'rule' = 'bonus-points';
    |]

  Migration20191002FavouriteReason -> whenM (tableExists "course_favourite")
    [executeQQ|
      ALTER TABLE "course_favourite" RENAME COLUMN "time" TO "last_visit";
      ALTER TABLE "course_favourite" ADD COLUMN "reason" jsonb DEFAULT '"visited"'::jsonb;
    |]

  Migration20191003CourseParticipantAllocatedId -> whenM (tableExists "course_participant") $ do
    queryRes <- [sqlQQ|SELECT (EXISTS (SELECT 1 FROM "course_participant" WHERE "allocated" <> false))|]
    case queryRes of
      [Single False] ->
        [executeQQ|
          ALTER TABLE "course_participant" DROP COLUMN  "allocated";
          ALTER TABLE "course_participant" ADD COLUMN "allocated" bigint;
        |]
      _other -> error "Cannot reconstruct course_participant.allocated"

  Migration20191013AllocationMatching -> whenM (tableExists "allocation")
    [executeQQ|
      CREATE TABLE "allocation_matching" ("id" SERIAL8 PRIMARY KEY UNIQUE, "allocation" INT8 NOT NULL, "fingerprint" BYTEA NOT NULL, "log" INT8 NOT NULL);
      INSERT INTO "allocation_matching" ("allocation", "fingerprint", "log") (select "id" as "allocation", "fingerprint", "matching_log" as "log" from "allocation" where not ("matching_log" is null) and not ("fingerprint" is null));
      ALTER TABLE "allocation" DROP COLUMN "fingerprint";
      ALTER TABLE "allocation" DROP COLUMN "matching_log";
    |]

  Migration20191125UserLanguages -> whenM (tableExists "user")
    [executeQQ|
      ALTER TABLE "user" ADD COLUMN "languages" jsonb;
      UPDATE "user" SET "languages" = "mail_languages" where "mail_languages" <> '[]';
      ALTER TABLE "user" DROP COLUMN "mail_languages";
    |]

  Migration20191126ExamPartCorrector -> whenM (tableExists "exam_part_corrector") $
    tableDropEmpty "exam_part_corrector"

  Migration20191128StudyFeaturesSuperField -> whenM (tableExists "study_features")
    [executeQQ|
      ALTER TABLE "study_features" ADD COLUMN "super_field" bigint;
      UPDATE "study_features" SET "super_field" = "field", "field" = "sub_field" WHERE NOT ("sub_field" IS NULL);
      ALTER TABLE "study_features" DROP COLUMN "sub_field";
    |]

  Migration20200111ExamOccurrenceRuleRefactor -> whenM (tableExists "exam")
    [executeQQ|
      UPDATE "exam" SET "occurrence_rule" = #{ExamRoomManual} WHERE "occurrence_rule" IS NULL;
      ALTER TABLE "exam" ALTER COLUMN "occurrence_rule" SET NOT NULL;
    |]

  Migration20200218ExamResultPassedGrade -> whenM ((&&) <$> tableExists "exam" <*> tableExists "exam_result") $ do
    queryRes <- [sqlQQ|SELECT exam_result.id, exam_result.result FROM exam_result INNER JOIN exam ON exam_result.exam = exam.id WHERE NOT exam.show_grades;|]
    forM_ queryRes $ \(resId :: ExamResultId, Single (res :: ExamResultGrade)) ->
      let res' :: ExamResultPassedGrade
          res' = Left . view passingGrade <$> res
       in [executeQQ|UPDATE exam_result SET result = #{res'} WHERE id = #{resId};|]

  Migration20200218ExamGradingModeMixed -> whenM (tableExists "exam")
    [executeQQ|
      ALTER TABLE "exam" ADD COLUMN "grading_mode" character varying;
      UPDATE "exam" SET "grading_mode" = 'grades' WHERE "show_grades";
      UPDATE "exam" SET "grading_mode" = 'pass' WHERE NOT "show_grades";
      ALTER TABLE "exam" DROP COLUMN "show_grades";
      ALTER TABLE "exam" ALTER COLUMN "grading_mode" SET NOT NULL;
    |]

  Migration20200218ExternalExamGradingModeMixed -> whenM (tableExists "external_exam")
    [executeQQ|
      ALTER TABLE "external_exam" ADD COLUMN "grading_mode" character varying;
      UPDATE "external_exam" SET "grading_mode" = 'grades' WHERE "show_grades";
      UPDATE "external_exam" SET "grading_mode" = 'pass' WHERE NOT "show_grades";
      ALTER TABLE "external_exam" DROP COLUMN "show_grades";
      ALTER TABLE "external_exam" ALTER COLUMN "grading_mode" SET NOT NULL;
    |]

  Migration20200311AllocationMatching -> whenM (tableExists "allocation_matching") $
    tableDropEmpty "allocation_matching"

  Migration20200424SubmissionGroups -> do
    whenM (tableExists "submission_group") $
      tableDropEmpty "submission_group"
    whenM (tableExists "submission_group_edit") $
      tableDropEmpty "submission_group_edit"

  Migration20200504CourseParticipantState -> whenM (tableExists "course_participant") $ do
    [executeQQ|
      ALTER TABLE "course_participant" ADD COLUMN "state" text NOT NULL DEFAULT 'active';
      ALTER TABLE "course_participant" ALTER COLUMN "state" DROP DEFAULT;
    |]
    let getAuditLog = rawQuery [st|SELECT DISTINCT ON ("info") "info", max("time") FROM "transaction_log" GROUP BY "info" ORDER BY "info";|] []
        ensureParticipant :: [PersistValue] -> ReaderT SqlBackend m ()
        ensureParticipant [fmap Aeson.fromJSON . fromPersistValue -> Right (Aeson.Success TransactionCourseParticipantEdit{..}), fromPersistValue -> Right (time :: UTCTime)] = do
          let toAllocated :: [[PersistValue]] -> Maybe AllocationId
              toAllocated = either (const Nothing) Just . fromPersistValue <=< listToMaybe <=< listToMaybe
          allocated <- toAllocated <$> sourceToList [queryQQ|SELECT "allocation_course".allocation FROM "allocation_deregister" INNER JOIN "allocation_course" ON "allocation_course".course = "allocation_deregister".course WHERE "user" = #{transactionUser} AND "allocation_course"."course" = #{transactionCourse} LIMIT 1;|]
          whenM (existsKey transactionCourse `and2M` existsKey transactionUser)
            [executeQQ|INSERT INTO "course_participant" ("course", "user", "registration", "state", "allocated") VALUES (#{transactionCourse}, #{transactionUser}, #{time}, #{CourseParticipantInactive False}, #{allocated}) ON CONFLICT DO NOTHING;|]
        ensureParticipant _ = return ()
    runConduit $ getAuditLog .| C.mapM_ ensureParticipant

  Migration20200506SessionFile -> whenM (tableExists "session_file") $
    tableDropEmpty "session_file"

  Migration20200627FileRefactor -> whenM (tableExists "file") $ do
    [executeQQ|
      ALTER TABLE "file" ADD COLUMN "hash" BYTEA;
      UPDATE "file" SET "hash" = digest("content", 'sha3-512');
    |]

    let
      migrateFromFile :: forall fRef.
                         ( HasFileReference fRef
                         , PersistRecordBackend fRef SqlBackend
                         )
                      => ([PersistValue] -> (Key fRef, FileReferenceResidual fRef))
                      -> (Entity fRef -> ReaderT SqlBackend m ())
                      -> [PersistValue]
                      -> ReaderT SqlBackend m ()
      migrateFromFile toResidual doUpdate ((fromPersistValue -> Right (fId :: Int64)):rest) = do
        let (fRefKey, residual) = toResidual rest
        fileDat <- [sqlQQ|
          SELECT "file".title, "file".modified, "file".hash FROM "file" WHERE "id" = #{fId};
        |]
        forM_ fileDat $ \case
          (fromPersistValue . unSingle -> Right (fileReferenceTitle' :: FilePath), fromPersistValue . unSingle -> Right fileReferenceModified, fromPersistValue . unSingle -> Right fileReferenceContent) -> do
            let fileRef fileReferenceTitle = _FileReference # (FileReference{..}, residual)
                candidateTitles = fileReferenceTitle' : [ fName <.> ("old-" <> show n) <.> ext | n <- [1..1000] ]
                  where (fName, ext) = splitExtension fileReferenceTitle'
            validTitles <- dropWhileM (fmap (is _Just) . checkUnique . fileRef) candidateTitles
            case validTitles of
              fTitle : _ -> doUpdate . Entity fRefKey $ fileRef fTitle
              _other -> error "Could not make validTitle"
          _other -> return ()
      migrateFromFile _ _ _ = return ()

    whenM (tableExists "submission_file") $ do
      [executeQQ|
        ALTER TABLE "submission_file" ADD COLUMN "title" VARCHAR;
        ALTER TABLE "submission_file" ADD COLUMN "content" BYTEA NULL;
        ALTER TABLE "submission_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
        ALTER TABLE "submission_file" DROP CONSTRAINT "unique_submission_file";
        ALTER TABLE "submission_file" ADD CONSTRAINT "unique_submission_file" UNIQUE("submission", "title", "is_update");
      |]
      let getSubmissionFiles = [queryQQ|SELECT "file", "submission_file"."id", "submission", "is_update", "is_deletion" FROM "submission_file" LEFT OUTER JOIN "file" ON "submission_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
          toResidual [ fromPersistValue -> Right sfId
                     , fromPersistValue -> Right submissionFileResidualSubmission
                     , fromPersistValue -> Right submissionFileResidualIsUpdate
                     , fromPersistValue -> Right submissionFileResidualIsDeletion
                     ]
                     = (sfId, SubmissionFileResidual{..})
          toResidual _ = error "Could not convert SubmissionFile to residual"
      runConduit $ getSubmissionFiles .| C.mapM_ (migrateFromFile @SubmissionFile toResidual replaceEntity)
      [executeQQ|
        ALTER TABLE "submission_file" DROP COLUMN "file";
      |]

    whenM (tableExists "sheet_file") $ do
      [executeQQ|
        ALTER TABLE "sheet_file" ADD COLUMN "title" VARCHAR;
        ALTER TABLE "sheet_file" ADD COLUMN "content" BYTEA NULL;
        ALTER TABLE "sheet_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
        ALTER TABLE "sheet_file" DROP CONSTRAINT "unique_sheet_file";
        ALTER TABLE "sheet_file" ADD CONSTRAINT "unique_sheet_file" UNIQUE("sheet", "type", "title");
      |]
      let getSheetFiles = [queryQQ|SELECT "file", "sheet_file"."id", "sheet", "type" FROM "sheet_file" LEFT OUTER JOIN "file" ON "sheet_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
          toResidual [ fromPersistValue -> Right shfId
                     , fromPersistValue -> Right sheetFileResidualSheet
                     , fromPersistValue -> Right sheetFileResidualType
                     ]
                     = (shfId, SheetFileResidual{..})
          toResidual _ = error "Could not convert SheetFile to residual"
      runConduit $ getSheetFiles .| C.mapM_ (migrateFromFile @SheetFile toResidual replaceEntity)
      [executeQQ|
        ALTER TABLE "sheet_file" DROP COLUMN "file";
      |]

    whenM (tableExists "course_app_instruction_file") $ do
      [executeQQ|
        ALTER TABLE "course_app_instruction_file" ADD COLUMN "title" VARCHAR;
        ALTER TABLE "course_app_instruction_file" ADD COLUMN "content" BYTEA NULL;
        ALTER TABLE "course_app_instruction_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
        ALTER TABLE "course_app_instruction_file" DROP CONSTRAINT "unique_course_app_instruction_file";
        ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "unique_course_app_instruction_file" UNIQUE("course", "title");
      |]
      let getCourseAppInstructionFiles = [queryQQ|SELECT "file", "course_app_instruction_file"."id", "course" FROM "course_app_instruction_file" LEFT OUTER JOIN "file" ON "course_app_instruction_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
          toResidual [ fromPersistValue -> Right caifId
                     , fromPersistValue -> Right courseAppInstructionFileResidualCourse
                     ]
                     = (caifId, CourseAppInstructionFileResidual{..})
          toResidual _ = error "Could not convert CourseAppInstructionFile to residual"
      runConduit $ getCourseAppInstructionFiles .| C.mapM_ (migrateFromFile @CourseAppInstructionFile toResidual replaceEntity)
      [executeQQ|
        ALTER TABLE "course_app_instruction_file" DROP COLUMN "file";
      |]

    whenM (tableExists "course_news_file") $ do
      [executeQQ|
        ALTER TABLE "course_news_file" ADD COLUMN "title" VARCHAR;
        ALTER TABLE "course_news_file" ADD COLUMN "content" BYTEA NULL;
        ALTER TABLE "course_news_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
        ALTER TABLE "course_news_file" DROP CONSTRAINT "unique_course_news_file";
        ALTER TABLE "course_news_file" ADD CONSTRAINT "unique_course_news_file" UNIQUE("news", "title");
      |]
      let getCourseNewsFiles = [queryQQ|SELECT "file", "course_news_file"."id", "news" FROM "course_news_file" LEFT OUTER JOIN "file" ON "course_news_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
          toResidual [ fromPersistValue -> Right cnfId
                     , fromPersistValue -> Right courseNewsFileResidualNews
                     ]
                     = (cnfId, CourseNewsFileResidual{..})
          toResidual _ = error "Could not convert CourseNewsFile to residual"
      runConduit $ getCourseNewsFiles .| C.mapM_ (migrateFromFile @CourseNewsFile toResidual replaceEntity)
      [executeQQ|
        ALTER TABLE "course_news_file" DROP COLUMN "file";
      |]

    whenM (tableExists "material_file") $ do
      [executeQQ|
        ALTER TABLE "material_file" ADD COLUMN "title" VARCHAR;
        ALTER TABLE "material_file" ADD COLUMN "content" BYTEA NULL;
        ALTER TABLE "material_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
        ALTER TABLE "material_file" DROP CONSTRAINT "unique_material_file";
        ALTER TABLE "material_file" ADD CONSTRAINT "unique_material_file" UNIQUE("material", "title");
      |]
      let getMaterialFiles = [queryQQ|SELECT "file", "material_file"."id", "material" FROM "material_file" LEFT OUTER JOIN "file" ON "material_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
          toResidual [ fromPersistValue -> Right shfId
                     , fromPersistValue -> Right materialFileResidualMaterial
                     ]
                     = (shfId, MaterialFileResidual{..})
          toResidual _ = error "Could not convert MaterialFile to residual"
      runConduit $ getMaterialFiles .| C.mapM_ (migrateFromFile @MaterialFile toResidual replaceEntity)
      [executeQQ|
        ALTER TABLE "material_file" DROP COLUMN "file";
      |]

    whenM (tableExists "course_application_file") $ do
      [executeQQ|
        ALTER TABLE "course_application_file" ADD COLUMN "title" VARCHAR;
        ALTER TABLE "course_application_file" ADD COLUMN "content" BYTEA NULL;
        ALTER TABLE "course_application_file" ADD COLUMN "modified" TIMESTAMP WITH TIME ZONE;
        ALTER TABLE "course_application_file" DROP CONSTRAINT "unique_application_file";
        ALTER TABLE "course_application_file" ADD CONSTRAINT "unique_course_application_file" UNIQUE("application", "title");
      |]
      let getCourseApplicationFiles = [queryQQ|SELECT "file", "course_application_file"."id", "application" FROM "course_application_file" LEFT OUTER JOIN "file" ON "course_application_file"."file" = "file".id ORDER BY "file"."modified" DESC;|]
          toResidual [ fromPersistValue -> Right cnfId
                     , fromPersistValue -> Right courseApplicationFileResidualApplication
                     ]
                     = (cnfId, CourseApplicationFileResidual{..})
          toResidual _ = error "Could not convert CourseApplicationFile to residual"
      runConduit $ getCourseApplicationFiles .| C.mapM_ (migrateFromFile @CourseApplicationFile toResidual replaceEntity)
      [executeQQ|
        ALTER TABLE "course_application_file" DROP COLUMN "file";
      |]

    whenM (tableExists "allocation_matching") $ do
      [executeQQ|
        ALTER TABLE "allocation_matching" ADD COLUMN "log_ref" BYTEA;
        UPDATE "allocation_matching" SET "log_ref" = (SELECT "hash" FROM "file" WHERE "file".id = "log");
        ALTER TABLE "allocation_matching" DROP COLUMN "log";
        ALTER TABLE "allocation_matching" RENAME COLUMN "log_ref" TO "log";
      |]

    whenM (tableExists "session_file")
      [executeQQ|
        ALTER TABLE "session_file" ADD COLUMN "content" BYTEA;
        UPDATE "session_file" SET "content" = (SELECT "hash" FROM "file" WHERE "file".id = "session_file"."file");
        ALTER TABLE "session_file" DROP COLUMN "file";
      |]

    [executeQQ|
      ALTER TABLE "file" RENAME TO "file_content";
      DELETE FROM "file_content" WHERE "content" IS NULL OR "hash" IS NULL;
    |]
    [executeQQ|
      DELETE FROM "file_content"
      WHERE "id" IN (
          SELECT
              "id"
          FROM (
              SELECT
                  "id",
                  ROW_NUMBER() OVER w AS rnum
              FROM "file_content"
              WINDOW w AS (
                  PARTITION BY "hash"
                  ORDER BY "id"
              )
          ) as t
      WHERE t.rnum > 1);
    |]
    [executeQQ|
      ALTER TABLE "file_content" DROP COLUMN "title";
      ALTER TABLE "file_content" DROP COLUMN "modified";
      ALTER TABLE "file_content" DROP COLUMN "id";
    |]

  Migration20200824AllocationNotifications -> whenM (and2M (tableExists "cron_last_exec") (tableExists "allocation")) $ do
    let
      allocationTimes :: EntityField Allocation (Maybe UTCTime)
                      -> ReaderT SqlBackend m (MergeHashMap UTCTime (Set AllocationId, Max UTCTime, Last InstanceId))
      allocationTimes aField = do
        ress <- [sqlQQ|SELECT ^{Allocation}.@{AllocationId},^{Allocation}.@{aField},^{CronLastExec}.@{CronLastExecTime},^{CronLastExec}.@{CronLastExecInstance} FROM ^{Allocation} INNER JOIN ^{CronLastExec} ON ^{CronLastExec}.@{CronLastExecJob}->'job' = '"queue-notification"' AND ^{CronLastExec}.@{CronLastExecJob}->'notification'->'notification' = '"allocation-staff-register"' AND ^{CronLastExec}.@{CronLastExecJob}->'notification'->'allocation' = (^{Allocation}.@{AllocationId} :: text) :: jsonb ORDER BY ^{Allocation}.@{aField} ASC;|]
        return . flip foldMap ress $ \(Single allocId, Single allocTime, Single execTime, Single execInstance)
          -> _MergeHashMap # HashMap.singleton allocTime (Set.singleton allocId, Max execTime, Last execInstance)

    staffRegisterFroms <- allocationTimes AllocationStaffRegisterFrom
    forM_ staffRegisterFroms $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
      insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationStaffRegister{..}, .. }

    registerFroms <- allocationTimes AllocationRegisterFrom
    forM_ registerFroms $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
      insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationRegister{..}, .. }

    staffAllocationFroms <- allocationTimes AllocationStaffAllocationFrom
    forM_ staffAllocationFroms $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
      insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationAllocation{..}, .. }

    registerTos <- allocationTimes AllocationRegisterTo
    forM_ registerTos $ \(nAllocations, Max cronLastExecTime, Last cronLastExecInstance) ->
      insert_ CronLastExec{ cronLastExecJob = toJSON $ JobQueueNotification NotificationAllocationUnratedApplications{..}, .. }

  Migration20200825StudyFeaturesFirstObserved -> whenM (tableExists "study_features")
    [executeQQ|
      ALTER TABLE study_features RENAME updated TO last_observed;
      ALTER TABLE study_features ADD COLUMN first_observed timestamp with time zone;
      UPDATE study_features SET first_observed = (SELECT MAX(last_observed) FROM study_features as other WHERE other."user" = study_features."user" AND other.degree = study_features.degree AND other.field = study_features.field AND other.type = study_features.type AND other.semester = study_features.semester - 1);
    |]

  Migration20200902FileChunking -> whenM (tableExists "file_content") $ do
    chunkingParams <- lift $ view _appFileChunkingParams

    [executeQQ|
      ALTER TABLE file_content RENAME TO file_content_chunk;
      ALTER INDEX file_content_pkey RENAME TO file_content_chunk_pkey;

      CREATE TABLE file_content_chunk_unreferenced (id bigserial, hash bytea NOT NULL, since timestamp with time zone NOT NULL);
      INSERT INTO file_content_chunk_unreferenced (since, hash) (SELECT unreferenced_since as since, hash FROM file_content_chunk WHERE NOT (unreferenced_since IS NULL));
      ALTER TABLE file_content_chunk DROP COLUMN unreferenced_since;

      ALTER TABLE file_content_chunk ADD COLUMN content_based boolean NOT NULL DEFAULT false;
      UPDATE file_content_chunk SET content_based = true WHERE length(content) <= #{fastCDCMinBlockSize chunkingParams};

      CREATE TABLE file_content_entry (id bigserial NOT NULL PRIMARY KEY, hash bytea NOT NULL, ix bigint NOT NULL, chunk_hash bytea NOT NULL);
      INSERT INTO file_content_entry (hash, chunk_hash, ix) (SELECT hash, hash as chunk_hash, 0 as ix FROM file_content_chunk);
    |]

  Migration20200916ExamMode -> do
    whenM (tableExists "exam")
      [executeQQ|
        ALTER TABLE exam ADD COLUMN "exam_mode" jsonb NOT NULL DEFAULT #{ExamMode Nothing Nothing Nothing Nothing};
      |]
    whenM (tableExists "school")
      [executeQQ|
        ALTER TABLE school ADD COLUMN "exam_discouraged_modes" jsonb NOT NULL DEFAULT #{ExamModeDNF predDNFFalse};
      |]

  Migration20201106StoredMarkup ->
    [executeQQ|
      SET client_min_messages TO WARNING;
      ALTER TABLE IF EXISTS ^{Allocation} ALTER COLUMN @{AllocationDescription} TYPE jsonb USING (CASE WHEN @{AllocationDescription} IS NOT NULL THEN to_json(@{AllocationDescription}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{Allocation} ALTER COLUMN @{AllocationStaffDescription} TYPE jsonb USING (CASE WHEN @{AllocationStaffDescription} IS NOT NULL THEN to_json(@{AllocationStaffDescription}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{Course} ALTER COLUMN @{CourseDescription} TYPE jsonb USING (CASE WHEN @{CourseDescription} IS NOT NULL THEN to_json(@{CourseDescription}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{Course} ALTER COLUMN @{CourseApplicationsInstructions} TYPE jsonb USING (CASE WHEN @{CourseApplicationsInstructions} IS NOT NULL THEN to_json(@{CourseApplicationsInstructions}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{CourseEvent} ALTER COLUMN @{CourseEventNote} TYPE jsonb USING (CASE WHEN @{CourseEventNote} IS NOT NULL THEN to_json(@{CourseEventNote}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{CourseUserNote} ALTER COLUMN @{CourseUserNoteNote} TYPE jsonb USING (CASE WHEN @{CourseUserNoteNote} IS NOT NULL THEN to_json(@{CourseUserNoteNote}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{Material} ALTER COLUMN @{MaterialDescription} TYPE jsonb USING (CASE WHEN @{MaterialDescription} IS NOT NULL THEN to_json(@{MaterialDescription}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{CourseNews} ALTER COLUMN @{CourseNewsContent} TYPE jsonb USING (CASE WHEN @{CourseNewsContent} IS NOT NULL THEN to_json(@{CourseNewsContent}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{CourseNews} ALTER COLUMN @{CourseNewsSummary} TYPE jsonb USING (CASE WHEN @{CourseNewsSummary} IS NOT NULL THEN to_json(@{CourseNewsSummary}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{Exam} ALTER COLUMN @{ExamDescription} TYPE jsonb USING (CASE WHEN @{ExamDescription} IS NOT NULL THEN to_json(@{ExamDescription}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{ExamOccurrence} ALTER COLUMN @{ExamOccurrenceDescription} TYPE jsonb USING (CASE WHEN @{ExamOccurrenceDescription} IS NOT NULL THEN to_json(@{ExamOccurrenceDescription}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{Sheet} ALTER COLUMN @{SheetDescription} TYPE jsonb USING (CASE WHEN @{SheetDescription} IS NOT NULL THEN to_json(@{SheetDescription}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{Sheet} ALTER COLUMN @{SheetMarkingText} TYPE jsonb USING (CASE WHEN @{SheetMarkingText} IS NOT NULL THEN to_json(@{SheetMarkingText}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{SystemMessage} ALTER COLUMN @{SystemMessageContent} TYPE jsonb USING (CASE WHEN @{SystemMessageContent} IS NOT NULL THEN to_json(@{SystemMessageContent}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{SystemMessage} ALTER COLUMN @{SystemMessageSummary} TYPE jsonb USING (CASE WHEN @{SystemMessageSummary} IS NOT NULL THEN to_json(@{SystemMessageSummary}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{SystemMessageTranslation} ALTER COLUMN @{SystemMessageTranslationContent} TYPE jsonb USING (CASE WHEN @{SystemMessageTranslationContent} IS NOT NULL THEN to_json(@{SystemMessageTranslationContent}) ELSE NULL END);
      ALTER TABLE IF EXISTS ^{SystemMessageTranslation} ALTER COLUMN @{SystemMessageTranslationSummary} TYPE jsonb USING (CASE WHEN @{SystemMessageTranslationSummary} IS NOT NULL THEN to_json(@{SystemMessageTranslationSummary}) ELSE NULL END);
      SET client_min_messages TO NOTICE;
    |]

  Migration20201119RoomTypes -> do
    whenM (tableExists "exam_occurrence") $ do
      [executeQQ|ALTER TABLE "exam_occurrence" ADD COLUMN "room_json" jsonb|]
      let getExamOccurrences = [queryQQ|SELECT "id", "room" FROM "exam_occurrence"|]
          migrateExamOccurrence [ fromPersistValue -> Right (eoId :: ExamOccurrenceId), fromPersistValue -> Right roomText ] = [executeQQ|UPDATE "exam_occurrence" SET "room_json" = #{RoomReferenceSimple roomText} WHERE "id" = #{eoId}|]
          migrateExamOccurrence _ = return ()
       in runConduit $ getExamOccurrences .| C.mapM_ migrateExamOccurrence
      [executeQQ|
        ALTER TABLE "exam_occurrence" DROP COLUMN "room";
        ALTER TABLE "exam_occurrence" RENAME COLUMN "room_json" TO "room";
      |]
    whenM (tableExists "tutorial") $ do
      [executeQQ|ALTER TABLE "tutorial" ADD COLUMN "room_json" jsonb|]
      let getTutorials = [queryQQ|SELECT "id", "room" FROM "tutorial"|]
          migrateTutorial [ fromPersistValue -> Right (tutId :: TutorialId), fromPersistValue -> Right roomText ] = [executeQQ|UPDATE "tutorial" SET "room_json" = #{RoomReferenceSimple roomText} WHERE "id" = #{tutId}|]
          migrateTutorial _ = return ()
       in runConduit $ getTutorials .| C.mapM_ migrateTutorial
      [executeQQ|
        ALTER TABLE "tutorial" DROP COLUMN "room";
        ALTER TABLE "tutorial" RENAME COLUMN "room_json" TO "room";
      |]
    whenM (tableExists "course_event") $ do
      [executeQQ|ALTER TABLE "course_event" ADD COLUMN "room_json" jsonb|]
      let getCourseEvents = [queryQQ|SELECT "id", "room" FROM "course_event"|]
          migrateCourseEvent [ fromPersistValue -> Right (ceId :: CourseEventId), fromPersistValue -> Right roomText ] = [executeQQ|UPDATE "course_event" SET "room_json" = #{RoomReferenceSimple roomText} WHERE "id" = #{ceId}|]
          migrateCourseEvent _ = return ()
       in runConduit $ getCourseEvents .| C.mapM_ migrateCourseEvent
      [executeQQ|
        ALTER TABLE "course_event" DROP COLUMN "room";
        ALTER TABLE "course_event" RENAME COLUMN "room_json" TO "room";
      |]
    whenM (tableExists "course") $ do
      let getCourses = [queryQQ|SELECT "id", "link_external" FROM "course"|]
          migrateCourse [ fromPersistValue -> Right (cId :: CourseId), fromPersistValue -> Right (uriText :: Maybe Text) ]
            | Just uri <- parseURI . unpack =<< uriText = [executeQQ|UPDATE "course" SET "link_external" = #{uri} WHERE "id" = #{cId}|]
            | otherwise = [executeQQ|UPDATE "course" SET "link_external" = NULL WHERE "id" = #{cId}|]
          migrateCourse _ = return ()
       in runConduit $ getCourses .| C.mapM_ migrateCourse

  Migration20210115ExamPartsFrom -> do
    whenM (tableExists "exam") $ do
      [executeQQ|ALTER TABLE "exam" ADD COLUMN "parts_from" timestamp with time zone|]
      let getExam = [queryQQ|SELECT "id", "finished" FROM "exam"|]
          migrateExam [ fromPersistValue -> Right (eId :: ExamId), fromPersistValue -> Right (finished :: Maybe UTCTime) ] = [executeQQ|UPDATE "exam" SET "parts_from" = #{finished} WHERE "id" = #{eId}|]
          migrateExam _ = return ()
       in runConduit $ getExam .| C.mapM_ migrateExam

  Migration20210208StudyFeaturesRelevanceCachedUUIDs ->
    whenM (tableExists "study_features") $ do
      [executeQQ|
        ALTER TABLE "study_features" ADD COLUMN "relevance_cached_uuid" uuid
      |]

      let getStudyFeatures = [queryQQ|SELECT "id" FROM "study_features" WHERE relevance_cached|]
          migrateStudyFeatures genUUID lift' [ fromPersistValue -> Right (sfId :: StudyFeaturesId) ] = do
            uuid <- genUUID
            lift' [executeQQ|UPDATE "study_features" SET "relevance_cached_uuid" = #{uuid} WHERE "id" = #{sfId}|]
          migrateStudyFeatures _ _ _ = return ()
       in runConduit $ getStudyFeatures .| randUUIDC (\genUUID lift' -> C.mapM_ $ migrateStudyFeatures genUUID lift')

      [executeQQ|
        ALTER TABLE "study_features" DROP COLUMN "relevance_cached";
        ALTER TABLE "study_features" RENAME COLUMN "relevance_cached_uuid" TO "relevance_cached";
      |]

  -- Placeholder to inform crontab generation when switchover happened so old submissions don't get notified as corrected
  Migration20210318CrontabSubmissionRatedNotification -> return ()

  Migration20210608SeparateTermActive -> do
    now <- liftIO getCurrentTime

    whenM (and2M (tableExists "term") (not <$> tableExists "term_active")) $ do
      [executeQQ|
        CREATe TABLE "term_active" ("id" SERIAL8 PRIMARY KEY UNIQUE, "term" numeric(5,1) NOT NULL, "from" timestamp with time zone NOT NULL)
      |]

      let getTerms = [queryQQ|SELECT "name", "active" FROM "term"|]
          migrateTerms [ fromPersistValue -> Right (tid :: TermId), fromPersistValue -> Right (isActive :: Bool) ] = when isActive
            [executeQQ|INSERT INTO term_active (term, "from") VALUES (#{tid}, #{now})|]
          migrateTerms _ = return ()
       in runConduit $ getTerms .| C.mapM_ migrateTerms

      [executeQQ|
        ALTER TABLE "term" DROP COLUMN "active";
      |]


tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
tableExists table = do
  haveTable <- [sqlQQ| SELECT to_regclass(#{table}); |]
  case haveTable :: [Maybe (Single PersistValue)] of
    [Just _] -> return True
    _other   -> return False

tablesExist :: MonadIO m => [Text] -> ReaderT SqlBackend m Bool
tablesExist = flip allM tableExists

tableIsEmpty :: MonadIO m => Text -> ReaderT SqlBackend m Bool
tableIsEmpty table = do
  res <- rawSql [st|SELECT COUNT(*) FROM "#{table}"|] []
  return $ case res of
    [unSingle -> rows] -> rows == (0 :: Int64)
    _other -> error "tableIsEmpty din't return exactly one result"

tableDropEmpty :: MonadIO m => Text -> ReaderT SqlBackend m ()
tableDropEmpty table = whenM (tableExists table) $ do
  isEmpty <- tableIsEmpty table
  if
    | isEmpty   -> rawExecute [st|DROP TABLE "#{table}" CASCADE|] []
    | otherwise -> error $ "Table " <> unpack table <> " is not empty"

columnExists :: MonadIO m
             => Text -- ^ Table
             -> Text -- ^ Column
             -> ReaderT SqlBackend m Bool
columnExists table column = do
  haveColumn <- [sqlQQ|SELECT column_name FROM information_schema.columns WHERE table_name=#{table} and column_name=#{column};|]
  case haveColumn :: [Single PersistValue] of
    [_]    -> return True
    _other -> return False
