module Sqel.Migration.Statement where

import qualified Control.Monad.Trans.Writer.Strict as Mtl
import qualified Data.Map.Strict as Map
import qualified Exon
import Hasql.Encoders (Params)
import qualified Hasql.Session as Session
import Hasql.Session (Session)
import qualified Sqel.Data.Migration as Migration
import Sqel.Data.Migration (
  ColumnAction (AddColumn, RemoveColumn, RenameColumn, RenameColumnType),
  MigrationActions (AutoActions, CustomActions),
  TypeAction (AddAction, ModifyAction, RenameAction),
  )
import Sqel.Data.PgType (
  ColumnType (ColumnComp, ColumnPrim),
  PgColumnName (PgColumnName),
  PgComposite (PgComposite),
  PgPrimName (PgPrimName),
  PgTypeRef (PgTypeRef),
  )
import Sqel.Data.PgTypeName (
  pattern PgCompName,
  PgTableName,
  pattern PgTableName,
  pattern PgTypeName,
  PgTypeName,
  pgTableName,
  )
import Sqel.Data.Sql (Sql (Sql), sql)
import qualified Sqel.Sql.Type as Sql
import Sqel.Statement (unprepared)
import qualified Text.Show as Show

data MigrationStatement where
  MigrationStatement :: p -> Params p -> Sql -> MigrationStatement

instance Show MigrationStatement where
  show :: MigrationStatement -> String
show (MigrationStatement p
_ Params p
_ Sql
s) = forall b a. (Show a, IsString b) => a -> b
show Sql
s

migrationStatementSql :: MigrationStatement -> Sql
migrationStatementSql :: MigrationStatement -> Sql
migrationStatementSql (MigrationStatement p
_ Params p
_ Sql
s) =
  Sql
s

alterStatement ::
  PgTypeName table ->
  p ->
  Params p ->
  (Sql -> Sql -> Sql) ->
  Mtl.Writer [MigrationStatement] ()
alterStatement :: forall (table :: Bool) p.
PgTypeName table
-> p
-> Params p
-> (Sql -> Sql -> Sql)
-> Writer [MigrationStatement] ()
alterStatement PgTypeName table
typeName p
p Params p
enc Sql -> Sql -> Sql
f =
  forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Mtl.tell [forall p. p -> Params p -> Sql -> MigrationStatement
MigrationStatement p
p Params p
enc (Sql -> Sql -> Sql
f [sql|alter #{entity} ##{pgTableName name}|] Sql
attr)]
  where
    (Sql
entity, Sql
attr, Text
name) = case PgTypeName table
typeName of
      PgTableName Text
n -> (Sql
"table", Sql
"column", Text
n)
      PgCompName Text
n -> (Sql
"type", Sql
"attribute", Text
n)

-- TODO maybe the default value can be null and the encoder Maybe, to unify the cases
columnStatements' ::
  PgTypeName table ->
  ColumnAction ->
  Mtl.Writer [MigrationStatement] ()
columnStatements' :: forall (table :: Bool).
PgTypeName table -> ColumnAction -> Writer [MigrationStatement] ()
columnStatements' PgTypeName table
typeName = \case
  AddColumn (PgColumnName Text
colName) ColumnType
tpe Maybe (a, Params a)
md -> do
    (Sql -> Sql -> Sql) -> Writer [MigrationStatement] ()
alter_ \ Sql
alter Sql
attr -> [sql|#{alter} add #{attr} ##{colName} #{colTypeName}|]
    case PgTypeName table
typeName of
      PgTableName Text
_ -> do
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (a, Params a)
md \ (a
defVal, Params a
enc) -> do
          forall (table :: Bool) p.
PgTypeName table
-> p
-> Params p
-> (Sql -> Sql -> Sql)
-> Writer [MigrationStatement] ()
alterStatement PgTypeName table
typeName a
defVal Params a
enc \ Sql
_ Sql
_ -> [sql|update ##{comp} set ##{colName} = $1|]
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Sql]
optFrag) \ NonEmpty Sql
opt ->
          (Sql -> Sql -> Sql) -> Writer [MigrationStatement] ()
alter_ \ Sql
alter Sql
attr ->
            [sql|#{alter} alter #{attr} ##{colName} set #{Exon.intercalate " " opt}|]
      PgCompName Text
_ -> forall (f :: * -> *). Applicative f => f ()
unit
    where
      ([Sql]
optFrag, Sql
colTypeName) = case ColumnType
tpe of
        ColumnPrim (PgPrimName Text
n) Bool
_ [Sql]
opt -> ([Sql]
opt, Text -> Sql
Sql Text
n)
        ColumnComp (PgTypeRef Text
n) Bool
_ [Sql]
opt -> ([Sql]
opt, Text -> Sql
Sql Text
n)
  RemoveColumn (PgColumnName Text
name) ColumnType
_ ->
    (Sql -> Sql -> Sql) -> Writer [MigrationStatement] ()
alter_ \ Sql
alter Sql
attr -> [sql|#{alter} drop #{attr} ##{name}|]
  RenameColumn (PgColumnName Text
old) (PgColumnName Text
new) ->
    (Sql -> Sql -> Sql) -> Writer [MigrationStatement] ()
alter_ \ Sql
alter Sql
attr -> [sql|#{alter} rename #{attr} ##{old} to ##{new}|]
  RenameColumnType (PgColumnName Text
old) (PgTypeName Text
new) ->
    (Sql -> Sql -> Sql) -> Writer [MigrationStatement] ()
alter_ \ Sql
alter Sql
attr -> [sql|#{alter} alter #{attr} ##{old} set data type ##{new}|]
  where
    alter_ :: (Sql -> Sql -> Sql) -> Writer [MigrationStatement] ()
alter_ = forall (table :: Bool) p.
PgTypeName table
-> p
-> Params p
-> (Sql -> Sql -> Sql)
-> Writer [MigrationStatement] ()
alterStatement PgTypeName table
typeName () forall a. Monoid a => a
mempty
    PgTypeName Text
comp = PgTypeName table
typeName

typeActionStatements :: PgTypeName table -> TypeAction table -> Mtl.Writer [MigrationStatement] ()
typeActionStatements :: forall (table :: Bool).
PgTypeName table
-> TypeAction table -> Writer [MigrationStatement] ()
typeActionStatements PgTypeName table
typeName = \case
  ModifyAction PgTypeName table
_ [ColumnAction]
cols ->
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (table :: Bool).
PgTypeName table -> ColumnAction -> Writer [MigrationStatement] ()
columnStatements' PgTypeName table
typeName) [ColumnAction]
cols
  RenameAction newName :: PgTypeName 'False
newName@(PgTypeName Text
new) [ColumnAction]
cols -> do
    forall (table :: Bool) p.
PgTypeName table
-> p
-> Params p
-> (Sql -> Sql -> Sql)
-> Writer [MigrationStatement] ()
alterStatement PgTypeName table
typeName () forall a. Monoid a => a
mempty \ Sql
alter Sql
_ -> [sql|#{alter} rename to ##{new}|]
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (table :: Bool).
PgTypeName table -> ColumnAction -> Writer [MigrationStatement] ()
columnStatements' PgTypeName 'False
newName) [ColumnAction]
cols
  AddAction PgColumns
cols ->
    forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Mtl.tell [forall p. p -> Params p -> Sql -> MigrationStatement
MigrationStatement () forall a. Monoid a => a
mempty (PgComposite -> Sql
Sql.createProdType (PgTypeName 'False -> PgColumns -> PgComposite
PgComposite PgTypeName table
typeName PgColumns
cols))]

typeStatements :: PgTypeName table -> TypeAction table -> [MigrationStatement]
typeStatements :: forall (table :: Bool).
PgTypeName table -> TypeAction table -> [MigrationStatement]
typeStatements PgTypeName table
name =
  forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Mtl.runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (table :: Bool).
PgTypeName table
-> TypeAction table -> Writer [MigrationStatement] ()
typeActionStatements PgTypeName table
name

migrationStatements :: PgTableName -> MigrationActions ext -> [MigrationStatement]
migrationStatements :: forall ext.
PgTypeName 'True -> MigrationActions ext -> [MigrationStatement]
migrationStatements PgTypeName 'True
tableName = \case
  AutoActions {Map (PgTypeName 'False) CompAction
TableAction
$sel:types:AutoActions :: forall ext.
MigrationActions ext -> Map (PgTypeName 'False) CompAction
$sel:table:AutoActions :: forall ext. MigrationActions ext -> TableAction
types :: Map (PgTypeName 'False) CompAction
table :: TableAction
..} ->
    forall (table :: Bool).
PgTypeName table -> TypeAction table -> [MigrationStatement]
typeStatements PgTypeName 'True
tableName TableAction
table forall a. Semigroup a => a -> a -> a
<> (forall k a. Map k a -> [(k, a)]
Map.toList Map (PgTypeName 'False) CompAction
types forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (PgTypeName 'False
name, CompAction
actions) -> forall (table :: Bool).
PgTypeName table -> TypeAction table -> [MigrationStatement]
typeStatements PgTypeName 'False
name CompAction
actions)
  CustomActions ext
_ ->
    []

migrationSession :: [MigrationStatement] -> Session ()
migrationSession :: [MigrationStatement] -> Session ()
migrationSession =
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ (MigrationStatement p
p Params p
enc Sql
stmt) -> forall params result.
params -> Statement params result -> Session result
Session.statement p
p (forall result d p.
ResultShape d result =>
Sql -> Row d -> Params p -> Statement p result
unprepared @() Sql
stmt forall (f :: * -> *). Applicative f => f ()
unit Params p
enc)