{-|
Module      :  Database.Persist.Migration
Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
Stability   :  experimental
Portability :  portable

Defines a migration framework for the persistent library.
-}

module Database.Persist.Migration
  ( hasMigration
  , checkMigration
  -- * Re-exports
  , module Database.Persist.Migration.Backend
  , module Database.Persist.Migration.Core
  , module Database.Persist.Migration.Operation
  , module Database.Persist.Migration.Operation.Types
  , 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.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.
hasMigration :: MonadIO m => Persistent.Migration -> Persistent.SqlPersistT m Bool
hasMigration :: Migration -> SqlPersistT m Bool
hasMigration = ([Text] -> Bool)
-> ReaderT SqlBackend m [Text] -> SqlPersistT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (ReaderT SqlBackend m [Text] -> SqlPersistT m Bool)
-> (Migration -> ReaderT SqlBackend m [Text])
-> Migration
-> SqlPersistT m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m [Text]
Persistent.showMigration

-- | Fails if the persistent library detects more migrations unaccounted for.
checkMigration :: MonadIO m => Persistent.Migration -> Persistent.SqlPersistT m ()
checkMigration :: Migration -> SqlPersistT m ()
checkMigration Migration
migration = do
  [Text]
migrationText <- Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m [Text]
Persistent.showMigration Migration
migration
  Bool -> SqlPersistT m () -> SqlPersistT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
migrationText) (SqlPersistT m () -> SqlPersistT m ())
-> SqlPersistT m () -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SqlPersistT m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> SqlPersistT m ()) -> [Char] -> SqlPersistT m ()
forall a b. (a -> b) -> a -> b
$
    [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"More migrations detected:" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Text] -> [[Char]]
bullets [Text]
migrationText
  where
    bullets :: [Text] -> [[Char]]
bullets = (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
" * " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ) ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack)