From 1cd0b78fa6d745dfdcecac735512f49221dc8d6d Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Tue, 24 May 2022 12:21:06 -0600 Subject: [PATCH] migrations --- package.yaml | 3 ++- src/Application.hs | 14 ++++++++++++++ src/Migration.hs | 34 ++++++++++++++++++++++++++++++++++ stack.yaml | 1 + 4 files changed, 51 insertions(+), 1 deletion(-) create mode 100644 src/Migration.hs diff --git a/package.yaml b/package.yaml index 3f8d1c1..77496a6 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: start9-registry -version: 0.1.0 +version: 0.2.0 default-extensions: - FlexibleInstances @@ -46,6 +46,7 @@ dependencies: - monad-loops - parallel - persistent + - persistent-migration - persistent-postgresql - persistent-template - process diff --git a/src/Application.hs b/src/Application.hs index b2130bd..6260ba4 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -83,6 +83,8 @@ import Control.Lens import Data.List ( lookup ) import Data.String.Interpolate.IsString ( i ) +import qualified Database.Persist.Migration +import qualified Database.Persist.Migration.Postgres import Database.Persist.Sql ( SqlBackend ) import Foundation import Handler.Admin @@ -95,6 +97,7 @@ import Lib.PkgRepository ( watchEosRepoRoot , watchPkgRepoRoot ) import Lib.Ssl +import Migration ( manualMigration ) import Model import Network.HTTP.Types.Header ( hOrigin ) import Network.Wai.Middleware.Gzip ( GzipFiles(GzipCompress) @@ -107,6 +110,7 @@ import Settings import System.Directory ( createDirectoryIfMissing ) import System.Posix.Process import System.Time.Extra +import qualified UnliftIO import Yesod -- This line actually creates our YesodDispatch instance. It is the second half @@ -152,6 +156,16 @@ makeFoundation appSettings = do -- Preform database migration using application logging settings runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc + `UnliftIO.catch` (\(e :: SomeException) -> do + print e + runSqlPool + (Database.Persist.Migration.Postgres.runMigration + Database.Persist.Migration.defaultSettings + manualMigration + ) + pool + runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc + ) -- Return the foundation return $ mkFoundation pool stopPkgWatch stopEosWatch diff --git a/src/Migration.hs b/src/Migration.hs new file mode 100644 index 0000000..5cacf51 --- /dev/null +++ b/src/Migration.hs @@ -0,0 +1,34 @@ +module Migration where + +import Database.Persist.Migration +import Database.Persist.Sql ( Single(..) ) +import Startlude ( ($) + , (<<$>>) + , Maybe(Just) + ) + +manualMigration :: Migration +manualMigration = [(0, 1) := migration_0_2_0] + +migration_0_2_0 :: [Operation] +migration_0_2_0 = + [ AddColumn "version" (Column "title" SqlString [NotNull]) (Just $ PersistText "") + , AddColumn "version" (Column "desc_short" SqlString [NotNull]) (Just $ PersistText "") + , AddColumn "version" (Column "desc_long" SqlString [NotNull]) (Just $ PersistText "") + , AddColumn "version" (Column "icon_type" SqlString [NotNull]) (Just $ PersistText "") + , populateMetadata + , DropColumn ("pkg_record", "title") + , DropColumn ("pkg_record", "desc_short") + , DropColumn ("pkg_record", "desc_long") + , DropColumn ("pkg_record", "icon_type") + ] + +populateMetadata :: Operation +populateMetadata = + RawOperation "Populating Metadata" + $ migrateTitles + <<$>> rawSql "SELECT pkg_id, title, desc_short, desc_long, icon_type FROM pkg_record" [] + where + migrateTitles (Single id', Single title', Single descShort', Single descLong', Single iconType') = MigrateSql + "UPDATE version SET title = ?, desc_short = ?, desc_long = ?, icon_type = ? where pkg_id = ?" + [PersistText title', PersistText descShort', PersistText descLong', PersistText iconType', PersistText id'] diff --git a/stack.yaml b/stack.yaml index e70c35a..731ea1b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -43,6 +43,7 @@ extra-deps: - protolude-0.3.0 - esqueleto-3.5.1.0 - monad-logger-extras-0.1.1.1 + - persistent-migration-0.3.0 - wai-request-spec-0.10.2.4 - warp-3.3.19 - yesod-auth-basic-0.1.0.3