migrations

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

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

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']

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