{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
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)
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"
}
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 :: (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
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_ :: 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
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_)
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
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
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
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)
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)
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)
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)
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)
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)