{-# 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 = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
TH.quoteExp  = \ String
s -> [| $(TH.lift s) :: PG.Query |]
  , quotePat :: String -> Q Pat
TH.quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteType :: String -> Q Type
TH.quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteDec :: String -> Q [Dec]
TH.quoteDec  = String -> String -> Q [Dec]
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 = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
  { quoteExp :: String -> Q Exp
TH.quoteExp  = \ String
s -> [| $(bodyToStatements s) :: [PG.Query] |]
  , quotePat :: String -> Q Pat
TH.quotePat  = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteType :: String -> Q Type
TH.quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"qqSql should only be used in an expression context"
  , quoteDec :: String -> Q [Dec]
TH.quoteDec  = String -> String -> Q [Dec]
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 = [String] -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift ([String] -> Q Exp) -> (String -> [String]) -> String -> Q Exp
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Text] -> String) -> [[Text]] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> String
forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> Text
forall t seq.
(Textual t, Element seq ~ t, MonoFoldable seq) =>
seq -> t
unlines) ([[Text]] -> [String])
-> (String -> [[Text]]) -> String -> [String]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Element [[Text]] -> Bool) -> [[Text]] -> [[Text]]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Bool -> Bool
not (Bool -> Bool) -> ([Text] -> Bool) -> [Text] -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null) ([[Text]] -> [[Text]])
-> (String -> [[Text]]) -> String -> [[Text]]
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]] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Element [Text] -> Bool) -> [Text] -> [Text]
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null)) ([[Text]] -> [[Text]])
-> (String -> [[Text]]) -> String -> [[Text]]
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 [] ([Text] -> [[Text]]) -> (String -> [Text]) -> String -> [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Text]
forall t. Textual t => t -> [t]
lines (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
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
";" (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
T.stripPrefix Text
";" Text
l =
            [Text] -> [Text]
forall seq. SemiSequence seq => seq -> seq
reverse [Text]
acc [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [Text
l'] [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [Text] -> [Text] -> [[Text]]
go [] [Text]
ls
          | Just Text
l' <- Text -> Text -> Maybe Text
T.stripPrefix Text
";" Text
l =
            [Text] -> [Text]
forall seq. SemiSequence seq => seq -> seq
reverse [Text]
acc [Text] -> [[Text]] -> [[Text]]
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 =
            [Text] -> [Text]
forall seq. SemiSequence seq => seq -> seq
reverse (Text
l' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [Text] -> [[Text]] -> [[Text]]
forall a. a -> [a] -> [a]
: [Text] -> [Text] -> [[Text]]
go [] [Text]
ls
          | Bool
otherwise =
            [Text] -> [Text] -> [[Text]]
go (Text
l Text -> [Text] -> [Text]
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 :: Query -> q -> m Int64
execute Query
q q
p = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Query -> ByteString
fromQuery Query
q) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Action] -> Text
forall a. Show a => a -> Text
tshow (q -> [Action]
forall a. ToRow a => a -> [Action]
toRow q
p)
  IO Int64 -> m Int64
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> q -> IO Int64
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 :: Query -> [q] -> m Int64
executeMany Query
q [q]
ps = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Query -> ByteString
fromQuery Query
q) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with ["
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (q -> Text) -> Maybe q -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((if [q] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [q]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", ...") else Text -> Text
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id) (Text -> Text) -> (q -> Text) -> q -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Action] -> Text
forall a. Show a => a -> Text
tshow ([Action] -> Text) -> (q -> [Action]) -> q -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. q -> [Action]
forall a. ToRow a => a -> [Action]
toRow) ([q] -> Maybe (Element [q])
forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay [q]
ps) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  IO Int64 -> m Int64
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> [q] -> IO Int64
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_ :: Query -> m Int64
execute_ Query
q = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> (ByteString -> Text) -> ByteString -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ Query -> ByteString
fromQuery Query
q
  IO Int64 -> m Int64
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Int64 -> m Int64) -> IO Int64 -> m Int64
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_ :: [Query] -> m ()
executeSeries_ = (Element [Query] -> m ()) -> [Query] -> m ()
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
(Element mono -> f b) -> mono -> f ()
traverse_ (m Int64 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Int64 -> m ()) -> (Query -> m Int64) -> Query -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Query -> m Int64
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 :: Query -> q -> m [r]
query Query
q q
p = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (Query -> ByteString
fromQuery Query
q) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Action] -> Text
forall a. Show a => a -> Text
tshow (q -> [Action]
forall a. ToRow a => a -> [Action]
toRow q
p)
  IO [r] -> m [r]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> q -> IO [r]
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_ :: Query -> m [r]
query_ Query
q = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> (ByteString -> Text) -> ByteString -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (ByteString -> m ()) -> ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ Query -> ByteString
fromQuery Query
q
  IO [r] -> m [r]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO [r]
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 :: Select columns -> m [haskells]
runQuery Select columns
q = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe String -> (Element (Maybe String) -> m ()) -> m ()
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
mono -> (Element mono -> f b) -> f ()
for_ (Select columns -> Maybe String
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
Loc -> Text -> LogLevel -> Text -> m ()
Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> (String -> Text) -> String -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack)
  IO [haskells] -> m [haskells]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [haskells] -> m [haskells]) -> IO [haskells] -> m [haskells]
forall a b. (a -> b) -> a -> b
$ Connection -> Select columns -> IO [haskells]
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 :: Table columns columns' -> [columns] -> m Int64
runInsertMany Table columns columns'
table [columns]
rows = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"inserting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([columns] -> Int
forall mono. MonoFoldable mono => mono -> Int
length [columns]
rows) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" rows into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableIdentifier -> Text
forall a. Show a => a -> Text
tshow (Table columns columns' -> TableIdentifier
forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
tableIdentifier Table columns columns'
table)
  IO Int64 -> m Int64
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Insert Int64 -> IO Int64
forall haskells. Connection -> Insert haskells -> IO haskells
Opaleye.runInsert Connection
conn (Table columns columns'
-> [columns]
-> Returning columns' Int64
-> Maybe OnConflict
-> Insert Int64
forall haskells fieldsW fieldsR.
Table fieldsW fieldsR
-> [fieldsW]
-> Returning fieldsR haskells
-> Maybe OnConflict
-> Insert haskells
Opaleye.Insert Table columns columns'
table [columns]
rows Returning columns' Int64
forall fieldsR. Returning fieldsR Int64
Opaleye.rCount Maybe OnConflict
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 :: 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 <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"updating " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableIdentifier -> Text
forall a. Show a => a -> Text
tshow (Table columnsW columnsR -> TableIdentifier
forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
tableIdentifier Table columnsW columnsR
table)
  IO Int64 -> m Int64
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Update Int64 -> IO Int64
forall haskells. Connection -> Update haskells -> IO haskells
Opaleye.runUpdate Connection
conn (Table columnsW columnsR
-> (columnsR -> columnsW)
-> (columnsR -> Field SqlBool)
-> Returning columnsR Int64
-> Update Int64
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 Returning columnsR Int64
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 :: Table columnsW columnsR -> (columnsR -> Field SqlBool) -> m Int64
runDelete Table columnsW columnsR
table columnsR -> Field SqlBool
filt = do
  Connection
conn <- m Connection
forall r (m :: * -> *). MonadReader r m => m r
ask
  Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
Text -> Text
(Text -> m ()) -> (Text -> Text) -> 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 ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"deleting from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableIdentifier -> Text
forall a. Show a => a -> Text
tshow (Table columnsW columnsR -> TableIdentifier
forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
tableIdentifier Table columnsW columnsR
table)
  IO Int64 -> m Int64
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Connection -> Delete Int64 -> IO Int64
forall haskells. Connection -> Delete haskells -> IO haskells
Opaleye.runDelete Connection
conn (Table columnsW columnsR
-> (columnsR -> Field SqlBool)
-> Returning columnsR Int64
-> Delete Int64
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 Returning columnsR Int64
forall fieldsR. Returning fieldsR Int64
Opaleye.rCount)

-- |Check if a schema exists using the @information_schema@ views.
doesSchemaExist :: MonadMigration m => Text -> m Bool
doesSchemaExist :: Text -> m Bool
doesSchemaExist Text
schema =
  Bool -> Bool
not (Bool -> Bool) -> ([Only Int] -> Bool) -> [Only Int] -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Only Int] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null :: [PG.Only Int] -> Bool) ([Only Int] -> Bool) -> m [Only Int] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> Only Text -> m [Only Int]
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 = ?" (Text -> Only Text
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 :: Text -> Text -> m Bool
doesTableExist Text
schema Text
table =
  Bool -> Bool
not (Bool -> Bool) -> ([Only Int] -> Bool) -> [Only Int] -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Only Int] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null :: [PG.Only Int] -> Bool) ([Only Int] -> Bool) -> m [Only Int] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> (Text, Text) -> m [Only Int]
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 :: Text -> Text -> Text -> m Bool
doesColumnExist Text
schema Text
table Text
column =
  Bool -> Bool
not (Bool -> Bool) -> ([Only Int] -> Bool) -> [Only Int] -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Only Int] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null :: [PG.Only Int] -> Bool) ([Only Int] -> Bool) -> m [Only Int] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> (Text, Text, Text) -> m [Only Int]
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)