Use the new migration system in place of persistent's one

config/models

@@ -12,6 +12,13 @@
 -- with this software. If not, see
 -- <http://creativecommons.org/publicdomain/zero/1.0/>.
 
+-------------------------------------------------------------------------------
+-- Meta
+-------------------------------------------------------------------------------
+
+SchemaVersion
+    number Int
+
 -------------------------------------------------------------------------------
 -- People
 -------------------------------------------------------------------------------

src/Vervis/Application.hs

@@ -65,6 +65,7 @@ import Vervis.Handler.Ticket
 import Vervis.Handler.Wiki
 import Vervis.Handler.Workflow
 
+import Vervis.Migration (migrateDB)
 import Vervis.Ssh (runSsh)
 
 -- This line actually creates our YesodDispatch instance. It is the second half
@@ -107,7 +108,8 @@ makeFoundation appSettings = do
         (pgPoolSize $ appDatabaseConf appSettings)
 
     -- Perform database migration using our application's logging settings.
-    runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
+    --runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
+    runLoggingT (runSqlPool migrateDB pool) logFunc
 
     -- Return the foundation
     return $ mkFoundation pool

src/Vervis/Migration.hs

@@ -0,0 +1,71 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Vervis.Migration
+    ( migrateDB
+    )
+where
+
+import Prelude
+
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+import Data.Maybe (fromMaybe)
+import Database.Persist
+import Database.Persist.Sql (SqlBackend, toSqlKey)
+
+import Database.Persist.Schema
+import Database.Persist.Schema.PostgreSQL (schemaBackend)
+
+import Vervis.Model
+
+key :: SchemaVersionId
+key = toSqlKey 1
+
+getDbSchemaVersion :: MonadIO m => ReaderT SqlBackend m (Maybe Int)
+getDbSchemaVersion = fmap schemaVersionNumber <$> get key
+
+setDbSchemaVersion :: MonadIO m => Int -> ReaderT SqlBackend m ()
+setDbSchemaVersion v = update key [SchemaVersionNumber =. v]
+
+-- | Run the migration system. The second parameter is the list of migration
+-- actions in chronological order. The migration process is:
+--
+-- * Check the schema version of the DB
+-- * Compare to the schema version of the app, which is the length of the list
+-- * If any migrations are required, run them
+-- * Update the schema version in the DB
+runMigrations
+    :: MonadIO m
+    => SchemaBackend SqlBackend
+    -> [SchemaT SqlBackend m ()]
+    -> ReaderT SqlBackend m ()
+runMigrations sb migrations = do
+    dver <- fromMaybe 0 <$> getDbSchemaVersion
+    let aver = length migrations
+    if aver < dver
+        then error "Older app version running with newer DB schema version"
+        else do
+            let migs = drop dver migrations
+            runReaderT (sequence migs) sb
+            setDbSchemaVersion aver
+
+changes :: MonadIO m => [SchemaT SqlBackend m ()]
+changes =
+    [
+    ]
+
+migrateDB :: MonadIO m => ReaderT SqlBackend m ()
+migrateDB = runMigrations schemaBackend changes

src/Vervis/Model.hs

@@ -35,7 +35,7 @@ import Vervis.Model.Workflow
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities at:
 -- http://www.yesodweb.com/book/persistent/
-share [mkPersist sqlSettings, mkMigrate "migrateAll"]
+share [mkPersist sqlSettings{-, mkMigrate "migrateAll"-}]
     $(persistFileWith lowerCaseSettings "config/models")
 
 instance HashDBUser Person where

vervis.cabal

@@ -146,6 +146,7 @@ library
                        Vervis.Import
                        Vervis.Import.NoFoundation
                        Vervis.MediaType
+                       Vervis.Migration
                        Vervis.Model
                        Vervis.Model.Entity
                        Vervis.Model.Group