{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# 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.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 )
import           Data.Typeable (cast)
import           Data.Word
import           GHC.TypeLits

import           Network.URI

#ifdef UNIX
import           System.Posix.Process (getProcessID)
#elif defined(WINDOWS)
import           System.Win32.Process (getCurrentProcessId)
#else
#error Need either POSIX or Win32 API for MonadBeamInsertReturning
#endif

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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
      Maybe (Char, TablePrefix)
_ -> String -> FromBackendRowM Sqlite Char
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 (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 (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 (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 -> String -> Ok Scientific
tryRead (TablePrefix -> String
T.unpack TablePrefix
t)
      SQLBlob ByteString
b -> String -> Ok Scientific
tryRead (ByteString -> String
BS.unpack ByteString
b)
      SQLData
SQLNull -> (String -> String -> String -> ResultError)
-> Field -> String -> Ok Scientific
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
UnexpectedNull Field
f String
"null"
    where
      tryRead :: String -> Ok Scientific
tryRead String
s =
        case String -> Maybe Scientific
forall a. Read a => String -> Maybe a
readMaybe String
s of
          Maybe Scientific
Nothing -> (String -> String -> String -> ResultError)
-> Field -> String -> Ok Scientific
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f (String -> Ok Scientific) -> String -> Ok Scientific
forall a b. (a -> b) -> a -> b
$
                     String
"No conversion to Scientific for '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"
          Just Scientific
s'  -> Scientific -> Ok Scientific
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' :: 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' (Proxy 'True
forall k (t :: k). Proxy t
Proxy @'True) (Proxy 'False
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 :: 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 (BeamSqlBackendCastTargetSyntax Sqlite
-> DataType Sqlite (SqlSerial Int)
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
DataType BeamSqlBackendCastTargetSyntax 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
  { SqliteM a -> ReaderT (String -> 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
a -> SqliteM a
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
SqliteM a -> (a -> SqliteM b) -> SqliteM b
SqliteM a -> SqliteM b -> SqliteM b
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
return :: a -> SqliteM a
$creturn :: forall a. a -> SqliteM a
>> :: SqliteM a -> SqliteM b -> SqliteM b
$c>> :: forall a b. SqliteM a -> SqliteM b -> SqliteM b
>>= :: SqliteM a -> (a -> SqliteM b) -> SqliteM b
$c>>= :: forall a b. SqliteM a -> (a -> SqliteM b) -> SqliteM b
$cp1Monad :: Applicative SqliteM
Monad, a -> SqliteM b -> SqliteM a
(a -> b) -> SqliteM a -> SqliteM b
(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
<$ :: a -> SqliteM b -> SqliteM a
$c<$ :: forall a b. a -> SqliteM b -> SqliteM a
fmap :: (a -> b) -> SqliteM a -> SqliteM b
$cfmap :: forall a b. (a -> b) -> SqliteM a -> SqliteM b
Functor, Functor SqliteM
a -> SqliteM a
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
SqliteM a -> SqliteM b -> SqliteM b
SqliteM a -> SqliteM b -> SqliteM a
SqliteM (a -> b) -> SqliteM a -> SqliteM b
(a -> b -> c) -> SqliteM a -> SqliteM b -> SqliteM c
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
<* :: SqliteM a -> SqliteM b -> SqliteM a
$c<* :: forall a b. SqliteM a -> SqliteM b -> SqliteM a
*> :: SqliteM a -> SqliteM b -> SqliteM b
$c*> :: forall a b. SqliteM a -> SqliteM b -> SqliteM b
liftA2 :: (a -> b -> c) -> SqliteM a -> SqliteM b -> SqliteM c
$cliftA2 :: forall a b c. (a -> b -> c) -> SqliteM a -> SqliteM b -> SqliteM c
<*> :: SqliteM (a -> b) -> SqliteM a -> SqliteM b
$c<*> :: forall a b. SqliteM (a -> b) -> SqliteM a -> SqliteM b
pure :: a -> SqliteM a
$cpure :: forall a. a -> SqliteM a
$cp1Applicative :: Functor SqliteM
Applicative, Monad SqliteM
Monad SqliteM -> (forall a. IO a -> SqliteM a) -> MonadIO SqliteM
IO a -> SqliteM a
forall a. IO a -> SqliteM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SqliteM a
$cliftIO :: forall a. IO a -> SqliteM a
$cp1MonadIO :: Monad SqliteM
MonadIO, Monad SqliteM
Monad SqliteM
-> (forall a. String -> SqliteM a) -> MonadFail SqliteM
String -> SqliteM a
forall a. String -> SqliteM a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> SqliteM a
$cfail :: forall a. String -> SqliteM a
$cp1MonadFail :: Monad SqliteM
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
-> (a -> RowParser a)
-> (FromBackendRowF Sqlite (RowParser a) -> RowParser a)
-> RowParser a
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 -> String
errSQLType     = String
typeString
                                   , errHaskellType :: ResultError -> String
errHaskellType = String
hsString
                                   , errMessage :: ResultError -> String
errMessage     = String
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 (String -> String -> String -> ColumnParseError
ColumnTypeMismatch String
hsString String
typeString (String
"conversion failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 -> String
errSQLType     = String
typeString
                               , errHaskellType :: ResultError -> String
errHaskellType = String
hsString
                               , errMessage :: ResultError -> String
errMessage     = String
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 (String -> String -> String -> ColumnParseError
ColumnTypeMismatch String
hsString String
typeString (String
"incompatible: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg))))
            Maybe ResultError
Nothing -> Maybe SomeException
forall a. Maybe a
Nothing

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

        step :: forall a'. FromBackendRowF Sqlite (RowParser a') -> RowParser a'
        step :: 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
-> (a -> RowParser a)
-> (FromBackendRowF Sqlite (RowParser a) -> RowParser a)
-> RowParser a
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
-> (a -> RowParser a)
-> (FromBackendRowF Sqlite (RowParser a) -> RowParser a)
-> RowParser a
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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a' -> StateT (Int, [SQLData]) Ok 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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Ok a' -> StateT (Int, [SQLData]) Ok 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(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 -> BeamSqlBackendCastTargetSyntax Sqlite
defaultSqlDataType Proxy (SqlSerial a)
_ Proxy Sqlite
_ Bool
False = BeamSqlBackendCastTargetSyntax Sqlite
SqliteDataTypeSyntax
sqliteSerialType
  defaultSqlDataType Proxy (SqlSerial a)
_ Proxy Sqlite
_ Bool
True = BeamSqlBackendCastTargetSyntax Sqlite
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 -> BeamSqlBackendCastTargetSyntax Sqlite
defaultSqlDataType Proxy ByteString
_ Proxy Sqlite
_ Bool
_ = BeamSqlBackendCastTargetSyntax Sqlite
SqliteDataTypeSyntax
sqliteBlobType

instance HasDefaultSqlDataType Sqlite LocalTime where
  defaultSqlDataType :: Proxy LocalTime
-> Proxy Sqlite -> Bool -> BeamSqlBackendCastTargetSyntax 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 :: c Sqlite Connection SqliteM -> BeamURIOpeners c
sqliteUriSyntax =
  (forall a. Connection -> SqliteM a -> IO a)
-> String
-> (URI -> IO (Connection, IO ()))
-> c Sqlite Connection SqliteM
-> BeamURIOpeners c
forall hdl (m :: * -> *) (c :: * -> * -> (* -> *) -> *) be.
(forall a. hdl -> m a -> IO a)
-> String
-> (URI -> IO (hdl, IO ()))
-> c be hdl m
-> BeamURIOpeners c
mkUriOpener forall a. Connection -> SqliteM a -> IO a
runBeamSqlite String
"sqlite:"
    (\URI
uri -> do
        let sqliteName :: String
sqliteName = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriPath URI
uri) then String
":memory:" else URI -> String
uriPath URI
uri
        Connection
hdl <- String -> IO Connection
open String
sqliteName
        (Connection, IO ()) -> IO (Connection, IO ())
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 :: (String -> IO ()) -> Connection -> SqliteM a -> IO a
runBeamSqliteDebug String -> IO ()
debugStmt Connection
conn SqliteM a
x = ReaderT (String -> IO (), Connection) IO a
-> (String -> IO (), Connection) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SqliteM a -> ReaderT (String -> IO (), Connection) IO a
forall a. SqliteM a -> ReaderT (String -> IO (), Connection) IO a
runSqliteM SqliteM a
x) (String -> IO ()
debugStmt, Connection
conn)

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

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

  runReturningMany :: BeamSqlBackendSyntax Sqlite
-> (SqliteM (Maybe x) -> SqliteM a) -> SqliteM a
runReturningMany (SqliteCommandSyntax (SqliteSyntax cmd vals)) SqliteM (Maybe x) -> SqliteM a
action =
      ReaderT (String -> IO (), Connection) IO a -> SqliteM a
forall a. ReaderT (String -> IO (), Connection) IO a -> SqliteM a
SqliteM (ReaderT (String -> IO (), Connection) IO a -> SqliteM a)
-> ReaderT (String -> IO (), Connection) IO a -> SqliteM a
forall a b. (a -> b) -> a -> b
$ do
        (String -> IO ()
logger, Connection
conn) <- ReaderT
  (String -> IO (), Connection) IO (String -> IO (), Connection)
forall r (m :: * -> *). MonadReader r m => m r
ask
        let cmdString :: String
cmdString = ByteString -> String
BL.unpack (Builder -> ByteString
toLazyByteString (((SQLData -> Builder) -> Builder) -> Builder
withPlaceholders (SQLData -> Builder) -> Builder
cmd))
        IO a -> ReaderT (String -> IO (), Connection) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderT (String -> IO (), Connection) IO a)
-> IO a -> ReaderT (String -> IO (), Connection) IO a
forall a b. (a -> b) -> a -> b
$ do
          String -> IO ()
logger (String
cmdString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n-- With values: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SQLData] -> String
forall a. Show a => a -> String
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 (String -> Query
forall a. IsString a => String -> a
fromString String
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 (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe x
row
               ReaderT (String -> IO (), Connection) IO a
-> (String -> IO (), Connection) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SqliteM a -> ReaderT (String -> IO (), Connection) IO a
forall a. SqliteM a -> ReaderT (String -> IO (), Connection) IO a
runSqliteM (SqliteM (Maybe x) -> SqliteM a
action SqliteM (Maybe x)
nextRow')) (String -> IO ()
logger, Connection
conn)
  runReturningMany SqliteCommandInsert {} SqliteM (Maybe x) -> SqliteM a
_ =
      String -> SqliteM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> SqliteM a)
-> ([String] -> String) -> [String] -> SqliteM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> SqliteM a) -> [String] -> SqliteM a
forall a b. (a -> b) -> a -> b
$
      [ String
"runReturningMany{Sqlite}: sqlite does not support returning "
      , String
"rows from an insert, use Database.Beam.Sqlite.insertReturning "
      , String
"for emulation" ]

instance Beam.MonadBeamInsertReturning Sqlite SqliteM where
  runInsertReturningList :: 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 :: (String -> IO ()) -> Connection -> SqliteInsertSyntax -> IO ()
runSqliteInsert String -> 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 :: String
cmdString = ByteString -> String
BL.unpack (Builder -> ByteString
toLazyByteString (((SQLData -> Builder) -> Builder) -> Builder
withPlaceholders (SQLData -> Builder) -> Builder
cmd))
        String -> IO ()
logger (String
cmdString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n-- With values: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SQLData] -> String
forall a. Show a => a -> String
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 (String -> Query
forall a. IsString a => String -> a
fromString String
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 :: String
cmdString = ByteString -> String
BL.unpack (Builder -> ByteString
toLazyByteString (((SQLData -> Builder) -> Builder) -> Builder
withPlaceholders (SQLData -> Builder) -> Builder
cmd))
      String -> IO ()
logger (String
cmdString String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n-- With values: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SQLData] -> String
forall a. Show a => a -> String
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 (String -> Query
forall a. IsString a => String -> a
fromString String
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 :: 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 :: SqlInsert Sqlite table -> SqliteM [table Identity]
runInsertReturningList SqlInsert Sqlite table
SqlInsertNoRows = [table Identity] -> SqliteM [table Identity]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
runInsertReturningList (SqlInsert TableSettings table
tblSettings insertStmt_ :: BeamSqlBackendInsertSyntax Sqlite
insertStmt_@(SqliteInsertSyntax nm _ _ _)) =
  do (String -> IO ()
logger, Connection
conn) <- ReaderT
  (String -> IO (), Connection) IO (String -> IO (), Connection)
-> SqliteM (String -> IO (), Connection)
forall a. ReaderT (String -> IO (), Connection) IO a -> SqliteM a
SqliteM ReaderT
  (String -> IO (), Connection) IO (String -> IO (), Connection)
forall r (m :: * -> *). MonadReader r m => m r
ask
     ReaderT (String -> IO (), Connection) IO [table Identity]
-> SqliteM [table Identity]
forall a. ReaderT (String -> IO (), Connection) IO a -> SqliteM a
SqliteM (ReaderT (String -> IO (), Connection) IO [table Identity]
 -> SqliteM [table Identity])
-> (IO [table Identity]
    -> ReaderT (String -> 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 (String -> IO (), Connection) IO [table Identity]
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

#ifdef UNIX
       TablePrefix
processId <- String -> TablePrefix
forall a. IsString a => String -> a
fromString (String -> TablePrefix)
-> (ProcessID -> String) -> ProcessID -> TablePrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessID -> String
forall a. Show a => a -> String
show (ProcessID -> TablePrefix) -> IO ProcessID -> IO TablePrefix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProcessID
getProcessID
#elif defined(WINDOWS)
       processId <- fromString . show <$> getCurrentProcessId
#else
#error Need either POSIX or Win32 API for MonadBeamInsertReturning
#endif

       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
processId))
           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
processId))
           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
processId))

           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
processId 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
processId))

           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
processId 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
processId 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
processId))


       ((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
                (String -> IO ()) -> Connection -> SqliteInsertSyntax -> IO ()
runSqliteInsert String -> IO ()
logger Connection
conn BeamSqlBackendInsertSyntax 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 Columnar (TableField table) a
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 (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
processId))
           IO ()
releaseSavepoint
           [table Identity] -> IO [table Identity]
forall (m :: * -> *) a. Monad m => a -> m a
return [table Identity]
x

instance Beam.BeamHasInsertOnConflict Sqlite where
  newtype SqlConflictTarget Sqlite table = SqliteConflictTarget
    { SqlConflictTarget Sqlite table
-> table (QExpr Sqlite QInternal) -> SqliteSyntax
unSqliteConflictTarget :: table (QExpr Sqlite QInternal) -> SqliteSyntax }
  newtype SqlConflictAction Sqlite table = SqliteConflictAction
    { 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 :: 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 BeamSqlBackendInsertValuesSyntax Sqlite
vs -> TableSettings table
-> BeamSqlBackendInsertSyntax Sqlite -> SqlInsert Sqlite table
forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendInsertSyntax be -> SqlInsert be table
SqlInsert (DatabaseEntityDescriptor Sqlite (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Sqlite (TableEntity table)
dt) (BeamSqlBackendInsertSyntax Sqlite -> SqlInsert Sqlite table)
-> BeamSqlBackendInsertSyntax Sqlite -> SqlInsert Sqlite table
forall a b. (a -> b) -> a -> b
$
      let getFieldName
            :: forall a
            .  Columnar' (TableField table) a
            -> Columnar' (QField QInternal) a
          getFieldName :: 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 be (tbl :: (* -> *) -> *).
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 Columnar (TableField table) a
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 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 be (tbl :: (* -> *) -> *).
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
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 (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' (Proxy AnyType
forall k (t :: k). Proxy t
Proxy @AnyType) (Proxy ((), TablePrefix)
forall k (t :: k). Proxy t
Proxy @((), T.Text)) 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 :: 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_ QField QInternal a
Columnar (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 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 BeamSqlBackendInsertValuesSyntax 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
-> table (QField QInternal) -> SqliteSyntax
forall (table :: (* -> *) -> *).
SqlConflictAction Sqlite table
-> forall s. table (QField s) -> SqliteSyntax
unSqliteConflictAction SqlConflictAction Sqlite table
action table (QField QInternal)
tableFields
             ]

  anyConflict :: 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 :: (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 (Proxy Sqlite
forall k (t :: k). Proxy t
Proxy @Sqlite) (table (QExpr Sqlite QInternal) -> proj
makeProjection table (QExpr Sqlite QInternal)
table) TablePrefix
"t"
  conflictingFieldsWhere :: (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
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 :: 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 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 [(BeamSqlBackendFieldNameSyntax 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 [(BeamSqlBackendFieldNameSyntax Sqlite,
  BeamSqlBackendExpressionSyntax Sqlite)]
[(SqliteFieldNameSyntax, SqliteExpressionSyntax)]
assignments
    ]
  onConflictUpdateSetWhere :: (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 -> 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
Beam.onConflictUpdateSet 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 :: 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 forall a. Columnar' (QField s) a -> Columnar' (QExpr Sqlite s) a
forall be (f :: * -> *) a s ty (f :: * -> *) a context s t.
(IsSql92ExpressionSyntax
   (Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be)))),
 Columnar f a ~ QField s ty,
 Columnar f a ~ QGenExpr context be s t) =>
Columnar' f a -> Columnar' f a
excludedField table (QField s)
table
  where excludedField :: Columnar' f a -> Columnar' f a
excludedField (Columnar' (QField _ _ 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