packages feed

persistent-migration 0.1.0 → 0.2.0

raw patch · 14 files changed

+122/−88 lines, 14 files

Files

CHANGELOG.md view
@@ -1,3 +1,14 @@+## persistent-migration 0.2.0++Breaking changes:+* Moved some types out of `Database.Persist.Migration.Operation` and into `Database.Persist.Migration.Core`++Fixes:+* Fix for GHC 8.8++Other changes:+* Re-export `rawSql` in `Database.Persist.Migration`+ ## persistent-migration 0.1.0  Breaking changes:
README.md view
@@ -1,10 +1,13 @@ # persistent-migration  [![CircleCI](https://circleci.com/gh/brandonchinn178/persistent-migration/tree/master.svg?style=svg)](https://circleci.com/gh/brandonchinn178/persistent-migration/tree/master)+[![Hackage](https://img.shields.io/hackage/v/persistent-migration.svg)](https://hackage.haskell.org/package/persistent-migration)  This is a migration library for the [persistent](http://www.stackage.org/package/persistent) package. +## Overview+ By default, persistent provides a way to do automatic migrations; how to quickly and conveniently update the schema to match the definitions of the models. Because of its automatic nature, it will also balk at any operations@@ -24,9 +27,10 @@ run the `Operations` necessary to get from the current version to the latest version. -```+## Usage++```haskell import Database.Persist.Migration-import Database.Persist.Sql (PersistValue(..), rawSql)  createPerson :: CreateTable createPerson = CreateTable@@ -85,7 +89,7 @@   ] ``` -```+```haskell import Database.Persist.Migration (checkMigration, defaultSettings) import Database.Persist.Migration.Postgres (runMigration) @@ -104,3 +108,22 @@ ```  For more examples, see `test/integration/Migration.hs`.++## FAQs++* I don't know the `SqlType` corresponding to my column's Haskell type++As a general rule, complicated JSON serialization will be `SqlBlob`, but+it might be `SqlString` for simpler data types. You can always choose one,+and see if Persistent complains about it needing to be another type.++For example, you might want to put `SqlBlob` first, and see if Persistent+errors with something like:++```+More migrations detected:+ * ALTER TABLE table ALTER COLUMN col TYPE VARCHAR+```++If Persistent tries to change the type to `VARCHAR`, then it probably+wants `SqlString` instead.
persistent-migration.cabal view
@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 809c91fc705a1d5507bcc49baa3cd4b3d0afd5c49c9b783cef1f88e649cd4073+-- hash: ba05ddb62204797a742d3b09fe26c8f9469e7c342a690d1e19a803873653c5f9  name:           persistent-migration-version:        0.1.0+version:        0.2.0 synopsis:       Manual migrations for the persistent library description:    Manual migrations for the persistent library. category:       Database@@ -16,7 +18,6 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.18 extra-doc-files:     CHANGELOG.md     README.md@@ -25,11 +26,6 @@   type: git   location: https://github.com/brandonchinn178/persistent-migration -flag dev-  description: Turn on development settings.-  manual: True-  default: False- library   exposed-modules:       Database.Persist.Migration@@ -55,10 +51,10 @@     , text     , time     , unordered-containers-  if flag(dev)-    ghc-options: -Werror   if impl(ghc >= 8.0)-    ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+    ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances+  if impl(ghc < 8.8)+    ghc-options: -Wnoncanonical-monadfail-instances   default-language: Haskell2010  test-suite persistent-migration-integration@@ -96,10 +92,10 @@     , text     , time     , yaml-  if flag(dev)-    ghc-options: -Werror   if impl(ghc >= 8.0)-    ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+    ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances+  if impl(ghc < 8.8)+    ghc-options: -Wnoncanonical-monadfail-instances   default-language: Haskell2010  test-suite persistent-migration-test@@ -130,8 +126,8 @@     , tasty-quickcheck     , text     , time-  if flag(dev)-    ghc-options: -Werror   if impl(ghc >= 8.0)-    ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+    ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances+  if impl(ghc < 8.8)+    ghc-options: -Wnoncanonical-monadfail-instances   default-language: Haskell2010
src/Database/Persist/Migration.hs view
@@ -18,17 +18,18 @@   , module Database.Persist.Migration.Utils.Sql   , PersistValue(..)   , SqlType(..)+  , rawSql   ) where  import Control.Monad (unless) import Control.Monad.IO.Class (MonadIO) import qualified Data.Text as Text-import Database.Persist (PersistValue(..), SqlType(..)) import Database.Persist.Migration.Backend import Database.Persist.Migration.Core hiding (getMigration, runMigration) import Database.Persist.Migration.Operation import Database.Persist.Migration.Operation.Types import Database.Persist.Migration.Utils.Sql+import Database.Persist.Sql (PersistValue(..), SqlType(..), rawSql) import qualified Database.Persist.Sql as Persistent  -- | True if the persistent library detects more migrations unaccounted for.@@ -39,7 +40,7 @@ checkMigration :: MonadIO m => Persistent.Migration -> Persistent.SqlPersistT m () checkMigration migration = do   migrationText <- Persistent.showMigration migration-  unless (null migrationText) $ fail $+  unless (null migrationText) $ error $     unlines $ "More migrations detected:" : bullets migrationText   where     bullets = map ((" * " ++ ) . Text.unpack)
src/Database/Persist/Migration/Core.hs view
@@ -10,14 +10,19 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}  module Database.Persist.Migration.Core-  ( MigrateSettings(..)+  ( Version+  , OperationPath+  , (~>)+  , Migration+  , MigrationPath(..)+  , opPath+  , MigrateSettings(..)   , defaultSettings   , validateMigration   , runMigration@@ -32,14 +37,7 @@ import qualified Data.Text as Text import Data.Time.Clock (getCurrentTime) import Database.Persist.Migration.Backend (MigrateBackend(..))-import Database.Persist.Migration.Operation-    ( Migration-    , MigrationPath(..)-    , Operation(..)-    , Version-    , opPath-    , validateOperation-    )+import Database.Persist.Migration.Operation (Operation(..), validateOperation) import Database.Persist.Migration.Operation.Types     (Column(..), ColumnProp(..), TableConstraint(..)) import Database.Persist.Migration.Utils.Plan (getPath)@@ -48,6 +46,34 @@     (PersistValue(..), Single(..), SqlPersistT, rawExecute, rawSql) import Database.Persist.Types (SqlType(..)) +-- | The version of a database. An operation migrates from the given version to another version.+--+-- The version must be increasing, such that the lowest version is the first version and the highest+-- version is the most up-to-date version.+--+-- A version represents a version of the database schema. In other words, any set of operations+-- taken to get to version X *MUST* all result in the same database schema.+type Version = Int++-- | The path that an operation takes.+type OperationPath = (Version, Version)++-- | An infix constructor for 'OperationPath'.+(~>) :: Version -> Version -> OperationPath+(~>) = (,)++-- | A migration list that defines operations to manually migrate a database schema.+type Migration = [MigrationPath]++-- | A path representing the operations needed to run to get from one version of the database schema+-- to the next.+data MigrationPath = OperationPath := [Operation]+  deriving (Show)++-- | Get the OperationPath in the MigrationPath.+opPath :: MigrationPath -> OperationPath+opPath (path := _) = path+ -- | Get the current version of the database, or Nothing if none exists. getCurrVersion :: MonadIO m => MigrateBackend -> SqlPersistT m (Maybe Version) getCurrVersion backend = do@@ -136,12 +162,12 @@   -> Migration   -> SqlPersistT m [MigrateSql] getMigration backend _ migration = do-  either fail return $ validateMigration migration+  either error return $ validateMigration migration   currVersion <- getCurrVersion backend   operations <- either badPath return $ getOperations migration currVersion-  either fail return $ mapM_ validateOperation operations+  either error return $ mapM_ validateOperation operations   concatMapM (mapReaderT liftIO . getMigrationSql backend) operations   where-    badPath (start, end) = fail $ "Could not find path: " ++ show start ++ " ~> " ++ show end+    badPath (start, end) = error $ "Could not find path: " ++ show start ++ " ~> " ++ show end     -- Utilities     concatMapM f = fmap concat . mapM f
src/Database/Persist/Migration/Operation.hs view
@@ -8,17 +8,10 @@ -} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Database.Persist.Migration.Operation-  ( Version-  , OperationPath-  , (~>)-  , Migration-  , MigrationPath(..)-  , opPath-  , Operation(..)+  ( Operation(..)   , validateOperation   ) where @@ -30,34 +23,6 @@ import Database.Persist.Migration.Utils.Data (isConstr) import Database.Persist.Migration.Utils.Sql (MigrateSql) import Database.Persist.Sql (PersistValue, SqlPersistT)---- | The version of a database. An operation migrates from the given version to another version.------ The version must be increasing, such that the lowest version is the first version and the highest--- version is the most up-to-date version.------ A version represents a version of the database schema. In other words, any set of operations--- taken to get to version X *MUST* all result in the same database schema.-type Version = Int---- | The path that an operation takes.-type OperationPath = (Version, Version)---- | An infix constructor for 'OperationPath'.-(~>) :: Version -> Version -> OperationPath-(~>) = (,)---- | A migration list that defines operations to manually migrate a database schema.-type Migration = [MigrationPath]---- | A path representing the operations needed to run to get from one version of the database schema--- to the next.-data MigrationPath = OperationPath := [Operation]-  deriving (Show)---- | Get the OperationPath in the MigrationPath.-opPath :: MigrationPath -> OperationPath-opPath (path := _) = path  -- | An operation that can be migrated. data Operation
src/Database/Persist/Migration/Postgres.hs view
@@ -22,7 +22,7 @@ import qualified Data.Text as Text import Database.Persist.Migration import qualified Database.Persist.Migration.Core as Migration-import Database.Persist.Sql (PersistValue, SqlPersistT, SqlType(..))+import Database.Persist.Sql (SqlPersistT)  -- | Run a migration with the Postgres backend. runMigration :: MigrateSettings -> Migration -> SqlPersistT IO ()
src/Database/Persist/Migration/Utils/Sql.hs view
@@ -6,6 +6,7 @@  Defines helper functions for writing SQL queries. -}+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -22,7 +23,9 @@   ) where  import Control.Monad.IO.Class (MonadIO(..))+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Text (Text) import qualified Data.Text as Text import Database.Persist.Sql (PersistValue(..), SqlPersistT)
test/integration/Migration.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -8,8 +10,10 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unused-top-binds #-}  module Migration (testMigrations) where@@ -18,22 +22,15 @@ import Control.Monad (unless, when) import Data.ByteString.Lazy (ByteString, fromStrict) import Data.Maybe (mapMaybe)+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Pool (Pool) import Data.Text (Text) import Data.Yaml (array, encode, object, (.=)) import Database.Persist (Entity(..), get, insertKey, insertMany_, selectList) import Database.Persist.Migration-import Database.Persist.Migration.Utils.Sql (uncommas, uncommas')-import Database.Persist.Sql-    ( PersistValue(..)-    , Single(..)-    , SqlBackend-    , SqlPersistT-    , SqlType(..)-    , rawExecute-    , rawSql-    )+import Database.Persist.Sql (Single(..), SqlBackend, SqlPersistT, rawExecute) import Database.Persist.TH     (mkMigrate, mkPersist, persistLowerCase, share, sqlSettings) import Test.Tasty (TestTree, testGroup)
test/integration/Property.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}@@ -11,7 +12,9 @@ import Control.Monad.IO.Class (liftIO) import Data.List (nub) import Data.Maybe (mapMaybe)+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Pool (Pool) import qualified Data.Text as Text import qualified Data.Text.IO as Text@@ -123,9 +126,9 @@       table <- pick arbitrary       fkTables <- pick $ getForeignKeyTables table       runSqlPool' $ mapM_ (runOperation' . toOperation) (fkTables ++ [table])-      isSuccess <- toBool <$> action (table, fkTables)+      isSuccessful <- toBool <$> action (table, fkTables)       runSqlPool' $ mapM_ dropTable' (table:fkTables)-      unless isSuccess $ stop rejected+      unless isSuccessful $ stop rejected     dropTable' CreateTable'{ctName} = runOperation' $ DropTable ctName  {- Helpers -}
test/integration/Utils/Backends.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}  module Utils.Backends@@ -7,7 +8,9 @@ import Control.Concurrent (threadDelay) import Control.Monad.Logger (runNoLoggingT) import qualified Data.ByteString.Char8 as ByteString+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Pool (Pool, destroyAllResources) import qualified Data.Text as Text import qualified Data.Text.IO as Text
test/unit/Migration.hs view
@@ -7,7 +7,6 @@ import qualified Data.Text as Text import Database.Persist.Migration import Database.Persist.Migration.Core (getMigration)-import Database.Persist.Sql (SqlType(..)) import Test.Tasty (TestName, TestTree, testGroup)  import Utils.Backends
test/unit/Utils/Backends.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}@@ -70,6 +71,9 @@     , connLimitOffset = error "connLimitOffset"     , connLogFunc = \_ _ _ _ -> return ()     , connMaxParams = error "connMaxParams"+#if MIN_VERSION_persistent(2, 9, 0)+    , connRepsertManySql = error "connRepsertManySql"+#endif     }   where     stmt = Statement
test/utils/Utils/QuickCheck.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -19,7 +20,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as ByteString import Data.List (nub)+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text@@ -56,7 +59,7 @@     let tableNames' = filter (/= name) tableNames     cols <- vectorOf (length colNames') $ genColumn tableNames'     let idCol = Column "id" SqlInt32 [NotNull, AutoIncrement]-        cols' = map (\(colName', col) -> col{colName = colName'}) $ zip colNames' cols+        cols' = zipWith (\colName' col -> col{colName = colName'}) colNames' cols         ctSchema = idCol : cols'      -- all of the columns that will be unique@@ -171,7 +174,7 @@   SqlTime -> PersistTimeOfDay <$> arbitrary   SqlDayTime -> PersistUTCTime <$> arbitrary   SqlBlob -> PersistByteString . ByteString.map cleanText <$> arbitrary-  SqlOther _ -> fail "SqlOther not supported"+  SqlOther _ -> error "SqlOther not supported"   where     cleanDouble :: Double -> Double     cleanDouble x = if isInfinite x || isNaN x then 0 else x