{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Database.Beam.Sqlite.Connection
  ( Sqlite(..), SqliteM(..)
  , sqliteUriSyntax

  , runBeamSqlite, runBeamSqliteDebug

    -- * Emulated @INSERT RETURNING@ support
  , insertReturning, runInsertReturningList
  ) where

import           Prelude hiding (fail)

import           Database.Beam.Backend
import           Database.Beam.Backend.Internal.Compat
import qualified Database.Beam.Backend.SQL.BeamExtensions as Beam
import           Database.Beam.Backend.URI
import           Database.Beam.Migrate.Generics
import           Database.Beam.Migrate.SQL ( BeamMigrateOnlySqlBackend, FieldReturnType(..) )
import qualified Database.Beam.Migrate.SQL as Beam
import           Database.Beam.Migrate.SQL.BeamExtensions
import           Database.Beam.Query ( SqlInsert(..), SqlInsertValues(..)
                                     , HasQBuilder(..), HasSqlEqualityCheck
                                     , HasSqlQuantifiedEqualityCheck
                                     , DataType(..)
                                     , HasSqlInTable(..)
                                     , insert, current_ )
import           Database.Beam.Query.Internal
import           Database.Beam.Query.SQL92
import           Database.Beam.Schema.Tables ( Beamable
                                             , Columnar'(..)
                                             , DatabaseEntity(..)
                                             , DatabaseEntityDescriptor(..)
                                             , TableEntity
                                             , TableField(..)
                                             , allBeamValues
                                             , changeBeamRep )
import           Database.Beam.Sqlite.Syntax

import           Database.SQLite.Simple ( Connection, ToRow(..), FromRow(..)
                                        , Query(..), SQLData(..), field
                                        , execute, execute_
                                        , withStatement, bind, nextRow
                                        , query_, open, close )
import           Database.SQLite.Simple.FromField ( FromField(..), ResultError(..)
                                                  , returnError, fieldData)
import           Database.SQLite.Simple.Internal (RowParser(RP), unRP)
import           Database.SQLite.Simple.Ok (Ok(..))
import           Database.SQLite.Simple.Types (Null)

import           Control.Exception (SomeException(..), bracket_, onException, mask)
import           Control.Monad (forM_)
import           Control.Monad.Base (MonadBase)
import           Control.Monad.Fail (MonadFail(..))
import           Control.Monad.Free.Church
import           Control.Monad.IO.Class (MonadIO(..))
import           Control.Monad.Identity (Identity)
import           Control.Monad.Reader (ReaderT(..), MonadReader(..), runReaderT)
import           Control.Monad.State.Strict (MonadState(..), StateT(..), runStateT)
import           Control.Monad.Trans (lift)
import           Control.Monad.Trans.Control (MonadBaseControl)
import           Control.Monad.Writer (tell, execWriter)

import           Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.DList as D
import           Data.Hashable (hash)
import           Data.Int
import           Data.Maybe (mapMaybe)
import           Data.Proxy (Proxy(..))
import           Data.Scientific (Scientific)
import           Data.String (fromString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T (decodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL (decodeUtf8)
import           Data.Time ( LocalTime, UTCTime, Day
                           , ZonedTime, utc, utcToLocalTime, getCurrentTime )
import           Data.Typeable (cast)
import           Data.Word
import           GHC.TypeLits

import           Network.URI

import           Text.Read (readMaybe)

-- | The SQLite backend. Used to parameterize 'MonadBeam' and 'FromBackendRow'
-- to provide support for SQLite databases. See the documentation for
-- 'MonadBeam' and the <https://haskell-beam.github.io/beam/ user guide> for more
-- information on how to use this backend.
data Sqlite = Sqlite

instance BeamBackend Sqlite where
  type BackendFromField Sqlite = FromField

instance HasQBuilder Sqlite where
  buildSqlQuery :: forall a (db :: (* -> *) -> *) s.
Projectible Sqlite a =>
TablePrefix -> Q Sqlite db s a -> BeamSqlBackendSelectSyntax Sqlite
buildSqlQuery = Bool
-> TablePrefix
-> Q Sqlite db s a
-> BeamSqlBackendSelectSyntax Sqlite
forall be (db :: (* -> *) -> *) s a.
(BeamSqlBackend be, Projectible be a) =>
Bool -> TablePrefix -> Q be db s a -> BeamSqlBackendSelectSyntax be
buildSql92Query' Bool
False -- SQLite does not support arbitrarily nesting UNION, INTERSECT, and EXCEPT

instance HasSqlInTable Sqlite where
  inRowValuesE :: Proxy Sqlite
-> BeamSqlBackendExpressionSyntax Sqlite
-> [BeamSqlBackendExpressionSyntax Sqlite]
-> BeamSqlBackendExpressionSyntax Sqlite
inRowValuesE Proxy Sqlite
Proxy BeamSqlBackendExpressionSyntax Sqlite
e [BeamSqlBackendExpressionSyntax Sqlite]
es = SqliteSyntax -> SqliteExpressionSyntax
SqliteExpressionSyntax (SqliteSyntax -> SqliteExpressionSyntax)
-> SqliteSyntax -> SqliteExpressionSyntax
forall a b. (a -> b) -> a -> b
$ [SqliteSyntax] -> SqliteSyntax
forall a. Monoid a => [a] -> a
mconcat
    [ SqliteSyntax -> SqliteSyntax
parens (SqliteSyntax -> SqliteSyntax) -> SqliteSyntax -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression BeamSqlBackendExpressionSyntax Sqlite
SqliteExpressionSyntax
e
    , ByteString -> SqliteSyntax
emit ByteString
" IN "
    , SqliteSyntax -> SqliteSyntax
parens (SqliteSyntax -> SqliteSyntax) -> SqliteSyntax -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ ByteString -> SqliteSyntax
emit ByteString
"VALUES " SqliteSyntax -> SqliteSyntax -> SqliteSyntax
forall a. Semigroup a => a -> a -> a
<> [SqliteSyntax] -> SqliteSyntax
commas ((SqliteExpressionSyntax -> SqliteSyntax)
-> [SqliteExpressionSyntax] -> [SqliteSyntax]
forall a b. (a -> b) -> [a] -> [b]
map SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression [BeamSqlBackendExpressionSyntax Sqlite]
[SqliteExpressionSyntax]
es)
    ]

instance BeamSqlBackendIsString Sqlite T.Text
instance BeamSqlBackendIsString Sqlite String

instance FromBackendRow Sqlite Bool
instance FromBackendRow Sqlite Double
instance FromBackendRow Sqlite Float
instance FromBackendRow Sqlite Int8
instance FromBackendRow Sqlite Int16
instance FromBackendRow Sqlite Int32
instance FromBackendRow Sqlite Int64
instance FromBackendRow Sqlite Integer
instance FromBackendRow Sqlite Word8
instance FromBackendRow Sqlite Word16
instance FromBackendRow Sqlite Word32
instance FromBackendRow Sqlite Word64
instance FromBackendRow Sqlite BS.ByteString
instance FromBackendRow Sqlite BL.ByteString
instance FromBackendRow Sqlite T.Text
instance FromBackendRow Sqlite TL.Text
instance FromBackendRow Sqlite UTCTime
instance FromBackendRow Sqlite Day
instance FromBackendRow Sqlite Null
instance FromBackendRow Sqlite Char where
  fromBackendRow :: FromBackendRowM Sqlite Char
fromBackendRow = do
    TablePrefix
t <- FromBackendRowM Sqlite TablePrefix
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
    case TablePrefix -> Maybe (Char, TablePrefix)
T.uncons TablePrefix
t of
      Just (Char
c, TablePrefix
_) -> Char -> FromBackendRowM Sqlite Char
forall a. a -> FromBackendRowM Sqlite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
      Maybe (Char, TablePrefix)
_ -> [Char] -> FromBackendRowM Sqlite Char
forall a. [Char] -> FromBackendRowM Sqlite a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Need string of size one to parse Char"
instance FromBackendRow Sqlite SqlNull where
  fromBackendRow :: FromBackendRowM Sqlite SqlNull
fromBackendRow =
    SqlNull
SqlNull SqlNull
-> FromBackendRowM Sqlite Null -> FromBackendRowM Sqlite SqlNull
forall a b.
a -> FromBackendRowM Sqlite b -> FromBackendRowM Sqlite a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (FromBackendRowM Sqlite Null
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow :: FromBackendRowM Sqlite Null)
instance FromBackendRow Sqlite LocalTime where
  fromBackendRow :: FromBackendRowM Sqlite LocalTime
fromBackendRow = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc (UTCTime -> LocalTime)
-> FromBackendRowM Sqlite UTCTime
-> FromBackendRowM Sqlite LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM Sqlite UTCTime
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
instance FromBackendRow Sqlite Scientific where
  fromBackendRow :: FromBackendRowM Sqlite Scientific
fromBackendRow = SqliteScientific -> Scientific
unSqliteScientific (SqliteScientific -> Scientific)
-> FromBackendRowM Sqlite SqliteScientific
-> FromBackendRowM Sqlite Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromBackendRowM Sqlite SqliteScientific
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow
instance FromBackendRow Sqlite SqliteScientific

instance TypeError (PreferExplicitSize Int Int32) => FromBackendRow Sqlite Int
instance TypeError (PreferExplicitSize Word Word32) => FromBackendRow Sqlite Word

newtype SqliteScientific = SqliteScientific { SqliteScientific -> Scientific
unSqliteScientific :: Scientific }
instance FromField SqliteScientific where
  fromField :: FieldParser SqliteScientific
fromField Field
f =
    Scientific -> SqliteScientific
SqliteScientific (Scientific -> SqliteScientific)
-> Ok Scientific -> Ok SqliteScientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case Field -> SQLData
fieldData Field
f of
      SQLInteger Int64
i -> Scientific -> Ok Scientific
forall a. a -> Ok a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i)
      SQLFloat Double
d -> Scientific -> Ok Scientific
forall a. a -> Ok a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Ok Scientific)
-> (Double -> Scientific) -> Double -> Ok Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Rational -> Scientific)
-> (Double -> Rational) -> Double -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Ok Scientific) -> Double -> Ok Scientific
forall a b. (a -> b) -> a -> b
$ Double
d
      SQLText TablePrefix
t -> [Char] -> Ok Scientific
tryRead (TablePrefix -> [Char]
T.unpack TablePrefix
t)
      SQLBlob ByteString
b -> [Char] -> Ok Scientific
tryRead (ByteString -> [Char]
BS.unpack ByteString
b)
      SQLData
SQLNull -> ([Char] -> [Char] -> [Char] -> ResultError)
-> Field -> [Char] -> Ok Scientific
forall a err.
(Typeable a, Exception err) =>
([Char] -> [Char] -> [Char] -> err) -> Field -> [Char] -> Ok a
returnError [Char] -> [Char] -> [Char] -> ResultError
UnexpectedNull Field
f [Char]
"null"
    where
      tryRead :: [Char] -> Ok Scientific
tryRead [Char]
s =
        case [Char] -> Maybe Scientific
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s of
          Maybe Scientific
Nothing -> ([Char] -> [Char] -> [Char] -> ResultError)
-> Field -> [Char] -> Ok Scientific
forall a err.
(Typeable a, Exception err) =>
([Char] -> [Char] -> [Char] -> err) -> Field -> [Char] -> Ok a
returnError [Char] -> [Char] -> [Char] -> ResultError
ConversionFailed Field
f ([Char] -> Ok Scientific) -> [Char] -> Ok Scientific
forall a b. (a -> b) -> a -> b
$
                     [Char]
"No conversion to Scientific for '" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"'"
          Just Scientific
s'  -> Scientific -> Ok Scientific
forall a. a -> Ok a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
s'

instance BeamSqlBackend Sqlite
instance BeamMigrateOnlySqlBackend Sqlite
type instance BeamSqlBackendSyntax Sqlite = SqliteCommandSyntax

data SqliteHasDefault = SqliteHasDefault
instance FieldReturnType 'True 'False Sqlite resTy a =>
         FieldReturnType 'False 'False Sqlite resTy (SqliteHasDefault -> a) where
  field' :: BeamMigrateSqlBackend Sqlite =>
Proxy 'False
-> Proxy 'False
-> TablePrefix
-> BeamMigrateSqlBackendDataTypeSyntax Sqlite
-> Maybe (BeamSqlBackendExpressionSyntax Sqlite)
-> Maybe TablePrefix
-> [BeamSqlBackendColumnConstraintDefinitionSyntax Sqlite]
-> SqliteHasDefault
-> a
field' Proxy 'False
_ Proxy 'False
_ TablePrefix
nm BeamMigrateSqlBackendDataTypeSyntax Sqlite
ty Maybe (BeamSqlBackendExpressionSyntax Sqlite)
_ Maybe TablePrefix
collation [BeamSqlBackendColumnConstraintDefinitionSyntax Sqlite]
constraints SqliteHasDefault
SqliteHasDefault =
    Proxy 'True
-> Proxy 'False
-> TablePrefix
-> BeamMigrateSqlBackendDataTypeSyntax Sqlite
-> Maybe (BeamSqlBackendExpressionSyntax Sqlite)
-> Maybe TablePrefix
-> [BeamSqlBackendColumnConstraintDefinitionSyntax Sqlite]
-> a
forall (defaultGiven :: Bool) (collationGiven :: Bool) be resTy a.
(FieldReturnType defaultGiven collationGiven be resTy a,
 BeamMigrateSqlBackend be) =>
Proxy defaultGiven
-> Proxy collationGiven
-> TablePrefix
-> BeamMigrateSqlBackendDataTypeSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> Maybe TablePrefix
-> [BeamSqlBackendColumnConstraintDefinitionSyntax be]
-> a
field' (forall (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @'True) (forall (t :: Bool). Proxy t
forall {k} (t :: k). Proxy t
Proxy @'False) TablePrefix
nm BeamMigrateSqlBackendDataTypeSyntax Sqlite
ty Maybe (BeamSqlBackendExpressionSyntax Sqlite)
forall a. Maybe a
Nothing Maybe TablePrefix
collation [BeamSqlBackendColumnConstraintDefinitionSyntax Sqlite]
constraints

instance BeamSqlBackendHasSerial Sqlite where
  genericSerial :: forall a.
FieldReturnType 'True 'False Sqlite (SqlSerial Int) a =>
TablePrefix -> a
genericSerial TablePrefix
nm = TablePrefix
-> DataType Sqlite (SqlSerial Int) -> SqliteHasDefault -> a
forall be resTy a.
(BeamMigrateSqlBackend be,
 FieldReturnType 'False 'False be resTy a) =>
TablePrefix -> DataType be resTy -> a
Beam.field TablePrefix
nm (Sql92ExpressionCastTargetSyntax
  (BeamSqlBackendExpressionSyntax Sqlite)
-> DataType Sqlite (SqlSerial Int)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
DataType Sql92ExpressionCastTargetSyntax
  (BeamSqlBackendExpressionSyntax Sqlite)
SqliteDataTypeSyntax
sqliteSerialType) SqliteHasDefault
SqliteHasDefault

-- | 'MonadBeam' instance inside which SQLite queries are run. See the
-- <https://haskell-beam.github.io/beam/ user guide> for more information
newtype SqliteM a
  = SqliteM
  { forall a. SqliteM a -> ReaderT ([Char] -> IO (), Connection) IO a
runSqliteM :: ReaderT (String -> IO (), Connection) IO a
    -- ^ Run an IO action with access to a SQLite connection and a debug logging
    -- function, called or each query submitted on the connection.
  } deriving (Applicative SqliteM
Applicative SqliteM =>
(forall a b. SqliteM a -> (a -> SqliteM b) -> SqliteM b)
-> (forall a b. SqliteM a -> SqliteM b -> SqliteM b)
-> (forall a. a -> SqliteM a)
-> Monad SqliteM
forall a. a -> SqliteM a
forall a b. SqliteM a -> SqliteM b -> SqliteM b
forall a b. SqliteM a -> (a -> SqliteM b) -> SqliteM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. SqliteM a -> (a -> SqliteM b) -> SqliteM b
>>= :: forall a b. SqliteM a -> (a -> SqliteM b) -> SqliteM b
$c>> :: forall a b. SqliteM a -> SqliteM b -> SqliteM b
>> :: forall a b. SqliteM a -> SqliteM b -> SqliteM b
$creturn :: forall a. a -> SqliteM a
return :: forall a. a -> SqliteM a
Monad, (forall a b. (a -> b) -> SqliteM a -> SqliteM b)
-> (forall a b. a -> SqliteM b -> SqliteM a) -> Functor SqliteM
forall a b. a -> SqliteM b -> SqliteM a
forall a b. (a -> b) -> SqliteM a -> SqliteM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SqliteM a -> SqliteM b
fmap :: forall a b. (a -> b) -> SqliteM a -> SqliteM b
$c<$ :: forall a b. a -> SqliteM b -> SqliteM a
<$ :: forall a b. a -> SqliteM b -> SqliteM a
Functor, Functor SqliteM
Functor SqliteM =>
(forall a. a -> SqliteM a)
-> (forall a b. SqliteM (a -> b) -> SqliteM a -> SqliteM b)
-> (forall a b c.
    (a -> b -> c) -> SqliteM a -> SqliteM b -> SqliteM c)
-> (forall a b. SqliteM a -> SqliteM b -> SqliteM b)
-> (forall a b. SqliteM a -> SqliteM b -> SqliteM a)
-> Applicative SqliteM
forall a. a -> SqliteM a
forall a b. SqliteM a -> SqliteM b -> SqliteM a
forall a b. SqliteM a -> SqliteM b -> SqliteM b
forall a b. SqliteM (a -> b) -> SqliteM a -> SqliteM b
forall a b c. (a -> b -> c) -> SqliteM a -> SqliteM b -> SqliteM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> SqliteM a
pure :: forall a. a -> SqliteM a
$c<*> :: forall a b. SqliteM (a -> b) -> SqliteM a -> SqliteM b
<*> :: forall a b. SqliteM (a -> b) -> SqliteM a -> SqliteM b
$cliftA2 :: forall a b c. (a -> b -> c) -> SqliteM a -> SqliteM b -> SqliteM c
liftA2 :: forall a b c. (a -> b -> c) -> SqliteM a -> SqliteM b -> SqliteM c
$c*> :: forall a b. SqliteM a -> SqliteM b -> SqliteM b
*> :: forall a b. SqliteM a -> SqliteM b -> SqliteM b
$c<* :: forall a b. SqliteM a -> SqliteM b -> SqliteM a
<* :: forall a b. SqliteM a -> SqliteM b -> SqliteM a
Applicative, Monad SqliteM
Monad SqliteM => (forall a. IO a -> SqliteM a) -> MonadIO SqliteM
forall a. IO a -> SqliteM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> SqliteM a
liftIO :: forall a. IO a -> SqliteM a
MonadIO, Monad SqliteM
Monad SqliteM =>
(forall a. [Char] -> SqliteM a) -> MonadFail SqliteM
forall a. [Char] -> SqliteM a
forall (m :: * -> *).
Monad m =>
(forall a. [Char] -> m a) -> MonadFail m
$cfail :: forall a. [Char] -> SqliteM a
fail :: forall a. [Char] -> SqliteM a
MonadFail)
    deriving newtype (MonadBase IO, MonadBaseControl IO)

newtype BeamSqliteParams = BeamSqliteParams [SQLData]
instance ToRow BeamSqliteParams where
  toRow :: BeamSqliteParams -> [SQLData]
toRow (BeamSqliteParams [SQLData]
x) = [SQLData]
x

newtype BeamSqliteRow a = BeamSqliteRow a
instance FromBackendRow Sqlite a => FromRow (BeamSqliteRow a) where
  fromRow :: RowParser (BeamSqliteRow a)
fromRow = a -> BeamSqliteRow a
forall a. a -> BeamSqliteRow a
BeamSqliteRow (a -> BeamSqliteRow a)
-> RowParser a -> RowParser (BeamSqliteRow a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> F (FromBackendRowF Sqlite) a
-> forall r. (a -> r) -> (FromBackendRowF Sqlite r -> r) -> r
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F (FromBackendRowF Sqlite) a
fromBackendRow' a -> RowParser a
forall {a}. a -> RowParser a
finish FromBackendRowF Sqlite (RowParser a) -> RowParser a
forall a'. FromBackendRowF Sqlite (RowParser a') -> RowParser a'
step
      where
        FromBackendRowM F (FromBackendRowF Sqlite) a
fromBackendRow' = FromBackendRowM Sqlite a
forall be a. FromBackendRow be a => FromBackendRowM be a
fromBackendRow :: FromBackendRowM Sqlite a

        translateErrors :: Maybe Int -> SomeException -> Maybe SomeException
        translateErrors :: Maybe Int -> SomeException -> Maybe SomeException
translateErrors Maybe Int
col (SomeException e
e) =
          case e -> Maybe ResultError
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e of
            Just (ConversionFailed { errSQLType :: ResultError -> [Char]
errSQLType     = [Char]
typeString
                                   , errHaskellType :: ResultError -> [Char]
errHaskellType = [Char]
hsString
                                   , errMessage :: ResultError -> [Char]
errMessage     = [Char]
msg }) ->
              SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just (BeamRowReadError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
col ([Char] -> [Char] -> [Char] -> ColumnParseError
ColumnTypeMismatch [Char]
hsString [Char]
typeString ([Char]
"conversion failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg))))
            Just (UnexpectedNull {}) ->
              SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just (BeamRowReadError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
col ColumnParseError
ColumnUnexpectedNull))
            Just (Incompatible { errSQLType :: ResultError -> [Char]
errSQLType     = [Char]
typeString
                               , errHaskellType :: ResultError -> [Char]
errHaskellType = [Char]
hsString
                               , errMessage :: ResultError -> [Char]
errMessage     = [Char]
msg }) ->
              SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just (BeamRowReadError -> SomeException
forall e. Exception e => e -> SomeException
SomeException (Maybe Int -> ColumnParseError -> BeamRowReadError
BeamRowReadError Maybe Int
col ([Char] -> [Char] -> [Char] -> ColumnParseError
ColumnTypeMismatch [Char]
hsString [Char]
typeString ([Char]
"incompatible: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg))))
            Maybe ResultError
Nothing -> Maybe SomeException
forall a. Maybe a
Nothing

        finish :: a -> RowParser a
finish = a -> RowParser a
forall {a}. a -> RowParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

        step :: forall a'. FromBackendRowF Sqlite (RowParser a') -> RowParser a'
        step :: forall a'. FromBackendRowF Sqlite (RowParser a') -> RowParser a'
step (ParseOneField a -> RowParser a'
next) =
            ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a' -> RowParser a'
forall a.
ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a
RP (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
 -> RowParser a')
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
-> RowParser a'
forall a b. (a -> b) -> a -> b
$ (RowParseRO -> StateT (Int, [SQLData]) Ok a')
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((RowParseRO -> StateT (Int, [SQLData]) Ok a')
 -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a')
-> (RowParseRO -> StateT (Int, [SQLData]) Ok a')
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
forall a b. (a -> b) -> a -> b
$ \RowParseRO
ro -> ((Int, [SQLData]) -> Ok (a', (Int, [SQLData])))
-> StateT (Int, [SQLData]) Ok a'
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (((Int, [SQLData]) -> Ok (a', (Int, [SQLData])))
 -> StateT (Int, [SQLData]) Ok a')
-> ((Int, [SQLData]) -> Ok (a', (Int, [SQLData])))
-> StateT (Int, [SQLData]) Ok a'
forall a b. (a -> b) -> a -> b
$ \st :: (Int, [SQLData])
st@(Int
col, [SQLData]
_) ->
            case StateT (Int, [SQLData]) Ok a
-> (Int, [SQLData]) -> Ok (a, (Int, [SQLData]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
-> RowParseRO -> StateT (Int, [SQLData]) Ok a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP RowParser a
forall a. FromField a => RowParser a
field) RowParseRO
ro) (Int, [SQLData])
st of
              Ok (a
x, (Int, [SQLData])
st') -> StateT (Int, [SQLData]) Ok a'
-> (Int, [SQLData]) -> Ok (a', (Int, [SQLData]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
-> RowParseRO -> StateT (Int, [SQLData]) Ok a'
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RowParser a' -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP (a -> RowParser a'
next a
x)) RowParseRO
ro) (Int, [SQLData])
st'
              Errors [SomeException]
errs -> [SomeException] -> Ok (a', (Int, [SQLData]))
forall a. [SomeException] -> Ok a
Errors ((SomeException -> Maybe SomeException)
-> [SomeException] -> [SomeException]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Int -> SomeException -> Maybe SomeException
translateErrors (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
col)) [SomeException]
errs)
        step (Alt (FromBackendRowM F (FromBackendRowF Sqlite) a
a) (FromBackendRowM F (FromBackendRowF Sqlite) a
b) a -> RowParser a'
next) = do
          ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a' -> RowParser a'
forall a.
ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a
RP (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
 -> RowParser a')
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
-> RowParser a'
forall a b. (a -> b) -> a -> b
$ do
            let RP ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
a' = F (FromBackendRowF Sqlite) a
-> forall r. (a -> r) -> (FromBackendRowF Sqlite r -> r) -> r
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F (FromBackendRowF Sqlite) a
a a -> RowParser a
forall {a}. a -> RowParser a
finish FromBackendRowF Sqlite (RowParser a) -> RowParser a
forall a'. FromBackendRowF Sqlite (RowParser a') -> RowParser a'
step
                RP ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
b' = F (FromBackendRowF Sqlite) a
-> forall r. (a -> r) -> (FromBackendRowF Sqlite r -> r) -> r
forall (f :: * -> *) a.
F f a -> forall r. (a -> r) -> (f r -> r) -> r
runF F (FromBackendRowF Sqlite) a
b a -> RowParser a
forall {a}. a -> RowParser a
finish FromBackendRowF Sqlite (RowParser a) -> RowParser a
forall a'. FromBackendRowF Sqlite (RowParser a') -> RowParser a'
step

            (Int, [SQLData])
st <- ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) (Int, [SQLData])
forall s (m :: * -> *). MonadState s m => m s
get
            RowParseRO
ro <- ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) RowParseRO
forall r (m :: * -> *). MonadReader r m => m r
ask
            case StateT (Int, [SQLData]) Ok a
-> (Int, [SQLData]) -> Ok (a, (Int, [SQLData]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
-> RowParseRO -> StateT (Int, [SQLData]) Ok a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
a' RowParseRO
ro) (Int, [SQLData])
st of
              Ok (a
ra, (Int, [SQLData])
st') -> do
                (Int, [SQLData])
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int, [SQLData])
st'
                RowParser a' -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP (a -> RowParser a'
next a
ra)
              Errors [SomeException]
aErrs ->
                case StateT (Int, [SQLData]) Ok a
-> (Int, [SQLData]) -> Ok (a, (Int, [SQLData]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
-> RowParseRO -> StateT (Int, [SQLData]) Ok a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
b' RowParseRO
ro) (Int, [SQLData])
st of
                  Ok (a
rb, (Int, [SQLData])
st') -> do
                    (Int, [SQLData])
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int, [SQLData])
st'
                    RowParser a' -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
forall a.
RowParser a -> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a
unRP (a -> RowParser a'
next a
rb)
                  Errors [SomeException]
bErrs ->
                    StateT (Int, [SQLData]) Ok a'
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a' -> StateT (Int, [SQLData]) Ok a'
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Int, [SQLData]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([SomeException] -> Ok a'
forall a. [SomeException] -> Ok a
Errors ([SomeException]
aErrs [SomeException] -> [SomeException] -> [SomeException]
forall a. [a] -> [a] -> [a]
++ [SomeException]
bErrs)))
        step (FailParseWith BeamRowReadError
err) = ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a' -> RowParser a'
forall a.
ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a -> RowParser a
RP (StateT (Int, [SQLData]) Ok a'
-> ReaderT RowParseRO (StateT (Int, [SQLData]) Ok) a'
forall (m :: * -> *) a. Monad m => m a -> ReaderT RowParseRO m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a' -> StateT (Int, [SQLData]) Ok a'
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Int, [SQLData]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([SomeException] -> Ok a'
forall a. [SomeException] -> Ok a
Errors [BeamRowReadError -> SomeException
forall e. Exception e => e -> SomeException
SomeException BeamRowReadError
err])))

-- * Equality checks
#define HAS_SQLITE_EQUALITY_CHECK(ty)                       \
  instance HasSqlEqualityCheck Sqlite (ty); \
  instance HasSqlQuantifiedEqualityCheck Sqlite (ty);

HAS_SQLITE_EQUALITY_CHECK(Int8)
HAS_SQLITE_EQUALITY_CHECK(Int16)
HAS_SQLITE_EQUALITY_CHECK(Int32)
HAS_SQLITE_EQUALITY_CHECK(Int64)
HAS_SQLITE_EQUALITY_CHECK(Word8)
HAS_SQLITE_EQUALITY_CHECK(Word16)
HAS_SQLITE_EQUALITY_CHECK(Word32)
HAS_SQLITE_EQUALITY_CHECK(Word64)
HAS_SQLITE_EQUALITY_CHECK(Double)
HAS_SQLITE_EQUALITY_CHECK(Float)
HAS_SQLITE_EQUALITY_CHECK(Bool)
HAS_SQLITE_EQUALITY_CHECK(String)
HAS_SQLITE_EQUALITY_CHECK(T.Text)
HAS_SQLITE_EQUALITY_CHECK(TL.Text)
HAS_SQLITE_EQUALITY_CHECK(BS.ByteString)
HAS_SQLITE_EQUALITY_CHECK(BL.ByteString)
HAS_SQLITE_EQUALITY_CHECK(UTCTime)
HAS_SQLITE_EQUALITY_CHECK(Day)
HAS_SQLITE_EQUALITY_CHECK(LocalTime)
HAS_SQLITE_EQUALITY_CHECK(ZonedTime)
HAS_SQLITE_EQUALITY_CHECK(Char)
HAS_SQLITE_EQUALITY_CHECK(Integer)
HAS_SQLITE_EQUALITY_CHECK(Scientific)

instance TypeError (PreferExplicitSize Int Int32) => HasSqlEqualityCheck Sqlite Int
instance TypeError (PreferExplicitSize Int Int32) => HasSqlQuantifiedEqualityCheck Sqlite Int
instance TypeError (PreferExplicitSize Word Word32) => HasSqlEqualityCheck Sqlite Word
instance TypeError (PreferExplicitSize Word Word32) => HasSqlQuantifiedEqualityCheck Sqlite Word

class HasDefaultSqlDataType Sqlite a => IsSqliteSerialIntegerType a
instance IsSqliteSerialIntegerType Int32
instance IsSqliteSerialIntegerType Int64
instance TypeError (PreferExplicitSize Int Int32) => IsSqliteSerialIntegerType Int

instance IsSqliteSerialIntegerType a => HasDefaultSqlDataType Sqlite (SqlSerial a) where
  defaultSqlDataType :: Proxy (SqlSerial a)
-> Proxy Sqlite
-> Bool
-> Sql92ExpressionCastTargetSyntax
     (BeamSqlBackendExpressionSyntax Sqlite)
defaultSqlDataType Proxy (SqlSerial a)
_ Proxy Sqlite
_ Bool
False = Sql92ExpressionCastTargetSyntax
  (BeamSqlBackendExpressionSyntax Sqlite)
SqliteDataTypeSyntax
sqliteSerialType
  defaultSqlDataType Proxy (SqlSerial a)
_ Proxy Sqlite
_ Bool
True = Sql92ExpressionCastTargetSyntax
  (BeamSqlBackendExpressionSyntax Sqlite)
SqliteDataTypeSyntax
forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType

instance HasDefaultSqlDataType Sqlite BS.ByteString where
  -- TODO we should somehow allow contsraints based on backend
  defaultSqlDataType :: Proxy ByteString
-> Proxy Sqlite
-> Bool
-> Sql92ExpressionCastTargetSyntax
     (BeamSqlBackendExpressionSyntax Sqlite)
defaultSqlDataType Proxy ByteString
_ Proxy Sqlite
_ Bool
_ = Sql92ExpressionCastTargetSyntax
  (BeamSqlBackendExpressionSyntax Sqlite)
SqliteDataTypeSyntax
sqliteBlobType

instance HasDefaultSqlDataType Sqlite LocalTime where
  defaultSqlDataType :: Proxy LocalTime
-> Proxy Sqlite
-> Bool
-> Sql92ExpressionCastTargetSyntax
     (BeamSqlBackendExpressionSyntax Sqlite)
defaultSqlDataType Proxy LocalTime
_ Proxy Sqlite
_ Bool
_ = Maybe Word -> Bool -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timestampType Maybe Word
forall a. Maybe a
Nothing Bool
False

-- | URI syntax for use with 'withDbConnection'. See documentation for
-- 'BeamURIOpeners' for more information.
sqliteUriSyntax :: c Sqlite Connection SqliteM
                -> BeamURIOpeners c
sqliteUriSyntax :: forall (c :: * -> * -> (* -> *) -> *).
c Sqlite Connection SqliteM -> BeamURIOpeners c
sqliteUriSyntax =
  (forall a. Connection -> SqliteM a -> IO a)
-> [Char]
-> (URI -> IO (Connection, IO ()))
-> c Sqlite Connection SqliteM
-> BeamURIOpeners c
forall hdl (m :: * -> *) (c :: * -> * -> (* -> *) -> *) be.
(forall a. hdl -> m a -> IO a)
-> [Char]
-> (URI -> IO (hdl, IO ()))
-> c be hdl m
-> BeamURIOpeners c
mkUriOpener Connection -> SqliteM a -> IO a
forall a. Connection -> SqliteM a -> IO a
runBeamSqlite [Char]
"sqlite:"
    (\URI
uri -> do
        let sqliteName :: [Char]
sqliteName = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> [Char]
uriPath URI
uri) then [Char]
":memory:" else URI -> [Char]
uriPath URI
uri
        Connection
hdl <- [Char] -> IO Connection
open [Char]
sqliteName
        (Connection, IO ()) -> IO (Connection, IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Connection
hdl, Connection -> IO ()
close Connection
hdl))

runBeamSqliteDebug :: (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug :: forall a. ([Char] -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug [Char] -> IO ()
debugStmt Connection
conn SqliteM a
x = ReaderT ([Char] -> IO (), Connection) IO a
-> ([Char] -> IO (), Connection) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SqliteM a -> ReaderT ([Char] -> IO (), Connection) IO a
forall a. SqliteM a -> ReaderT ([Char] -> IO (), Connection) IO a
runSqliteM SqliteM a
x) ([Char] -> IO ()
debugStmt, Connection
conn)

runBeamSqlite :: Connection -> SqliteM a -> IO a
runBeamSqlite :: forall a. Connection -> SqliteM a -> IO a
runBeamSqlite = ([Char] -> IO ()) -> Connection -> SqliteM a -> IO a
forall a. ([Char] -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug (\[Char]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance MonadBeam Sqlite SqliteM where
  runNoReturn :: BeamSqlBackendSyntax Sqlite -> SqliteM ()
runNoReturn (SqliteCommandSyntax (SqliteSyntax (SQLData -> Builder) -> Builder
cmd DList SQLData
vals)) =
    ReaderT ([Char] -> IO (), Connection) IO () -> SqliteM ()
forall a. ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a
SqliteM (ReaderT ([Char] -> IO (), Connection) IO () -> SqliteM ())
-> ReaderT ([Char] -> IO (), Connection) IO () -> SqliteM ()
forall a b. (a -> b) -> a -> b
$ do
      ([Char] -> IO ()
logger, Connection
conn) <- ReaderT
  ([Char] -> IO (), Connection) IO ([Char] -> IO (), Connection)
forall r (m :: * -> *). MonadReader r m => m r
ask
      let cmdString :: [Char]
cmdString = ByteString -> [Char]
BL.unpack (Builder -> ByteString
toLazyByteString (((SQLData -> Builder) -> Builder) -> Builder
withPlaceholders (SQLData -> Builder) -> Builder
cmd))
      IO () -> ReaderT ([Char] -> IO (), Connection) IO ()
forall a. IO a -> ReaderT ([Char] -> IO (), Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO ()
logger ([Char]
cmdString [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";\n-- With values: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [SQLData] -> [Char]
forall a. Show a => a -> [Char]
show (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals)))
      IO () -> ReaderT ([Char] -> IO (), Connection) IO ()
forall a. IO a -> ReaderT ([Char] -> IO (), Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> Query -> [SQLData] -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn ([Char] -> Query
forall a. IsString a => [Char] -> a
fromString [Char]
cmdString) (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals))
  runNoReturn (SqliteCommandInsert SqliteInsertSyntax
insertStmt_) =
    ReaderT ([Char] -> IO (), Connection) IO () -> SqliteM ()
forall a. ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a
SqliteM (ReaderT ([Char] -> IO (), Connection) IO () -> SqliteM ())
-> ReaderT ([Char] -> IO (), Connection) IO () -> SqliteM ()
forall a b. (a -> b) -> a -> b
$ do
      ([Char] -> IO ()
logger, Connection
conn) <- ReaderT
  ([Char] -> IO (), Connection) IO ([Char] -> IO (), Connection)
forall r (m :: * -> *). MonadReader r m => m r
ask
      IO () -> ReaderT ([Char] -> IO (), Connection) IO ()
forall a. IO a -> ReaderT ([Char] -> IO (), Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (([Char] -> IO ()) -> Connection -> SqliteInsertSyntax -> IO ()
runSqliteInsert [Char] -> IO ()
logger Connection
conn SqliteInsertSyntax
insertStmt_)

  runReturningMany :: forall x a.
FromBackendRow Sqlite x =>
BeamSqlBackendSyntax Sqlite
-> (SqliteM (Maybe x) -> SqliteM a) -> SqliteM a
runReturningMany (SqliteCommandSyntax (SqliteSyntax (SQLData -> Builder) -> Builder
cmd DList SQLData
vals)) SqliteM (Maybe x) -> SqliteM a
action =
      ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a
forall a. ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a
SqliteM (ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a)
-> ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a
forall a b. (a -> b) -> a -> b
$ do
        ([Char] -> IO ()
logger, Connection
conn) <- ReaderT
  ([Char] -> IO (), Connection) IO ([Char] -> IO (), Connection)
forall r (m :: * -> *). MonadReader r m => m r
ask
        let cmdString :: [Char]
cmdString = ByteString -> [Char]
BL.unpack (Builder -> ByteString
toLazyByteString (((SQLData -> Builder) -> Builder) -> Builder
withPlaceholders (SQLData -> Builder) -> Builder
cmd))
        IO a -> ReaderT ([Char] -> IO (), Connection) IO a
forall a. IO a -> ReaderT ([Char] -> IO (), Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderT ([Char] -> IO (), Connection) IO a)
-> IO a -> ReaderT ([Char] -> IO (), Connection) IO a
forall a b. (a -> b) -> a -> b
$ do
          [Char] -> IO ()
logger ([Char]
cmdString [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";\n-- With values: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [SQLData] -> [Char]
forall a. Show a => a -> [Char]
show (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals))
          Connection -> Query -> (Statement -> IO a) -> IO a
forall a. Connection -> Query -> (Statement -> IO a) -> IO a
withStatement Connection
conn ([Char] -> Query
forall a. IsString a => [Char] -> a
fromString [Char]
cmdString) ((Statement -> IO a) -> IO a) -> (Statement -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Statement
stmt ->
            do Statement -> BeamSqliteParams -> IO ()
forall params. ToRow params => Statement -> params -> IO ()
bind Statement
stmt ([SQLData] -> BeamSqliteParams
BeamSqliteParams (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals))
               let nextRow' :: SqliteM (Maybe x)
nextRow' = IO (Maybe (BeamSqliteRow (Maybe x)))
-> SqliteM (Maybe (BeamSqliteRow (Maybe x)))
forall a. IO a -> SqliteM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Statement -> IO (Maybe (BeamSqliteRow (Maybe x)))
forall r. FromRow r => Statement -> IO (Maybe r)
nextRow Statement
stmt) SqliteM (Maybe (BeamSqliteRow (Maybe x)))
-> (Maybe (BeamSqliteRow (Maybe x)) -> SqliteM (Maybe x))
-> SqliteM (Maybe x)
forall a b. SqliteM a -> (a -> SqliteM b) -> SqliteM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (BeamSqliteRow (Maybe x))
x ->
                              case Maybe (BeamSqliteRow (Maybe x))
x of
                                Maybe (BeamSqliteRow (Maybe x))
Nothing -> Maybe x -> SqliteM (Maybe x)
forall a. a -> SqliteM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe x
forall a. Maybe a
Nothing
                                Just (BeamSqliteRow Maybe x
row) -> Maybe x -> SqliteM (Maybe x)
forall a. a -> SqliteM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe x
row
               ReaderT ([Char] -> IO (), Connection) IO a
-> ([Char] -> IO (), Connection) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SqliteM a -> ReaderT ([Char] -> IO (), Connection) IO a
forall a. SqliteM a -> ReaderT ([Char] -> IO (), Connection) IO a
runSqliteM (SqliteM (Maybe x) -> SqliteM a
action SqliteM (Maybe x)
nextRow')) ([Char] -> IO ()
logger, Connection
conn)
  runReturningMany SqliteCommandInsert {} SqliteM (Maybe x) -> SqliteM a
_ =
      [Char] -> SqliteM a
forall a. [Char] -> SqliteM a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> SqliteM a)
-> ([[Char]] -> [Char]) -> [[Char]] -> SqliteM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat ([[Char]] -> SqliteM a) -> [[Char]] -> SqliteM a
forall a b. (a -> b) -> a -> b
$
      [ [Char]
"runReturningMany{Sqlite}: sqlite does not support returning "
      , [Char]
"rows from an insert, use Database.Beam.Sqlite.insertReturning "
      , [Char]
"for emulation" ]

instance Beam.MonadBeamInsertReturning Sqlite SqliteM where
  runInsertReturningList :: forall (table :: (* -> *) -> *).
(Beamable table, Projectible Sqlite (table (QExpr Sqlite ())),
 FromBackendRow Sqlite (table Identity)) =>
SqlInsert Sqlite table -> SqliteM [table Identity]
runInsertReturningList = SqlInsert Sqlite table -> SqliteM [table Identity]
forall (table :: (* -> *) -> *).
(Beamable table, FromBackendRow Sqlite (table Identity)) =>
SqlInsert Sqlite table -> SqliteM [table Identity]
runInsertReturningList

runSqliteInsert :: (String -> IO ()) -> Connection -> SqliteInsertSyntax -> IO ()
runSqliteInsert :: ([Char] -> IO ()) -> Connection -> SqliteInsertSyntax -> IO ()
runSqliteInsert [Char] -> IO ()
logger Connection
conn (SqliteInsertSyntax SqliteTableNameSyntax
tbl [TablePrefix]
fields SqliteInsertValuesSyntax
vs Maybe SqliteOnConflictSyntax
onConflict)
    -- If all expressions are simple expressions (no default), then just

  | SqliteInsertExpressions [[SqliteExpressionSyntax]]
es <- SqliteInsertValuesSyntax
vs, ([SqliteExpressionSyntax] -> Bool)
-> [[SqliteExpressionSyntax]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((SqliteExpressionSyntax -> Bool)
-> [SqliteExpressionSyntax] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SqliteExpressionSyntax -> SqliteExpressionSyntax -> Bool
forall a. Eq a => a -> a -> Bool
== SqliteExpressionSyntax
SqliteExpressionDefault)) [[SqliteExpressionSyntax]]
es =
      [[SqliteExpressionSyntax]]
-> ([SqliteExpressionSyntax] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[SqliteExpressionSyntax]]
es (([SqliteExpressionSyntax] -> IO ()) -> IO ())
-> ([SqliteExpressionSyntax] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[SqliteExpressionSyntax]
row -> do
        let ([TablePrefix]
fields', [SqliteExpressionSyntax]
row') = [(TablePrefix, SqliteExpressionSyntax)]
-> ([TablePrefix], [SqliteExpressionSyntax])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TablePrefix, SqliteExpressionSyntax)]
 -> ([TablePrefix], [SqliteExpressionSyntax]))
-> [(TablePrefix, SqliteExpressionSyntax)]
-> ([TablePrefix], [SqliteExpressionSyntax])
forall a b. (a -> b) -> a -> b
$ ((TablePrefix, SqliteExpressionSyntax) -> Bool)
-> [(TablePrefix, SqliteExpressionSyntax)]
-> [(TablePrefix, SqliteExpressionSyntax)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SqliteExpressionSyntax -> SqliteExpressionSyntax -> Bool
forall a. Eq a => a -> a -> Bool
/= SqliteExpressionSyntax
SqliteExpressionDefault) (SqliteExpressionSyntax -> Bool)
-> ((TablePrefix, SqliteExpressionSyntax)
    -> SqliteExpressionSyntax)
-> (TablePrefix, SqliteExpressionSyntax)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TablePrefix, SqliteExpressionSyntax) -> SqliteExpressionSyntax
forall a b. (a, b) -> b
snd) ([(TablePrefix, SqliteExpressionSyntax)]
 -> [(TablePrefix, SqliteExpressionSyntax)])
-> [(TablePrefix, SqliteExpressionSyntax)]
-> [(TablePrefix, SqliteExpressionSyntax)]
forall a b. (a -> b) -> a -> b
$ [TablePrefix]
-> [SqliteExpressionSyntax]
-> [(TablePrefix, SqliteExpressionSyntax)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TablePrefix]
fields [SqliteExpressionSyntax]
row
            SqliteSyntax (SQLData -> Builder) -> Builder
cmd DList SQLData
vals = SqliteTableNameSyntax
-> [TablePrefix]
-> SqliteInsertValuesSyntax
-> Maybe SqliteOnConflictSyntax
-> SqliteSyntax
formatSqliteInsertOnConflict SqliteTableNameSyntax
tbl [TablePrefix]
fields' ([[SqliteExpressionSyntax]] -> SqliteInsertValuesSyntax
SqliteInsertExpressions [ [SqliteExpressionSyntax]
row' ]) Maybe SqliteOnConflictSyntax
onConflict
            cmdString :: [Char]
cmdString = ByteString -> [Char]
BL.unpack (Builder -> ByteString
toLazyByteString (((SQLData -> Builder) -> Builder) -> Builder
withPlaceholders (SQLData -> Builder) -> Builder
cmd))
        [Char] -> IO ()
logger ([Char]
cmdString [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";\n-- With values: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [SQLData] -> [Char]
forall a. Show a => a -> [Char]
show (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals))
        Connection -> Query -> [SQLData] -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn ([Char] -> Query
forall a. IsString a => [Char] -> a
fromString [Char]
cmdString) (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals)
  | Bool
otherwise = do
      let SqliteSyntax (SQLData -> Builder) -> Builder
cmd DList SQLData
vals = SqliteTableNameSyntax
-> [TablePrefix]
-> SqliteInsertValuesSyntax
-> Maybe SqliteOnConflictSyntax
-> SqliteSyntax
formatSqliteInsertOnConflict SqliteTableNameSyntax
tbl [TablePrefix]
fields SqliteInsertValuesSyntax
vs Maybe SqliteOnConflictSyntax
onConflict
          cmdString :: [Char]
cmdString = ByteString -> [Char]
BL.unpack (Builder -> ByteString
toLazyByteString (((SQLData -> Builder) -> Builder) -> Builder
withPlaceholders (SQLData -> Builder) -> Builder
cmd))
      [Char] -> IO ()
logger ([Char]
cmdString [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";\n-- With values: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [SQLData] -> [Char]
forall a. Show a => a -> [Char]
show (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals))
      Connection -> Query -> [SQLData] -> IO ()
forall q. ToRow q => Connection -> Query -> q -> IO ()
execute Connection
conn ([Char] -> Query
forall a. IsString a => [Char] -> a
fromString [Char]
cmdString) (DList SQLData -> [SQLData]
forall a. DList a -> [a]
D.toList DList SQLData
vals)

-- * emulated INSERT returning support

-- | Build a 'SqliteInsertReturning' representing inserting the given values
-- into the given table. Use 'runInsertReturningList'
insertReturning :: Beamable table
                => DatabaseEntity Sqlite db (TableEntity table)
                -> SqlInsertValues Sqlite (table (QExpr Sqlite s))
                -> SqlInsert Sqlite table
insertReturning :: forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) s.
Beamable table =>
DatabaseEntity Sqlite db (TableEntity table)
-> SqlInsertValues Sqlite (table (QExpr Sqlite s))
-> SqlInsert Sqlite table
insertReturning = DatabaseEntity Sqlite db (TableEntity table)
-> SqlInsertValues Sqlite (table (QExpr Sqlite s))
-> SqlInsert Sqlite table
forall be (table :: (* -> *) -> *) s (db :: (* -> *) -> *).
(BeamSqlBackend be,
 ProjectibleWithPredicate
   AnyType () TablePrefix (table (QField s))) =>
DatabaseEntity be db (TableEntity table)
-> SqlInsertValues be (table (QExpr be s)) -> SqlInsert be table
insert

-- | Runs a 'SqliteInsertReturning' statement and returns a result for each
-- inserted row.
runInsertReturningList :: (Beamable table, FromBackendRow Sqlite (table Identity))
                       => SqlInsert Sqlite table
                       -> SqliteM [ table Identity ]
runInsertReturningList :: forall (table :: (* -> *) -> *).
(Beamable table, FromBackendRow Sqlite (table Identity)) =>
SqlInsert Sqlite table -> SqliteM [table Identity]
runInsertReturningList SqlInsert Sqlite table
SqlInsertNoRows = [table Identity] -> SqliteM [table Identity]
forall a. a -> SqliteM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
runInsertReturningList (SqlInsert TableSettings table
tblSettings insertStmt_ :: Sql92InsertSyntax (BeamSqlBackendSyntax Sqlite)
insertStmt_@(SqliteInsertSyntax SqliteTableNameSyntax
nm [TablePrefix]
_ SqliteInsertValuesSyntax
_ Maybe SqliteOnConflictSyntax
_)) =
  do ([Char] -> IO ()
logger, Connection
conn) <- ReaderT
  ([Char] -> IO (), Connection) IO ([Char] -> IO (), Connection)
-> SqliteM ([Char] -> IO (), Connection)
forall a. ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a
SqliteM ReaderT
  ([Char] -> IO (), Connection) IO ([Char] -> IO (), Connection)
forall r (m :: * -> *). MonadReader r m => m r
ask
     ReaderT ([Char] -> IO (), Connection) IO [table Identity]
-> SqliteM [table Identity]
forall a. ReaderT ([Char] -> IO (), Connection) IO a -> SqliteM a
SqliteM (ReaderT ([Char] -> IO (), Connection) IO [table Identity]
 -> SqliteM [table Identity])
-> (IO [table Identity]
    -> ReaderT ([Char] -> IO (), Connection) IO [table Identity])
-> IO [table Identity]
-> SqliteM [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [table Identity]
-> ReaderT ([Char] -> IO (), Connection) IO [table Identity]
forall a. IO a -> ReaderT ([Char] -> IO (), Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [table Identity] -> SqliteM [table Identity])
-> IO [table Identity] -> SqliteM [table Identity]
forall a b. (a -> b) -> a -> b
$ do
       
       -- We create a pseudo-random savepoint identification that can be referenced
       -- throughout this operation. -- This used to be based on the process ID 
       -- (e.g. `System.Posix.Process.getProcessID` for UNIX),
       -- but using timestamps is more portable; see #738
       --
       -- Note that `hash` can return negative numbers, hence the use of `abs`.
       TablePrefix
savepointId <- [Char] -> TablePrefix
forall a. IsString a => [Char] -> a
fromString ([Char] -> TablePrefix)
-> (UTCTime -> [Char]) -> UTCTime -> TablePrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (UTCTime -> Int) -> UTCTime -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> (UTCTime -> Int) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Int
forall a. Hashable a => a -> Int
hash (UTCTime -> TablePrefix) -> IO UTCTime -> IO TablePrefix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

       let tableNameTxt :: TablePrefix
tableNameTxt = ByteString -> TablePrefix
T.decodeUtf8 (ByteString -> ByteString
BL.toStrict (SqliteSyntax -> ByteString
sqliteRenderSyntaxScript (SqliteTableNameSyntax -> SqliteSyntax
fromSqliteTableName SqliteTableNameSyntax
nm)))

           startSavepoint :: IO ()
startSavepoint =
             Connection -> Query -> IO ()
execute_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"SAVEPOINT insert_savepoint_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId))
           rollbackToSavepoint :: IO ()
rollbackToSavepoint =
             Connection -> Query -> IO ()
execute_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"ROLLBACK TRANSACTION TO SAVEPOINT insert_savepoint_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId))
           releaseSavepoint :: IO ()
releaseSavepoint =
             Connection -> Query -> IO ()
execute_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"RELEASE SAVEPOINT insert_savepoint_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId))

           createInsertedValuesTable :: IO ()
createInsertedValuesTable =
             Connection -> Query -> IO ()
execute_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"CREATE TEMPORARY TABLE inserted_values_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
" AS SELECT * FROM " TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
tableNameTxt TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
" LIMIT 0"))
           dropInsertedValuesTable :: IO ()
dropInsertedValuesTable =
             Connection -> Query -> IO ()
execute_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"DROP TABLE inserted_values_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId))

           createInsertTrigger :: IO ()
createInsertTrigger =
             Connection -> Query -> IO ()
execute_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"CREATE TEMPORARY TRIGGER insert_trigger_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
" AFTER INSERT ON " TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
tableNameTxt TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
" BEGIN " TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<>
                                   TablePrefix
"INSERT INTO inserted_values_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
" SELECT * FROM " TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
tableNameTxt TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
" WHERE ROWID=last_insert_rowid(); END" ))
           dropInsertTrigger :: IO ()
dropInsertTrigger =
             Connection -> Query -> IO ()
execute_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"DROP TRIGGER insert_trigger_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId))


       ((forall a. IO a -> IO a) -> IO [table Identity])
-> IO [table Identity]
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO [table Identity])
 -> IO [table Identity])
-> ((forall a. IO a -> IO a) -> IO [table Identity])
-> IO [table Identity]
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
         IO ()
startSavepoint
         (IO [table Identity] -> IO () -> IO [table Identity])
-> IO () -> IO [table Identity] -> IO [table Identity]
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO [table Identity] -> IO () -> IO [table Identity]
forall a b. IO a -> IO b -> IO a
onException IO ()
rollbackToSavepoint (IO [table Identity] -> IO [table Identity])
-> (IO [table Identity] -> IO [table Identity])
-> IO [table Identity]
-> IO [table Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [table Identity] -> IO [table Identity]
forall a. IO a -> IO a
restore (IO [table Identity] -> IO [table Identity])
-> IO [table Identity] -> IO [table Identity]
forall a b. (a -> b) -> a -> b
$ do
           [table Identity]
x <- IO () -> IO () -> IO [table Identity] -> IO [table Identity]
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
createInsertedValuesTable IO ()
dropInsertedValuesTable (IO [table Identity] -> IO [table Identity])
-> IO [table Identity] -> IO [table Identity]
forall a b. (a -> b) -> a -> b
$
                IO () -> IO () -> IO [table Identity] -> IO [table Identity]
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO ()
createInsertTrigger IO ()
dropInsertTrigger (IO [table Identity] -> IO [table Identity])
-> IO [table Identity] -> IO [table Identity]
forall a b. (a -> b) -> a -> b
$ do
                ([Char] -> IO ()) -> Connection -> SqliteInsertSyntax -> IO ()
runSqliteInsert [Char] -> IO ()
logger Connection
conn Sql92InsertSyntax (BeamSqlBackendSyntax Sqlite)
SqliteInsertSyntax
insertStmt_

                let columns :: TablePrefix
columns = Text -> TablePrefix
TL.toStrict (Text -> TablePrefix) -> Text -> TablePrefix
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TL.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
                              SqliteSyntax -> ByteString
sqliteRenderSyntaxScript (SqliteSyntax -> ByteString) -> SqliteSyntax -> ByteString
forall a b. (a -> b) -> a -> b
$ [SqliteSyntax] -> SqliteSyntax
commas ([SqliteSyntax] -> SqliteSyntax) -> [SqliteSyntax] -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$
                              (forall a. Columnar' (TableField table) a -> SqliteSyntax)
-> TableSettings table -> [SqliteSyntax]
forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' Columnar (TableField table) a
projField) -> TablePrefix -> SqliteSyntax
quotedIdentifier (TableField table a -> TablePrefix
forall (table :: (* -> *) -> *) ty.
TableField table ty -> TablePrefix
_fieldName TableField table a
Columnar (TableField table) a
projField)) (TableSettings table -> [SqliteSyntax])
-> TableSettings table -> [SqliteSyntax]
forall a b. (a -> b) -> a -> b
$
                              TableSettings table
tblSettings

                (BeamSqliteRow (table Identity) -> table Identity)
-> [BeamSqliteRow (table Identity)] -> [table Identity]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(BeamSqliteRow table Identity
r) -> table Identity
r) ([BeamSqliteRow (table Identity)] -> [table Identity])
-> IO [BeamSqliteRow (table Identity)] -> IO [table Identity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [BeamSqliteRow (table Identity)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn (TablePrefix -> Query
Query (TablePrefix
"SELECT " TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
columns TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
" FROM inserted_values_" TablePrefix -> TablePrefix -> TablePrefix
forall a. Semigroup a => a -> a -> a
<> TablePrefix
savepointId))
           IO ()
releaseSavepoint
           [table Identity] -> IO [table Identity]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [table Identity]
x

instance Beam.BeamHasInsertOnConflict Sqlite where
  newtype SqlConflictTarget Sqlite table = SqliteConflictTarget
    { forall (table :: (* -> *) -> *).
SqlConflictTarget Sqlite table
-> table (QExpr Sqlite QInternal) -> SqliteSyntax
unSqliteConflictTarget :: table (QExpr Sqlite QInternal) -> SqliteSyntax }
  newtype SqlConflictAction Sqlite table = SqliteConflictAction
    { forall (table :: (* -> *) -> *).
SqlConflictAction Sqlite table
-> forall s. table (QField s) -> SqliteSyntax
unSqliteConflictAction :: forall s. table (QField s) -> SqliteSyntax }

  insertOnConflict
    :: forall db table s. Beamable table
    => DatabaseEntity Sqlite db (TableEntity table)
    -> SqlInsertValues Sqlite (table (QExpr Sqlite s))
    -> Beam.SqlConflictTarget Sqlite table
    -> Beam.SqlConflictAction Sqlite table
    -> SqlInsert Sqlite table
  insertOnConflict :: forall (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
Beamable table =>
DatabaseEntity Sqlite db (TableEntity table)
-> SqlInsertValues Sqlite (table (QExpr Sqlite s))
-> SqlConflictTarget Sqlite table
-> SqlConflictAction Sqlite table
-> SqlInsert Sqlite table
insertOnConflict (DatabaseEntity DatabaseEntityDescriptor Sqlite (TableEntity table)
dt) SqlInsertValues Sqlite (table (QExpr Sqlite s))
values SqlConflictTarget Sqlite table
target SqlConflictAction Sqlite table
action = case SqlInsertValues Sqlite (table (QExpr Sqlite s))
values of
    SqlInsertValues Sqlite (table (QExpr Sqlite s))
SqlInsertValuesEmpty -> SqlInsert Sqlite table
forall be (table :: (* -> *) -> *). SqlInsert be table
SqlInsertNoRows
    SqlInsertValues Sql92InsertValuesSyntax
  (Sql92InsertSyntax (BeamSqlBackendSyntax Sqlite))
vs -> TableSettings table
-> Sql92InsertSyntax (BeamSqlBackendSyntax Sqlite)
-> SqlInsert Sqlite table
forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendInsertSyntax be -> SqlInsert be table
SqlInsert (DatabaseEntityDescriptor Sqlite (TableEntity table)
-> TableSettings table
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Sqlite (TableEntity table)
dt) (Sql92InsertSyntax (BeamSqlBackendSyntax Sqlite)
 -> SqlInsert Sqlite table)
-> Sql92InsertSyntax (BeamSqlBackendSyntax Sqlite)
-> SqlInsert Sqlite table
forall a b. (a -> b) -> a -> b
$
      let getFieldName
            :: forall a
            .  Columnar' (TableField table) a
            -> Columnar' (QField QInternal) a
          getFieldName :: forall a.
Columnar' (TableField table) a -> Columnar' (QField QInternal) a
getFieldName (Columnar' Columnar (TableField table) a
fd) =
            Columnar (QField QInternal) a -> Columnar' (QField QInternal) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar (QField QInternal) a -> Columnar' (QField QInternal) a)
-> Columnar (QField QInternal) a -> Columnar' (QField QInternal) a
forall a b. (a -> b) -> a -> b
$ Bool -> TablePrefix -> TablePrefix -> QField QInternal a
forall s ty. Bool -> TablePrefix -> TablePrefix -> QField s ty
QField Bool
False (DatabaseEntityDescriptor Sqlite (TableEntity table) -> TablePrefix
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TablePrefix
dbTableCurrentName DatabaseEntityDescriptor Sqlite (TableEntity table)
dt) (TablePrefix -> QField QInternal a)
-> TablePrefix -> QField QInternal a
forall a b. (a -> b) -> a -> b
$ TableField table a -> TablePrefix
forall (table :: (* -> *) -> *) ty.
TableField table ty -> TablePrefix
_fieldName TableField table a
Columnar (TableField table) a
fd
          tableFields :: table (QField QInternal)
tableFields = (forall a.
 Columnar' (TableField table) a -> Columnar' (QField QInternal) a)
-> TableSettings table -> table (QField QInternal)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep Columnar' (TableField table) a -> Columnar' (QField QInternal) a
forall a.
Columnar' (TableField table) a -> Columnar' (QField QInternal) a
getFieldName (TableSettings table -> table (QField QInternal))
-> TableSettings table -> table (QField QInternal)
forall a b. (a -> b) -> a -> b
$ DatabaseEntityDescriptor Sqlite (TableEntity table)
-> TableSettings table
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Sqlite (TableEntity table)
dt
          tellFieldName :: p -> p -> b -> m b
tellFieldName p
_ p
_ b
f = [b] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [b
f] m () -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
f
          fieldNames :: [TablePrefix]
fieldNames = Writer [TablePrefix] (table (QField QInternal)) -> [TablePrefix]
forall w a. Writer w a -> w
execWriter (Writer [TablePrefix] (table (QField QInternal)) -> [TablePrefix])
-> Writer [TablePrefix] (table (QField QInternal)) -> [TablePrefix]
forall a b. (a -> b) -> a -> b
$
            Proxy AnyType
-> Proxy ((), TablePrefix)
-> (forall context.
    AnyType context =>
    Proxy context
    -> Proxy ()
    -> TablePrefix
    -> WriterT [TablePrefix] Identity TablePrefix)
-> table (QField QInternal)
-> Writer [TablePrefix] (table (QField QInternal))
forall (m :: * -> *).
Monad m =>
Proxy AnyType
-> Proxy ((), TablePrefix)
-> (forall context.
    AnyType context =>
    Proxy context -> Proxy () -> TablePrefix -> m TablePrefix)
-> table (QField QInternal)
-> m (table (QField QInternal))
forall (contextPredicate :: * -> Constraint) be res a
       (m :: * -> *).
(ProjectibleWithPredicate contextPredicate be res a, Monad m) =>
Proxy contextPredicate
-> Proxy (be, res)
-> (forall context.
    contextPredicate context =>
    Proxy context -> Proxy be -> res -> m res)
-> a
-> m a
project' (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @AnyType) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @((), T.Text)) Proxy context
-> Proxy ()
-> TablePrefix
-> WriterT [TablePrefix] Identity TablePrefix
forall context.
AnyType context =>
Proxy context
-> Proxy ()
-> TablePrefix
-> WriterT [TablePrefix] Identity TablePrefix
forall {m :: * -> *} {b} {p} {p}.
MonadWriter [b] m =>
p -> p -> b -> m b
tellFieldName table (QField QInternal)
tableFields
          currentField
            :: forall a
            .  Columnar' (QField QInternal) a
            -> Columnar' (QExpr Sqlite QInternal) a
          currentField :: forall a.
Columnar' (QField QInternal) a
-> Columnar' (QExpr Sqlite QInternal) a
currentField (Columnar' Columnar (QField QInternal) a
f) = Columnar (QExpr Sqlite QInternal) a
-> Columnar' (QExpr Sqlite QInternal) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar (QExpr Sqlite QInternal) a
 -> Columnar' (QExpr Sqlite QInternal) a)
-> Columnar (QExpr Sqlite QInternal) a
-> Columnar' (QExpr Sqlite QInternal) a
forall a b. (a -> b) -> a -> b
$ QField QInternal a -> QExpr Sqlite QInternal a
forall be s ty. BeamSqlBackend be => QField s ty -> QExpr be s ty
current_ Columnar (QField QInternal) a
QField QInternal a
f
          tableCurrent :: table (QExpr Sqlite QInternal)
tableCurrent = (forall a.
 Columnar' (QField QInternal) a
 -> Columnar' (QExpr Sqlite QInternal) a)
-> table (QField QInternal) -> table (QExpr Sqlite QInternal)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep Columnar' (QField QInternal) a
-> Columnar' (QExpr Sqlite QInternal) a
forall a.
Columnar' (QField QInternal) a
-> Columnar' (QExpr Sqlite QInternal) a
currentField table (QField QInternal)
tableFields
      in SqliteTableNameSyntax
-> [TablePrefix]
-> SqliteInsertValuesSyntax
-> Maybe SqliteOnConflictSyntax
-> SqliteInsertSyntax
SqliteInsertSyntax (DatabaseEntityDescriptor Sqlite (TableEntity table)
-> SqliteTableNameSyntax
forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor Sqlite (TableEntity table)
dt) [TablePrefix]
fieldNames Sql92InsertValuesSyntax
  (Sql92InsertSyntax (BeamSqlBackendSyntax Sqlite))
SqliteInsertValuesSyntax
vs (Maybe SqliteOnConflictSyntax -> SqliteInsertSyntax)
-> Maybe SqliteOnConflictSyntax -> SqliteInsertSyntax
forall a b. (a -> b) -> a -> b
$ SqliteOnConflictSyntax -> Maybe SqliteOnConflictSyntax
forall a. a -> Maybe a
Just (SqliteOnConflictSyntax -> Maybe SqliteOnConflictSyntax)
-> SqliteOnConflictSyntax -> Maybe SqliteOnConflictSyntax
forall a b. (a -> b) -> a -> b
$
           SqliteSyntax -> SqliteOnConflictSyntax
SqliteOnConflictSyntax (SqliteSyntax -> SqliteOnConflictSyntax)
-> SqliteSyntax -> SqliteOnConflictSyntax
forall a b. (a -> b) -> a -> b
$ [SqliteSyntax] -> SqliteSyntax
forall a. Monoid a => [a] -> a
mconcat
             [ ByteString -> SqliteSyntax
emit ByteString
"ON CONFLICT "
             , SqlConflictTarget Sqlite table
-> table (QExpr Sqlite QInternal) -> SqliteSyntax
forall (table :: (* -> *) -> *).
SqlConflictTarget Sqlite table
-> table (QExpr Sqlite QInternal) -> SqliteSyntax
unSqliteConflictTarget SqlConflictTarget Sqlite table
target table (QExpr Sqlite QInternal)
tableCurrent
             , ByteString -> SqliteSyntax
emit ByteString
" DO "
             , SqlConflictAction Sqlite table
-> forall s. table (QField s) -> SqliteSyntax
forall (table :: (* -> *) -> *).
SqlConflictAction Sqlite table
-> forall s. table (QField s) -> SqliteSyntax
unSqliteConflictAction SqlConflictAction Sqlite table
action table (QField QInternal)
tableFields
             ]

  anyConflict :: forall (table :: (* -> *) -> *). SqlConflictTarget Sqlite table
anyConflict = (table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
forall (table :: (* -> *) -> *).
(table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
SqliteConflictTarget ((table (QExpr Sqlite QInternal) -> SqliteSyntax)
 -> SqlConflictTarget Sqlite table)
-> (table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
forall a b. (a -> b) -> a -> b
$ SqliteSyntax -> table (QExpr Sqlite QInternal) -> SqliteSyntax
forall a b. a -> b -> a
const SqliteSyntax
forall a. Monoid a => a
mempty
  conflictingFields :: forall proj (table :: (* -> *) -> *).
Projectible Sqlite proj =>
(table (QExpr Sqlite QInternal) -> proj)
-> SqlConflictTarget Sqlite table
conflictingFields table (QExpr Sqlite QInternal) -> proj
makeProjection = (table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
forall (table :: (* -> *) -> *).
(table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
SqliteConflictTarget ((table (QExpr Sqlite QInternal) -> SqliteSyntax)
 -> SqlConflictTarget Sqlite table)
-> (table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
forall a b. (a -> b) -> a -> b
$ \table (QExpr Sqlite QInternal)
table ->
    SqliteSyntax -> SqliteSyntax
parens (SqliteSyntax -> SqliteSyntax) -> SqliteSyntax -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ [SqliteSyntax] -> SqliteSyntax
commas ([SqliteSyntax] -> SqliteSyntax) -> [SqliteSyntax] -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ (SqliteExpressionSyntax -> SqliteSyntax)
-> [SqliteExpressionSyntax] -> [SqliteSyntax]
forall a b. (a -> b) -> [a] -> [b]
map SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression ([SqliteExpressionSyntax] -> [SqliteSyntax])
-> [SqliteExpressionSyntax] -> [SqliteSyntax]
forall a b. (a -> b) -> a -> b
$
      Proxy Sqlite
-> proj -> WithExprContext [BeamSqlBackendExpressionSyntax Sqlite]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Sqlite) (table (QExpr Sqlite QInternal) -> proj
makeProjection table (QExpr Sqlite QInternal)
table) TablePrefix
"t"
  conflictingFieldsWhere :: forall proj (table :: (* -> *) -> *).
Projectible Sqlite proj =>
(table (QExpr Sqlite QInternal) -> proj)
-> (forall s. table (QExpr Sqlite s) -> QExpr Sqlite s Bool)
-> SqlConflictTarget Sqlite table
conflictingFieldsWhere table (QExpr Sqlite QInternal) -> proj
makeProjection forall s. table (QExpr Sqlite s) -> QExpr Sqlite s Bool
makeWhere =
    (table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
forall (table :: (* -> *) -> *).
(table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
SqliteConflictTarget ((table (QExpr Sqlite QInternal) -> SqliteSyntax)
 -> SqlConflictTarget Sqlite table)
-> (table (QExpr Sqlite QInternal) -> SqliteSyntax)
-> SqlConflictTarget Sqlite table
forall a b. (a -> b) -> a -> b
$ \table (QExpr Sqlite QInternal)
table -> [SqliteSyntax] -> SqliteSyntax
forall a. Monoid a => [a] -> a
mconcat
      [ SqlConflictTarget Sqlite table
-> table (QExpr Sqlite QInternal) -> SqliteSyntax
forall (table :: (* -> *) -> *).
SqlConflictTarget Sqlite table
-> table (QExpr Sqlite QInternal) -> SqliteSyntax
unSqliteConflictTarget ((table (QExpr Sqlite QInternal) -> proj)
-> SqlConflictTarget Sqlite table
forall be proj (table :: (* -> *) -> *).
(BeamHasInsertOnConflict be, Projectible be proj) =>
(table (QExpr be QInternal) -> proj) -> SqlConflictTarget be table
forall proj (table :: (* -> *) -> *).
Projectible Sqlite proj =>
(table (QExpr Sqlite QInternal) -> proj)
-> SqlConflictTarget Sqlite table
Beam.conflictingFields table (QExpr Sqlite QInternal) -> proj
makeProjection) table (QExpr Sqlite QInternal)
table
      , ByteString -> SqliteSyntax
emit ByteString
" WHERE "
      , let QExpr TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
mkE = table (QExpr Sqlite QInternal)
-> QGenExpr QValueContext Sqlite QInternal Bool
forall s. table (QExpr Sqlite s) -> QExpr Sqlite s Bool
makeWhere table (QExpr Sqlite QInternal)
table
        in SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression (SqliteExpressionSyntax -> SqliteSyntax)
-> SqliteExpressionSyntax -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
mkE TablePrefix
"t"
      ]

  onConflictDoNothing :: forall (table :: (* -> *) -> *). SqlConflictAction Sqlite table
onConflictDoNothing = (forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
forall (table :: (* -> *) -> *).
(forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
SqliteConflictAction ((forall s. table (QField s) -> SqliteSyntax)
 -> SqlConflictAction Sqlite table)
-> (forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
forall a b. (a -> b) -> a -> b
$ SqliteSyntax -> table (QField s) -> SqliteSyntax
forall a b. a -> b -> a
const (SqliteSyntax -> table (QField s) -> SqliteSyntax)
-> SqliteSyntax -> table (QField s) -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ ByteString -> SqliteSyntax
emit ByteString
"NOTHING"
  onConflictUpdateSet :: forall (table :: (* -> *) -> *).
Beamable table =>
(forall s.
 table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s)
-> SqlConflictAction Sqlite table
onConflictUpdateSet forall s.
table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s
makeAssignments = (forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
forall (table :: (* -> *) -> *).
(forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
SqliteConflictAction ((forall s. table (QField s) -> SqliteSyntax)
 -> SqlConflictAction Sqlite table)
-> (forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
forall a b. (a -> b) -> a -> b
$ \table (QField s)
table -> [SqliteSyntax] -> SqliteSyntax
forall a. Monoid a => [a] -> a
mconcat
    [ ByteString -> SqliteSyntax
emit ByteString
"UPDATE SET "
    , let QAssignment [(Sql92ExpressionFieldNameSyntax
    (BeamSqlBackendExpressionSyntax Sqlite),
  BeamSqlBackendExpressionSyntax Sqlite)]
assignments = table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s
forall s.
table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s
makeAssignments table (QField s)
table (table (QExpr Sqlite s) -> QAssignment Sqlite s)
-> table (QExpr Sqlite s) -> QAssignment Sqlite s
forall a b. (a -> b) -> a -> b
$ table (QField s) -> table (QExpr Sqlite s)
forall (table :: (* -> *) -> *) s.
Beamable table =>
table (QField s) -> table (QExpr Sqlite s)
excluded table (QField s)
table
          emitAssignment :: (SqliteFieldNameSyntax, SqliteExpressionSyntax) -> SqliteSyntax
emitAssignment (SqliteFieldNameSyntax
fieldName, SqliteExpressionSyntax
expr) = [SqliteSyntax] -> SqliteSyntax
forall a. Monoid a => [a] -> a
mconcat
            [ SqliteFieldNameSyntax -> SqliteSyntax
fromSqliteFieldNameSyntax SqliteFieldNameSyntax
fieldName
            , ByteString -> SqliteSyntax
emit ByteString
" = "
            , SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression SqliteExpressionSyntax
expr
            ]
      in [SqliteSyntax] -> SqliteSyntax
commas ([SqliteSyntax] -> SqliteSyntax) -> [SqliteSyntax] -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ ((SqliteFieldNameSyntax, SqliteExpressionSyntax) -> SqliteSyntax)
-> [(SqliteFieldNameSyntax, SqliteExpressionSyntax)]
-> [SqliteSyntax]
forall a b. (a -> b) -> [a] -> [b]
map (SqliteFieldNameSyntax, SqliteExpressionSyntax) -> SqliteSyntax
emitAssignment [(Sql92ExpressionFieldNameSyntax
    (BeamSqlBackendExpressionSyntax Sqlite),
  BeamSqlBackendExpressionSyntax Sqlite)]
[(SqliteFieldNameSyntax, SqliteExpressionSyntax)]
assignments
    ]
  onConflictUpdateSetWhere :: forall (table :: (* -> *) -> *).
Beamable table =>
(forall s.
 table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s)
-> (forall s.
    table (QField s) -> table (QExpr Sqlite s) -> QExpr Sqlite s Bool)
-> SqlConflictAction Sqlite table
onConflictUpdateSetWhere forall s.
table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s
makeAssignments forall s.
table (QField s) -> table (QExpr Sqlite s) -> QExpr Sqlite s Bool
makeWhere =
    (forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
forall (table :: (* -> *) -> *).
(forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
SqliteConflictAction ((forall s. table (QField s) -> SqliteSyntax)
 -> SqlConflictAction Sqlite table)
-> (forall s. table (QField s) -> SqliteSyntax)
-> SqlConflictAction Sqlite table
forall a b. (a -> b) -> a -> b
$ \table (QField s)
table -> [SqliteSyntax] -> SqliteSyntax
forall a. Monoid a => [a] -> a
mconcat
      [ SqlConflictAction Sqlite table
-> forall s. table (QField s) -> SqliteSyntax
forall (table :: (* -> *) -> *).
SqlConflictAction Sqlite table
-> forall s. table (QField s) -> SqliteSyntax
unSqliteConflictAction ((forall s.
 table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s)
-> SqlConflictAction Sqlite table
forall be (table :: (* -> *) -> *).
(BeamHasInsertOnConflict be, Beamable table) =>
(forall s.
 table (QField s) -> table (QExpr be s) -> QAssignment be s)
-> SqlConflictAction be table
forall (table :: (* -> *) -> *).
Beamable table =>
(forall s.
 table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s)
-> SqlConflictAction Sqlite table
Beam.onConflictUpdateSet table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s
forall s.
table (QField s) -> table (QExpr Sqlite s) -> QAssignment Sqlite s
makeAssignments) table (QField s)
table
      , ByteString -> SqliteSyntax
emit ByteString
" WHERE "
      , let QExpr TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
mkE = table (QField s)
-> table (QExpr Sqlite s) -> QGenExpr QValueContext Sqlite s Bool
forall s.
table (QField s) -> table (QExpr Sqlite s) -> QExpr Sqlite s Bool
makeWhere table (QField s)
table (table (QExpr Sqlite s) -> QGenExpr QValueContext Sqlite s Bool)
-> table (QExpr Sqlite s) -> QGenExpr QValueContext Sqlite s Bool
forall a b. (a -> b) -> a -> b
$ table (QField s) -> table (QExpr Sqlite s)
forall (table :: (* -> *) -> *) s.
Beamable table =>
table (QField s) -> table (QExpr Sqlite s)
excluded table (QField s)
table
        in SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression (SqliteExpressionSyntax -> SqliteSyntax)
-> SqliteExpressionSyntax -> SqliteSyntax
forall a b. (a -> b) -> a -> b
$ TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
mkE TablePrefix
"t"
      ]

excluded
  :: forall table s
  .  Beamable table
  => table (QField s)
  -> table (QExpr Sqlite s)
excluded :: forall (table :: (* -> *) -> *) s.
Beamable table =>
table (QField s) -> table (QExpr Sqlite s)
excluded table (QField s)
table = (forall a. Columnar' (QField s) a -> Columnar' (QExpr Sqlite s) a)
-> table (QField s) -> table (QExpr Sqlite s)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep Columnar' (QField s) a -> Columnar' (QExpr Sqlite s) a
forall a. Columnar' (QField s) a -> Columnar' (QExpr Sqlite s) a
forall {f :: * -> *} {a} {context} {be} {s} {t} {f :: * -> *} {a}
       {s} {ty}.
(Columnar f a ~ QGenExpr context be s t,
 Columnar f a ~ QField s ty,
 IsSql92ExpressionSyntax
   (Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be))))) =>
Columnar' f a -> Columnar' f a
excludedField table (QField s)
table
  where excludedField :: Columnar' f a -> Columnar' f a
excludedField (Columnar' (QField Bool
_ TablePrefix
_ TablePrefix
name)) =
          Columnar f a -> Columnar' f a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Columnar f a -> Columnar' f a) -> Columnar f a -> Columnar' f a
forall a b. (a -> b) -> a -> b
$ (TablePrefix
 -> Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
-> QGenExpr context be s t
forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr ((TablePrefix
  -> Sql92SelectTableExpressionSyntax
       (Sql92SelectSelectTableSyntax
          (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
 -> QGenExpr context be s t)
-> (TablePrefix
    -> Sql92SelectTableExpressionSyntax
         (Sql92SelectSelectTableSyntax
            (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
-> QGenExpr context be s t
forall a b. (a -> b) -> a -> b
$ Sql92SelectTableExpressionSyntax
  (Sql92SelectSelectTableSyntax
     (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
-> TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
forall a b. a -> b -> a
const (Sql92SelectTableExpressionSyntax
   (Sql92SelectSelectTableSyntax
      (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
 -> TablePrefix
 -> Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
-> TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
forall a b. (a -> b) -> a -> b
$ Sql92ExpressionFieldNameSyntax
  (Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Sql92ExpressionFieldNameSyntax
   (Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
 -> Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
-> Sql92ExpressionFieldNameSyntax
     (Sql92SelectTableExpressionSyntax
        (Sql92SelectSelectTableSyntax
           (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
forall a b. (a -> b) -> a -> b
$ TablePrefix
-> TablePrefix
-> Sql92ExpressionFieldNameSyntax
     (Sql92SelectTableExpressionSyntax
        (Sql92SelectSelectTableSyntax
           (Sql92SelectSyntax (BeamSqlBackendSyntax be))))
forall fn.
IsSql92FieldNameSyntax fn =>
TablePrefix -> TablePrefix -> fn
qualifiedField TablePrefix
"excluded" TablePrefix
name