module Database.Rivet.V0 (
Migration
, createTable
, dropTable
, renameColumn
, addColumn
, dropColumn
, sql
, ColumnSpec(..)
) where
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Text (Text)
import Database.Rivet
data ColumnSpec = ColumnSpec { colName :: Text
, colType :: Text
, colDefault :: Maybe Text
, colConstraints :: Maybe Text
}
swap :: Syntax m -> Syntax m
swap (SQL up down) = SQL down up
swap (App up down) = App down up
add :: Monad m => (Text, Text) -> Migration m ()
add (up, down) = Migration () [SQL up down]
invert :: Monad m => Migration m () -> Migration m ()
invert (Migration () ps) = Migration () (map swap ps)
stripDown :: Monad m => Migration m () -> Migration m ()
stripDown (Migration () ps) = Migration () (map elimDown ps)
where elimDown (SQL up _) = SQL up ""
elimDown (App up _) = App up (return ())
createTable :: Monad m => Text -> [ColumnSpec] -> Migration m ()
createTable tab cols =
do add ("CREATE TABLE " <> tab <> "()", "DROP TABLE " <> tab)
stripDown $ mapM_ (addColumn tab) cols
dropTable :: Monad m => Text -> [ColumnSpec] -> Migration m ()
dropTable tab = invert . createTable tab
renameColumn :: Monad m => Text -> Text -> Text -> Migration m ()
renameColumn tab old new =
add ("ALTER TABLE " <> tab <> " RENAME COLUMN " <> old <> " TO " <> new
,"ALTER TABLE " <> tab <> " RENAME COLUMN " <> new <> " TO " <> old)
addColumn :: Monad m => Text -> ColumnSpec -> Migration m ()
addColumn tab (ColumnSpec nm ty def constr) =
add ("ALTER TABLE " <> tab <> " ADD COLUMN " <> nm <>
" " <> ty <> maybe "" (" DEFAULT " <>) def <> " " <>
fromMaybe "" constr,
"ALTER TABLE " <> tab <> " DROP COLUMN " <> nm)
dropColumn :: Monad m => Text -> ColumnSpec -> Migration m ()
dropColumn tab = invert . addColumn tab
sql :: Monad m => Text -> Text -> Migration m ()
sql up down = Migration () [SQL up down]