{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
-- |Utilities for writing migrations.
module Refurb.MigrationUtils where

import ClassyPrelude
import Control.Monad.Base (liftBase)
import Control.Monad.Logger (logDebug)
import Data.Profunctor.Product.Default (Default)
import qualified Data.Text as T
import qualified Database.PostgreSQL.Simple as PG
import Database.PostgreSQL.Simple.ToRow (toRow)
import Database.PostgreSQL.Simple.Types (fromQuery)
import qualified Language.Haskell.TH.Syntax as TH
import qualified Language.Haskell.TH.Quote as TH
import qualified Opaleye
import Opaleye.Internal.Table (tableIdentifier)
import Refurb.Types (MonadMigration)

-- |Simple quasiquoter which just makes it easier to embed literal chunks of SQL in migrations.
--
-- For example:
--
-- @
--   createStuffIndex :: MonadMigration m => m ()
--   createStuffIndex =
--     execute_
--       [qqSql|
--         create index stuff_index
--           on stuff (things)
--           where is_what_we_want_to_index = 't'
--       |]
-- @
qqSql :: TH.QuasiQuoter
qqSql :: QuasiQuoter
qqSql = TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
TH.quoteExp  = \ String
s -> [| $(TH.lift s) :: PG.Query |]
  , quotePat :: String -> Q Pat
TH.quotePat  = forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteType :: String -> Q Type
TH.quoteType = forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteDec :: String -> Q [Dec]
TH.quoteDec  = forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  }

-- |Quasiquoter which takes a block of literal SQL and converts it into a list of 'PG.Query' values, e.g. to pass to 'executeSeries_'. A semicolon at the
-- beginning or end of a line (sans whitespace) separates SQL statements.
--
-- For example:
--
-- @
--   createStuff :: MonadMigration m => m ()
--   createStuff =
--     executeSeries_ [qqSqls|
--       create sequence stuff_seq;
--       create table stuff
--         ( id bigint not null primary key default nextval('stuff_seq')
--         );
--       |]
-- @
qqSqls :: TH.QuasiQuoter
qqSqls :: QuasiQuoter
qqSqls = TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
TH.quoteExp  = \ String
s -> [| $(bodyToStatements s) :: [PG.Query] |]
  , quotePat :: String -> Q Pat
TH.quotePat  = forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteType :: String -> Q Type
TH.quoteType = forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteDec :: String -> Q [Dec]
TH.quoteDec  = forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  }
  where
    bodyToStatements :: String -> TH.Q TH.Exp
    bodyToStatements :: String -> Q Exp
bodyToStatements = forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall mono. MonoFoldable mono => mono -> [Element mono]
unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> Bool
null) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> Bool
null)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> [Text] -> [[Text]]
go [] forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Textual t => t -> [t]
lines forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => [Element seq] -> seq
pack
      where
        go :: [Text] -> [Text] -> [[Text]]
go [Text]
acc [] = [[Text]
acc]
        go [Text]
acc ((Text -> Text
T.strip -> Text
l):[Text]
ls)
          | Just Text
l' <- Text -> Text -> Maybe Text
T.stripSuffix Text
";" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
T.stripPrefix Text
";" Text
l =
            forall seq. SemiSequence seq => seq -> seq
reverse [Text]
acc forall a. a -> [a] -> [a]
: [Text
l'] forall a. a -> [a] -> [a]
: [Text] -> [Text] -> [[Text]]
go [] [Text]
ls
          | Just Text
l' <- Text -> Text -> Maybe Text
T.stripPrefix Text
";" Text
l =
            forall seq. SemiSequence seq => seq -> seq
reverse [Text]
acc forall a. a -> [a] -> [a]
: [Text] -> [Text] -> [[Text]]
go [Text
l'] [Text]
ls
          | Just Text
l' <- Text -> Text -> Maybe Text
T.stripSuffix Text
";" Text
l =
            forall seq. SemiSequence seq => seq -> seq
reverse (Text
l' forall a. a -> [a] -> [a]
: [Text]
acc) forall a. a -> [a] -> [a]
: [Text] -> [Text] -> [[Text]]
go [] [Text]
ls
          | Bool
otherwise =
            [Text] -> [Text] -> [[Text]]
go (Text
l forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
ls

-- |Execute some parameterized SQL against the database connection.
-- Wraps 'PG.execute' using the 'MonadMigration' reader to get the connection.
execute :: (MonadMigration m, PG.ToRow q) => PG.Query -> q -> m Int64
execute :: forall (m :: * -> *) q.
(MonadMigration m, ToRow q) =>
Query -> q -> m Int64
execute Query
q q
p = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall a b. (a -> b) -> a -> b
$ forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Query -> ByteString
fromQuery Query
q) forall a. Semigroup a => a -> a -> a
<> Text
" with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall a. ToRow a => a -> [Action]
toRow q
p)
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall q. ToRow q => Connection -> Query -> q -> IO Int64
PG.execute Connection
conn Query
q q
p

-- |Execute some parameterized SQL against the database connection.
-- Wraps 'PG.executeMany' using the 'MonadMigration' reader to get the connection.
executeMany :: (MonadMigration m, PG.ToRow q) => PG.Query -> [q] -> m Int64
executeMany :: forall (m :: * -> *) q.
(MonadMigration m, ToRow q) =>
Query -> [q] -> m Int64
executeMany Query
q [q]
ps = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall a b. (a -> b) -> a -> b
$ forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Query -> ByteString
fromQuery Query
q) forall a. Semigroup a => a -> a -> a
<> Text
" with ["
    forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((if forall mono. MonoFoldable mono => mono -> Int
length [q]
ps forall a. Ord a => a -> a -> Bool
> Int
1 then (forall a. Semigroup a => a -> a -> a
<> Text
", ...") else forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> Text
tshow forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ToRow a => a -> [Action]
toRow) (forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay [q]
ps) forall a. Semigroup a => a -> a -> a
<> Text
"]"
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall q. ToRow q => Connection -> Query -> [q] -> IO Int64
PG.executeMany Connection
conn Query
q [q]
ps

-- |Execute some fixed SQL against the database connection.
-- Wraps 'PG.execute_' using the 'MonadMigration' reader to get the connection.
execute_ :: MonadMigration m => PG.Query -> m Int64
execute_ :: forall (m :: * -> *). MonadMigration m => Query -> m Int64
execute_ Query
q = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 forall a b. (a -> b) -> a -> b
$ Query -> ByteString
fromQuery Query
q
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO Int64
PG.execute_ Connection
conn Query
q

-- |Execute a series of fixed SQL statements against the database connection.
-- Equivalent to `traverse_ (void . execute_)`
executeSeries_ :: MonadMigration m => [PG.Query] -> m ()
executeSeries_ :: forall (m :: * -> *). MonadMigration m => [Query] -> m ()
executeSeries_ = forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
(Element mono -> f b) -> mono -> f ()
traverse_ (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *). MonadMigration m => Query -> m Int64
execute_)

-- |Run a parameterized query against the database connection.
-- Wraps 'PG.query' using the 'MonadMigration' reader to get the connection.
query :: (MonadMigration m, PG.ToRow q, PG.FromRow r) => PG.Query -> q -> m [r]
query :: forall (m :: * -> *) q r.
(MonadMigration m, ToRow q, FromRow r) =>
Query -> q -> m [r]
query Query
q q
p = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall a b. (a -> b) -> a -> b
$ forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Query -> ByteString
fromQuery Query
q) forall a. Semigroup a => a -> a -> a
<> Text
" with " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall a. ToRow a => a -> [Action]
toRow q
p)
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
conn Query
q q
p

-- |Run a fixed query against the database connection.
-- Wraps 'PG.query_' using the 'MonadMigration' reader to get the connection.
query_ :: (MonadMigration m, PG.FromRow r) => PG.Query -> m [r]
query_ :: forall (m :: * -> *) r.
(MonadMigration m, FromRow r) =>
Query -> m [r]
query_ Query
q = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 forall a b. (a -> b) -> a -> b
$ Query -> ByteString
fromQuery Query
q
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall r. FromRow r => Connection -> Query -> IO [r]
PG.query_ Connection
conn Query
q

-- |Run an Opaleye query against the database connection.
-- Wraps 'Opaleye.runSelect' using the 'MonadMigration' reader to get the connection.
runQuery
  :: ( MonadMigration m
     , Default Opaleye.Unpackspec columns columns
     , Default Opaleye.FromFields columns haskells
     )
  => Opaleye.Select columns -> m [haskells]
runQuery :: forall (m :: * -> *) columns haskells.
(MonadMigration m, Default Unpackspec columns columns,
 Default FromFields columns haskells) =>
Select columns -> m [haskells]
runQuery Select columns
q = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
mono -> (Element mono -> f b) -> f ()
for_ (forall fields.
Default Unpackspec fields fields =>
Select fields -> Maybe String
Opaleye.showSql Select columns
q) ($Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall seq. IsSequence seq => [Element seq] -> seq
pack)
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall fields haskells.
Default FromFields fields haskells =>
Connection -> Select fields -> IO [haskells]
Opaleye.runSelect Connection
conn Select columns
q

-- |Run an Opaleye 'Opaleye.runInsert' against the database connection.
runInsertMany :: MonadMigration m => Opaleye.Table columns columns' -> [columns] -> m Int64
runInsertMany :: forall (m :: * -> *) columns columns'.
MonadMigration m =>
Table columns columns' -> [columns] -> m Int64
runInsertMany Table columns columns'
table [columns]
rows = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall a b. (a -> b) -> a -> b
$ Text
"inserting " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall mono. MonoFoldable mono => mono -> Int
length [columns]
rows) forall a. Semigroup a => a -> a -> a
<> Text
" rows into " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
tableIdentifier Table columns columns'
table)
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall haskells. Connection -> Insert haskells -> IO haskells
Opaleye.runInsert Connection
conn (forall haskells fieldsW fieldsR.
Table fieldsW fieldsR
-> [fieldsW]
-> Returning fieldsR haskells
-> Maybe OnConflict
-> Insert haskells
Opaleye.Insert Table columns columns'
table [columns]
rows forall fieldsR. Returning fieldsR Int64
Opaleye.rCount forall a. Maybe a
Nothing)

-- |Run an Opaleye 'Opaleye.runUpdate' against the database connection.
runUpdate :: MonadMigration m => Opaleye.Table columnsW columnsR -> (columnsR -> columnsW) -> (columnsR -> Opaleye.Field Opaleye.SqlBool) -> m Int64
runUpdate :: forall (m :: * -> *) columnsW columnsR.
MonadMigration m =>
Table columnsW columnsR
-> (columnsR -> columnsW) -> (columnsR -> Field SqlBool) -> m Int64
runUpdate Table columnsW columnsR
table columnsR -> columnsW
permute columnsR -> Field SqlBool
filt = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall a b. (a -> b) -> a -> b
$ Text
"updating " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
tableIdentifier Table columnsW columnsR
table)
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall haskells. Connection -> Update haskells -> IO haskells
Opaleye.runUpdate Connection
conn (forall haskells fieldsW fieldsR.
Table fieldsW fieldsR
-> (fieldsR -> fieldsW)
-> (fieldsR -> Field SqlBool)
-> Returning fieldsR haskells
-> Update haskells
Opaleye.Update Table columnsW columnsR
table columnsR -> columnsW
permute columnsR -> Field SqlBool
filt forall fieldsR. Returning fieldsR Int64
Opaleye.rCount)

-- |Run an Opaleye 'Opaleye.runDelete' against the database connection.
runDelete :: MonadMigration m => Opaleye.Table columnsW columnsR -> (columnsR -> Opaleye.Field Opaleye.SqlBool) -> m Int64
runDelete :: forall (m :: * -> *) columnsW columnsR.
MonadMigration m =>
Table columnsW columnsR -> (columnsR -> Field SqlBool) -> m Int64
runDelete Table columnsW columnsR
table columnsR -> Field SqlBool
filt = do
  Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall a b. (a -> b) -> a -> b
$ Text
"deleting from " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
tableIdentifier Table columnsW columnsR
table)
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall haskells. Connection -> Delete haskells -> IO haskells
Opaleye.runDelete Connection
conn (forall haskells fieldsW fieldsR.
Table fieldsW fieldsR
-> (fieldsR -> Field SqlBool)
-> Returning fieldsR haskells
-> Delete haskells
Opaleye.Delete Table columnsW columnsR
table columnsR -> Field SqlBool
filt forall fieldsR. Returning fieldsR Int64
Opaleye.rCount)

-- |Check if a schema exists using the @information_schema@ views.
doesSchemaExist :: MonadMigration m => Text -> m Bool
doesSchemaExist :: forall (m :: * -> *). MonadMigration m => Text -> m Bool
doesSchemaExist Text
schema =
  Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall mono. MonoFoldable mono => mono -> Bool
null :: [PG.Only Int] -> Bool) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) q r.
(MonadMigration m, ToRow q, FromRow r) =>
Query -> q -> m [r]
query Query
"select 1 from information_schema.schemata where schema_name = ?" (forall a. a -> Only a
PG.Only Text
schema)

-- |Check if a table exists in a schema using the @information_schema@ views.
doesTableExist :: MonadMigration m => Text -> Text -> m Bool
doesTableExist :: forall (m :: * -> *). MonadMigration m => Text -> Text -> m Bool
doesTableExist Text
schema Text
table =
  Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall mono. MonoFoldable mono => mono -> Bool
null :: [PG.Only Int] -> Bool) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) q r.
(MonadMigration m, ToRow q, FromRow r) =>
Query -> q -> m [r]
query Query
"select 1 from information_schema.tables where table_schema = ? and table_name = ?" (Text
schema, Text
table)

-- |Check if a column exists in a schema on a table using the @information_schema@ views.
doesColumnExist :: MonadMigration m => Text -> Text -> Text -> m Bool
doesColumnExist :: forall (m :: * -> *).
MonadMigration m =>
Text -> Text -> Text -> m Bool
doesColumnExist Text
schema Text
table Text
column =
  Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall mono. MonoFoldable mono => mono -> Bool
null :: [PG.Only Int] -> Bool) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) q r.
(MonadMigration m, ToRow q, FromRow r) =>
Query -> q -> m [r]
query Query
"select 1 from information_schema.columns where table_schema = ? and table_name = ? and column_name = ?" (Text
schema, Text
table, Text
column)