{-# LANGUAGE OverloadedStrings #-}
module Database.Schema.Migrations.Migration
    ( Migration(..)
    , newMigration
    , emptyMigration
    )
where

import Database.Schema.Migrations.Dependencies

import Data.Text ( Text )
import Data.Time () -- for UTCTime Show instance
import qualified Data.Time.Clock as Clock

data Migration = Migration { Migration -> Maybe UTCTime
mTimestamp :: Maybe Clock.UTCTime
                           , Migration -> Text
mId :: Text
                           , Migration -> Maybe Text
mDesc :: Maybe Text
                           , Migration -> Text
mApply :: Text
                           , Migration -> Maybe Text
mRevert :: Maybe Text
                           , Migration -> [Text]
mDeps :: [Text]
                           }
               deriving (Migration -> Migration -> Bool
(Migration -> Migration -> Bool)
-> (Migration -> Migration -> Bool) -> Eq Migration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Migration -> Migration -> Bool
$c/= :: Migration -> Migration -> Bool
== :: Migration -> Migration -> Bool
$c== :: Migration -> Migration -> Bool
Eq, Int -> Migration -> ShowS
[Migration] -> ShowS
Migration -> String
(Int -> Migration -> ShowS)
-> (Migration -> String)
-> ([Migration] -> ShowS)
-> Show Migration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Migration] -> ShowS
$cshowList :: [Migration] -> ShowS
show :: Migration -> String
$cshow :: Migration -> String
showsPrec :: Int -> Migration -> ShowS
$cshowsPrec :: Int -> Migration -> ShowS
Show, Eq Migration
Eq Migration
-> (Migration -> Migration -> Ordering)
-> (Migration -> Migration -> Bool)
-> (Migration -> Migration -> Bool)
-> (Migration -> Migration -> Bool)
-> (Migration -> Migration -> Bool)
-> (Migration -> Migration -> Migration)
-> (Migration -> Migration -> Migration)
-> Ord Migration
Migration -> Migration -> Bool
Migration -> Migration -> Ordering
Migration -> Migration -> Migration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Migration -> Migration -> Migration
$cmin :: Migration -> Migration -> Migration
max :: Migration -> Migration -> Migration
$cmax :: Migration -> Migration -> Migration
>= :: Migration -> Migration -> Bool
$c>= :: Migration -> Migration -> Bool
> :: Migration -> Migration -> Bool
$c> :: Migration -> Migration -> Bool
<= :: Migration -> Migration -> Bool
$c<= :: Migration -> Migration -> Bool
< :: Migration -> Migration -> Bool
$c< :: Migration -> Migration -> Bool
compare :: Migration -> Migration -> Ordering
$ccompare :: Migration -> Migration -> Ordering
$cp1Ord :: Eq Migration
Ord)

instance Dependable Migration where
    depsOf :: Migration -> [Text]
depsOf = Migration -> [Text]
mDeps
    depId :: Migration -> Text
depId = Migration -> Text
mId

emptyMigration :: Text -> Migration
emptyMigration :: Text -> Migration
emptyMigration Text
name =
  Migration :: Maybe UTCTime
-> Text -> Maybe Text -> Text -> Maybe Text -> [Text] -> Migration
Migration { mTimestamp :: Maybe UTCTime
mTimestamp = Maybe UTCTime
forall a. Maybe a
Nothing
            , mId :: Text
mId = Text
name
            , mApply :: Text
mApply = Text
""
            , mRevert :: Maybe Text
mRevert = Maybe Text
forall a. Maybe a
Nothing
            , mDesc :: Maybe Text
mDesc = Maybe Text
forall a. Maybe a
Nothing
            , mDeps :: [Text]
mDeps = []
            }

newMigration :: Text -> Migration
newMigration :: Text -> Migration
newMigration Text
theId = 
  (Text -> Migration
emptyMigration Text
theId) 
    { mApply :: Text
mApply = Text
"(Apply SQL here.)"
    , mDesc :: Maybe Text
mDesc = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(Describe migration here.)"
    }