{-|
Module: Squeal.PostgreSQL.Expression.Inline
Description: inline expressions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

inline expressions
-}

{-# LANGUAGE
    DataKinds
  , FlexibleContexts
  , FlexibleInstances
  , LambdaCase
  , MultiParamTypeClasses
  , MultiWayIf
  , OverloadedStrings
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , TypeSynonymInstances
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Expression.Inline
  ( -- * Inline
    Inline (..)
  , InlineParam (..)
  , InlineField (..)
  , inlineFields
  , InlineColumn (..)
  , inlineColumns
  ) where

import Data.Binary.Builder (toLazyByteString)
import Data.ByteString.Lazy (toStrict)
import Data.ByteString.Builder (doubleDec, floatDec, int16Dec, int32Dec, int64Dec)
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Functor.Const (Const(Const))
import Data.Functor.Constant (Constant(Constant))
import Data.Int (Int16, Int32, Int64)
import Data.Kind (Type)
import Data.Scientific (Scientific)
import Data.String
import Data.Text (Text)
import Data.Time.Clock (DiffTime, diffTimeToPicoseconds, UTCTime)
import Data.Time.Format.ISO8601 (formatShow, timeOfDayAndOffsetFormat, FormatExtension(ExtendedFormat), iso8601Show)
import Data.Time.Calendar (Day)
import Data.Time.LocalTime (LocalTime, TimeOfDay, TimeZone)
import Data.UUID.Types (UUID, toASCIIBytes)
import Data.Vector (Vector, toList)
import Database.PostgreSQL.LibPQ (Oid(Oid))
import GHC.TypeLits

import qualified Data.Aeson as JSON
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text.Lazy as Lazy.Text
import qualified Generics.SOP as SOP
import qualified Generics.SOP.Record as SOP

import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Expression.Array
import Squeal.PostgreSQL.Expression.Default
import Squeal.PostgreSQL.Expression.Composite
import Squeal.PostgreSQL.Expression.Logic
import Squeal.PostgreSQL.Expression.Null
import Squeal.PostgreSQL.Expression.Range
import Squeal.PostgreSQL.Expression.Time
import Squeal.PostgreSQL.Expression.Type
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Type.PG
import Squeal.PostgreSQL.Type.Schema

{- |
The `Inline` class allows embedding a Haskell value directly
as an `Expression` using `inline`.

>>> printSQL (inline 'a')
(E'a' :: char(1))

>>> printSQL (inline (1 :: Double))
(1.0 :: float8)

>>> printSQL (inline (Json ([1, 2] :: [Double])))
('[1.0,2.0]' :: json)

>>> printSQL (inline (Enumerated GT))
'GT'
-}
class Inline x where inline :: x -> Expr (null (PG x))
instance Inline Bool where
  inline :: Bool -> Expr (null (PG Bool))
inline = \case
    Bool
True -> Expression grp lat with db params from (null (PG Bool))
forall (null :: PGType -> NullType). Expr (null 'PGbool)
true
    Bool
False -> Expression grp lat with db params from (null (PG Bool))
forall (null :: PGType -> NullType). Expr (null 'PGbool)
false
instance JSON.ToJSON x => Inline (Json x) where
  inline :: Json x -> Expr (null (PG (Json x)))
inline (Json x
x)
    = Expression grp lat with db params from (null 'PGjson)
-> Expression grp lat with db params from (null 'PGjson)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGjson)
 -> Expression grp lat with db params from (null 'PGjson))
-> (x -> Expression grp lat with db params from (null 'PGjson))
-> x
-> Expression grp lat with db params from (null 'PGjson)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGjson)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGjson))
-> (x -> ByteString)
-> x
-> Expression grp lat with db params from (null 'PGjson)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString) -> (x -> ByteString) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    (ByteString -> ByteString) -> (x -> ByteString) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode
    (x -> Expression grp lat with db params from (null 'PGjson))
-> x -> Expression grp lat with db params from (null 'PGjson)
forall a b. (a -> b) -> a -> b
$ x
x
instance JSON.ToJSON x => Inline (Jsonb x) where
  inline :: Jsonb x -> Expr (null (PG (Jsonb x)))
inline (Jsonb x
x)
    = Expression grp lat with db params from (null 'PGjsonb)
-> Expression grp lat with db params from (null 'PGjsonb)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGjsonb)
 -> Expression grp lat with db params from (null 'PGjsonb))
-> (x -> Expression grp lat with db params from (null 'PGjsonb))
-> x
-> Expression grp lat with db params from (null 'PGjsonb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGjsonb)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGjsonb))
-> (x -> ByteString)
-> x
-> Expression grp lat with db params from (null 'PGjsonb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString) -> (x -> ByteString) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    (ByteString -> ByteString) -> (x -> ByteString) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode
    (x -> Expression grp lat with db params from (null 'PGjsonb))
-> x -> Expression grp lat with db params from (null 'PGjsonb)
forall a b. (a -> b) -> a -> b
$ x
x
instance Inline Char where
  inline :: Char -> Expr (null (PG Char))
inline Char
chr = Expression grp lat with db params from (null ('PGchar 1))
-> Expression grp lat with db params from (null ('PGchar 1))
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype (Expression grp lat with db params from (null ('PGchar 1))
 -> Expression grp lat with db params from (null ('PGchar 1)))
-> (ByteString
    -> Expression grp lat with db params from (null ('PGchar 1)))
-> ByteString
-> Expression grp lat with db params from (null ('PGchar 1))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null ('PGchar 1))
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString
 -> Expression grp lat with db params from (null ('PGchar 1)))
-> ByteString
-> Expression grp lat with db params from (null ('PGchar 1))
forall a b. (a -> b) -> a -> b
$
    ByteString
"E\'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Char -> String
escape Char
chr) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
instance Inline String where inline :: String -> Expr (null (PG String))
inline String
x = String -> Expression grp lat with db params from (null 'PGtext)
forall a. IsString a => String -> a
fromString String
x
instance Inline Int16 where
  inline :: Int16 -> Expr (null (PG Int16))
inline Int16
x
    = Expression grp lat with db params from (null 'PGint2)
-> Expression grp lat with db params from (null 'PGint2)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGint2)
 -> Expression grp lat with db params from (null 'PGint2))
-> (Int16 -> Expression grp lat with db params from (null 'PGint2))
-> Int16
-> Expression grp lat with db params from (null 'PGint2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGint2)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGint2))
-> (Int16 -> ByteString)
-> Int16
-> Expression grp lat with db params from (null 'PGint2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    (ByteString -> ByteString)
-> (Int16 -> ByteString) -> Int16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    (Builder -> ByteString)
-> (Int16 -> Builder) -> Int16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
int16Dec
    (Int16 -> Expression grp lat with db params from (null 'PGint2))
-> Int16 -> Expression grp lat with db params from (null 'PGint2)
forall a b. (a -> b) -> a -> b
$ Int16
x
instance Inline Int32 where
  inline :: Int32 -> Expr (null (PG Int32))
inline Int32
x
    = Expression grp lat with db params from (null 'PGint4)
-> Expression grp lat with db params from (null 'PGint4)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGint4)
 -> Expression grp lat with db params from (null 'PGint4))
-> (Int32 -> Expression grp lat with db params from (null 'PGint4))
-> Int32
-> Expression grp lat with db params from (null 'PGint4)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGint4)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGint4))
-> (Int32 -> ByteString)
-> Int32
-> Expression grp lat with db params from (null 'PGint4)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    (ByteString -> ByteString)
-> (Int32 -> ByteString) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    (Builder -> ByteString)
-> (Int32 -> Builder) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
int32Dec
    (Int32 -> Expression grp lat with db params from (null 'PGint4))
-> Int32 -> Expression grp lat with db params from (null 'PGint4)
forall a b. (a -> b) -> a -> b
$ Int32
x
instance Inline Int64 where
  inline :: Int64 -> Expr (null (PG Int64))
inline Int64
x =
    if Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
forall a. Bounded a => a
minBound
    -- For some reason Postgres throws an error with
    -- (-9223372036854775808 :: int8)
    -- even though it's a valid lowest value for int8
    then Int64 -> Expr (null (PG Int64))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline (Int64
xInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1) Expression grp lat with db params from (null 'PGint8)
-> Expression grp lat with db params from (null 'PGint8)
-> Expression grp lat with db params from (null 'PGint8)
forall a. Num a => a -> a -> a
- Expression grp lat with db params from (null 'PGint8)
1
    else Expression grp lat with db params from (null 'PGint8)
-> Expression grp lat with db params from (null 'PGint8)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGint8)
 -> Expression grp lat with db params from (null 'PGint8))
-> (Builder
    -> Expression grp lat with db params from (null 'PGint8))
-> Builder
-> Expression grp lat with db params from (null 'PGint8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGint8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGint8))
-> (Builder -> ByteString)
-> Builder
-> Expression grp lat with db params from (null 'PGint8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    (Builder -> Expression grp lat with db params from (null 'PGint8))
-> Builder -> Expression grp lat with db params from (null 'PGint8)
forall a b. (a -> b) -> a -> b
$ Int64 -> Builder
int64Dec Int64
x
instance Inline Float where
  inline :: Float -> Expr (null (PG Float))
inline Float
x = Expression grp lat with db params from (null 'PGfloat4)
-> Expression grp lat with db params from (null 'PGfloat4)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype (Expression grp lat with db params from (null 'PGfloat4)
 -> Expression grp lat with db params from (null 'PGfloat4))
-> (ByteString
    -> Expression grp lat with db params from (null 'PGfloat4))
-> ByteString
-> Expression grp lat with db params from (null 'PGfloat4)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGfloat4)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString
 -> Expression grp lat with db params from (null 'PGfloat4))
-> ByteString
-> Expression grp lat with db params from (null 'PGfloat4)
forall a b. (a -> b) -> a -> b
$
    if Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
x
    then ByteString -> ByteString
singleQuotedUtf8 (Float -> ByteString
decimal Float
x)
    else Float -> ByteString
decimal Float
x
    where
      decimal :: Float -> ByteString
decimal = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Float -> ByteString) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Float -> Builder) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
floatDec
instance Inline Double where
  inline :: Double -> Expr (null (PG Double))
inline Double
x = Expression grp lat with db params from (null 'PGfloat8)
-> Expression grp lat with db params from (null 'PGfloat8)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype (Expression grp lat with db params from (null 'PGfloat8)
 -> Expression grp lat with db params from (null 'PGfloat8))
-> (ByteString
    -> Expression grp lat with db params from (null 'PGfloat8))
-> ByteString
-> Expression grp lat with db params from (null 'PGfloat8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGfloat8)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString
 -> Expression grp lat with db params from (null 'PGfloat8))
-> ByteString
-> Expression grp lat with db params from (null 'PGfloat8)
forall a b. (a -> b) -> a -> b
$
    if Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x
    then ByteString -> ByteString
singleQuotedUtf8 (Double -> ByteString
decimal Double
x)
    else Double -> ByteString
decimal Double
x
    where
      decimal :: Double -> ByteString
decimal = ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Double -> ByteString) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Double -> Builder) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
doubleDec
instance Inline Scientific where
  inline :: Scientific -> Expr (null (PG Scientific))
inline Scientific
x
    = Expression grp lat with db params from (null 'PGnumeric)
-> Expression grp lat with db params from (null 'PGnumeric)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGnumeric)
 -> Expression grp lat with db params from (null 'PGnumeric))
-> (Scientific
    -> Expression grp lat with db params from (null 'PGnumeric))
-> Scientific
-> Expression grp lat with db params from (null 'PGnumeric)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGnumeric)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGnumeric))
-> (Scientific -> ByteString)
-> Scientific
-> Expression grp lat with db params from (null 'PGnumeric)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    (ByteString -> ByteString)
-> (Scientific -> ByteString) -> Scientific -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    (Builder -> ByteString)
-> (Scientific -> Builder) -> Scientific -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Builder
scientificBuilder
    (Scientific
 -> Expression grp lat with db params from (null 'PGnumeric))
-> Scientific
-> Expression grp lat with db params from (null 'PGnumeric)
forall a b. (a -> b) -> a -> b
$ Scientific
x
instance Inline Text where inline :: Text -> Expr (null (PG Text))
inline Text
x = String -> Expression grp lat with db params from (null 'PGtext)
forall a. IsString a => String -> a
fromString (String -> Expression grp lat with db params from (null 'PGtext))
-> (Text -> String)
-> Text
-> Expression grp lat with db params from (null 'PGtext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Expression grp lat with db params from (null 'PGtext))
-> Text -> Expression grp lat with db params from (null 'PGtext)
forall a b. (a -> b) -> a -> b
$ Text
x
instance Inline Lazy.Text where inline :: Text -> Expr (null (PG Text))
inline Text
x = String -> Expression grp lat with db params from (null 'PGtext)
forall a. IsString a => String -> a
fromString (String -> Expression grp lat with db params from (null 'PGtext))
-> (Text -> String)
-> Text
-> Expression grp lat with db params from (null 'PGtext)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Lazy.Text.unpack (Text -> Expression grp lat with db params from (null 'PGtext))
-> Text -> Expression grp lat with db params from (null 'PGtext)
forall a b. (a -> b) -> a -> b
$ Text
x
instance (KnownNat n, 1 <= n) => Inline (VarChar n) where
  inline :: VarChar n -> Expr (null (PG (VarChar n)))
inline VarChar n
x
    = Expression grp lat with db params from (null ('PGvarchar n))
-> Expression grp lat with db params from (null ('PGvarchar n))
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null ('PGvarchar n))
 -> Expression grp lat with db params from (null ('PGvarchar n)))
-> (VarChar n
    -> Expression grp lat with db params from (null ('PGvarchar n)))
-> VarChar n
-> Expression grp lat with db params from (null ('PGvarchar n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null ('PGvarchar n))
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null ('PGvarchar n)))
-> (VarChar n -> ByteString)
-> VarChar n
-> Expression grp lat with db params from (null ('PGvarchar n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
escapeQuotedText
    (Text -> ByteString)
-> (VarChar n -> Text) -> VarChar n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarChar n -> Text
forall (n :: Nat). VarChar n -> Text
getVarChar
    (VarChar n
 -> Expression grp lat with db params from (null ('PGvarchar n)))
-> VarChar n
-> Expression grp lat with db params from (null ('PGvarchar n))
forall a b. (a -> b) -> a -> b
$ VarChar n
x
instance (KnownNat n, 1 <= n) => Inline (FixChar n) where
  inline :: FixChar n -> Expr (null (PG (FixChar n)))
inline FixChar n
x
    = Expression grp lat with db params from (null ('PGchar n))
-> Expression grp lat with db params from (null ('PGchar n))
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null ('PGchar n))
 -> Expression grp lat with db params from (null ('PGchar n)))
-> (FixChar n
    -> Expression grp lat with db params from (null ('PGchar n)))
-> FixChar n
-> Expression grp lat with db params from (null ('PGchar n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null ('PGchar n))
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null ('PGchar n)))
-> (FixChar n -> ByteString)
-> FixChar n
-> Expression grp lat with db params from (null ('PGchar n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
escapeQuotedText
    (Text -> ByteString)
-> (FixChar n -> Text) -> FixChar n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixChar n -> Text
forall (n :: Nat). FixChar n -> Text
getFixChar
    (FixChar n
 -> Expression grp lat with db params from (null ('PGchar n)))
-> FixChar n
-> Expression grp lat with db params from (null ('PGchar n))
forall a b. (a -> b) -> a -> b
$ FixChar n
x
instance Inline x => Inline (Const x tag) where inline :: Const x tag -> Expr (null (PG (Const x tag)))
inline (Const x
x) = x -> Expr (null (PG x))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline x
x
instance Inline x => Inline (SOP.K x tag) where inline :: K x tag -> Expr (null (PG (K x tag)))
inline (SOP.K x
x) = x -> Expr (null (PG x))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline x
x
instance Inline x => Inline (Constant x tag) where
  inline :: Constant x tag -> Expr (null (PG (Constant x tag)))
inline (Constant x
x) = x -> Expr (null (PG x))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline x
x
instance Inline DiffTime where
  inline :: DiffTime -> Expr (null (PG DiffTime))
inline DiffTime
dt =
    let
      picosecs :: Integer
picosecs = DiffTime -> Integer
diffTimeToPicoseconds DiffTime
dt
      (Integer
secs,Integer
leftover) = Integer
picosecs Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000000000000
      microsecs :: Integer
microsecs = Integer
leftover Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
1000000
    in
      Expression grp lat with db params from (null 'PGinterval)
-> Expression grp lat with db params from (null 'PGinterval)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype (Expression grp lat with db params from (null 'PGinterval)
 -> Expression grp lat with db params from (null 'PGinterval))
-> Expression grp lat with db params from (null 'PGinterval)
-> Expression grp lat with db params from (null 'PGinterval)
forall a b. (a -> b) -> a -> b
$
        Milli -> TimeUnit -> Expr (null 'PGinterval)
forall (null :: PGType -> NullType).
Milli -> TimeUnit -> Expr (null 'PGinterval)
interval_ (Integer -> Milli
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
secs) TimeUnit
Seconds
        Expression grp lat with db params from (null 'PGinterval)
-> Expression grp lat with db params from (null 'PGinterval)
-> Expression grp lat with db params from (null 'PGinterval)
forall k (time :: k) (diff :: k) (null :: k -> NullType).
TimeOp time diff =>
Operator (null diff) (null time) (null time)
+! Milli -> TimeUnit -> Expr (null 'PGinterval)
forall (null :: PGType -> NullType).
Milli -> TimeUnit -> Expr (null 'PGinterval)
interval_ (Integer -> Milli
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
microsecs) TimeUnit
Microseconds
instance Inline Day where
  inline :: Day -> Expr (null (PG Day))
inline Day
x
    = Expression grp lat with db params from (null 'PGdate)
-> Expression grp lat with db params from (null 'PGdate)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGdate)
 -> Expression grp lat with db params from (null 'PGdate))
-> (Day -> Expression grp lat with db params from (null 'PGdate))
-> Day
-> Expression grp lat with db params from (null 'PGdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGdate)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGdate))
-> (Day -> ByteString)
-> Day
-> Expression grp lat with db params from (null 'PGdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString)
-> (Day -> ByteString) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
    (String -> ByteString) -> (Day -> String) -> Day -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> String
forall t. ISO8601 t => t -> String
iso8601Show
    (Day -> Expression grp lat with db params from (null 'PGdate))
-> Day -> Expression grp lat with db params from (null 'PGdate)
forall a b. (a -> b) -> a -> b
$ Day
x
instance Inline UTCTime where
  inline :: UTCTime -> Expr (null (PG UTCTime))
inline UTCTime
x
    = Expression grp lat with db params from (null 'PGtimestamptz)
-> Expression grp lat with db params from (null 'PGtimestamptz)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGtimestamptz)
 -> Expression grp lat with db params from (null 'PGtimestamptz))
-> (UTCTime
    -> Expression grp lat with db params from (null 'PGtimestamptz))
-> UTCTime
-> Expression grp lat with db params from (null 'PGtimestamptz)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGtimestamptz)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGtimestamptz))
-> (UTCTime -> ByteString)
-> UTCTime
-> Expression grp lat with db params from (null 'PGtimestamptz)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString)
-> (UTCTime -> ByteString) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
    (String -> ByteString)
-> (UTCTime -> String) -> UTCTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show
    (UTCTime
 -> Expression grp lat with db params from (null 'PGtimestamptz))
-> UTCTime
-> Expression grp lat with db params from (null 'PGtimestamptz)
forall a b. (a -> b) -> a -> b
$ UTCTime
x
instance Inline (TimeOfDay, TimeZone) where
  inline :: (TimeOfDay, TimeZone) -> Expr (null (PG (TimeOfDay, TimeZone)))
inline (TimeOfDay, TimeZone)
x
    = Expression grp lat with db params from (null 'PGtimetz)
-> Expression grp lat with db params from (null 'PGtimetz)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGtimetz)
 -> Expression grp lat with db params from (null 'PGtimetz))
-> ((TimeOfDay, TimeZone)
    -> Expression grp lat with db params from (null 'PGtimetz))
-> (TimeOfDay, TimeZone)
-> Expression grp lat with db params from (null 'PGtimetz)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGtimetz)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGtimetz))
-> ((TimeOfDay, TimeZone) -> ByteString)
-> (TimeOfDay, TimeZone)
-> Expression grp lat with db params from (null 'PGtimetz)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString)
-> ((TimeOfDay, TimeZone) -> ByteString)
-> (TimeOfDay, TimeZone)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
    (String -> ByteString)
-> ((TimeOfDay, TimeZone) -> String)
-> (TimeOfDay, TimeZone)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format (TimeOfDay, TimeZone) -> (TimeOfDay, TimeZone) -> String
forall t. Format t -> t -> String
formatShow (FormatExtension -> Format (TimeOfDay, TimeZone)
timeOfDayAndOffsetFormat FormatExtension
ExtendedFormat)
    ((TimeOfDay, TimeZone)
 -> Expression grp lat with db params from (null 'PGtimetz))
-> (TimeOfDay, TimeZone)
-> Expression grp lat with db params from (null 'PGtimetz)
forall a b. (a -> b) -> a -> b
$ (TimeOfDay, TimeZone)
x
instance Inline TimeOfDay where
  inline :: TimeOfDay -> Expr (null (PG TimeOfDay))
inline TimeOfDay
x
    = Expression grp lat with db params from (null 'PGtime)
-> Expression grp lat with db params from (null 'PGtime)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGtime)
 -> Expression grp lat with db params from (null 'PGtime))
-> (TimeOfDay
    -> Expression grp lat with db params from (null 'PGtime))
-> TimeOfDay
-> Expression grp lat with db params from (null 'PGtime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGtime)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGtime))
-> (TimeOfDay -> ByteString)
-> TimeOfDay
-> Expression grp lat with db params from (null 'PGtime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString)
-> (TimeOfDay -> ByteString) -> TimeOfDay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
    (String -> ByteString)
-> (TimeOfDay -> String) -> TimeOfDay -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> String
forall t. ISO8601 t => t -> String
iso8601Show
    (TimeOfDay
 -> Expression grp lat with db params from (null 'PGtime))
-> TimeOfDay
-> Expression grp lat with db params from (null 'PGtime)
forall a b. (a -> b) -> a -> b
$ TimeOfDay
x
instance Inline LocalTime where
  inline :: LocalTime -> Expr (null (PG LocalTime))
inline LocalTime
x
    = Expression grp lat with db params from (null 'PGtimestamp)
-> Expression grp lat with db params from (null 'PGtimestamp)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGtimestamp)
 -> Expression grp lat with db params from (null 'PGtimestamp))
-> (LocalTime
    -> Expression grp lat with db params from (null 'PGtimestamp))
-> LocalTime
-> Expression grp lat with db params from (null 'PGtimestamp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGtimestamp)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGtimestamp))
-> (LocalTime -> ByteString)
-> LocalTime
-> Expression grp lat with db params from (null 'PGtimestamp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString)
-> (LocalTime -> ByteString) -> LocalTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
    (String -> ByteString)
-> (LocalTime -> String) -> LocalTime -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> String
forall t. ISO8601 t => t -> String
iso8601Show
    (LocalTime
 -> Expression grp lat with db params from (null 'PGtimestamp))
-> LocalTime
-> Expression grp lat with db params from (null 'PGtimestamp)
forall a b. (a -> b) -> a -> b
$ LocalTime
x
instance Inline (Range Int32) where
  inline :: Range Int32 -> Expr (null (PG (Range Int32)))
inline Range Int32
x = TypeExpression db (null ('PGrange 'PGint4))
-> Range
     (Expression grp lat with db params from ('NotNull 'PGint4))
-> Expression grp lat with db params from (null ('PGrange 'PGint4))
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (params :: [NullType]) (from :: FromType).
TypeExpression db (null ('PGrange ty))
-> Range (Expression grp lat with db params from ('NotNull ty))
-> Expression grp lat with db params from (null ('PGrange ty))
range TypeExpression db (null ('PGrange 'PGint4))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGint4))
int4range (Range (Expression grp lat with db params from ('NotNull 'PGint4))
 -> Expression
      grp lat with db params from (null ('PGrange 'PGint4)))
-> (Range Int32
    -> Range
         (Expression grp lat with db params from ('NotNull 'PGint4)))
-> Range Int32
-> Expression grp lat with db params from (null ('PGrange 'PGint4))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32
 -> Expression grp lat with db params from ('NotNull 'PGint4))
-> Range Int32
-> Range
     (Expression grp lat with db params from ('NotNull 'PGint4))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int32
y -> Int32 -> Expr ('NotNull (PG Int32))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Int32
y) (Range Int32
 -> Expression
      grp lat with db params from (null ('PGrange 'PGint4)))
-> Range Int32
-> Expression grp lat with db params from (null ('PGrange 'PGint4))
forall a b. (a -> b) -> a -> b
$ Range Int32
x
instance Inline (Range Int64) where
  inline :: Range Int64 -> Expr (null (PG (Range Int64)))
inline Range Int64
x = TypeExpression db (null ('PGrange 'PGint8))
-> Range
     (Expression grp lat with db params from ('NotNull 'PGint8))
-> Expression grp lat with db params from (null ('PGrange 'PGint8))
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (params :: [NullType]) (from :: FromType).
TypeExpression db (null ('PGrange ty))
-> Range (Expression grp lat with db params from ('NotNull ty))
-> Expression grp lat with db params from (null ('PGrange ty))
range TypeExpression db (null ('PGrange 'PGint8))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGint8))
int8range (Range (Expression grp lat with db params from ('NotNull 'PGint8))
 -> Expression
      grp lat with db params from (null ('PGrange 'PGint8)))
-> (Range Int64
    -> Range
         (Expression grp lat with db params from ('NotNull 'PGint8)))
-> Range Int64
-> Expression grp lat with db params from (null ('PGrange 'PGint8))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64
 -> Expression grp lat with db params from ('NotNull 'PGint8))
-> Range Int64
-> Range
     (Expression grp lat with db params from ('NotNull 'PGint8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int64
y -> Int64 -> Expr ('NotNull (PG Int64))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Int64
y) (Range Int64
 -> Expression
      grp lat with db params from (null ('PGrange 'PGint8)))
-> Range Int64
-> Expression grp lat with db params from (null ('PGrange 'PGint8))
forall a b. (a -> b) -> a -> b
$ Range Int64
x
instance Inline (Range Scientific) where
  inline :: Range Scientific -> Expr (null (PG (Range Scientific)))
inline Range Scientific
x = TypeExpression db (null ('PGrange 'PGnumeric))
-> Range
     (Expression grp lat with db params from ('NotNull 'PGnumeric))
-> Expression
     grp lat with db params from (null ('PGrange 'PGnumeric))
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (params :: [NullType]) (from :: FromType).
TypeExpression db (null ('PGrange ty))
-> Range (Expression grp lat with db params from ('NotNull ty))
-> Expression grp lat with db params from (null ('PGrange ty))
range TypeExpression db (null ('PGrange 'PGnumeric))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGnumeric))
numrange (Range
   (Expression grp lat with db params from ('NotNull 'PGnumeric))
 -> Expression
      grp lat with db params from (null ('PGrange 'PGnumeric)))
-> (Range Scientific
    -> Range
         (Expression grp lat with db params from ('NotNull 'PGnumeric)))
-> Range Scientific
-> Expression
     grp lat with db params from (null ('PGrange 'PGnumeric))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific
 -> Expression grp lat with db params from ('NotNull 'PGnumeric))
-> Range Scientific
-> Range
     (Expression grp lat with db params from ('NotNull 'PGnumeric))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Scientific
y -> Scientific -> Expr ('NotNull (PG Scientific))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Scientific
y) (Range Scientific
 -> Expression
      grp lat with db params from (null ('PGrange 'PGnumeric)))
-> Range Scientific
-> Expression
     grp lat with db params from (null ('PGrange 'PGnumeric))
forall a b. (a -> b) -> a -> b
$ Range Scientific
x
instance Inline (Range LocalTime) where
  inline :: Range LocalTime -> Expr (null (PG (Range LocalTime)))
inline Range LocalTime
x = TypeExpression db (null ('PGrange 'PGtimestamp))
-> Range
     (Expression grp lat with db params from ('NotNull 'PGtimestamp))
-> Expression
     grp lat with db params from (null ('PGrange 'PGtimestamp))
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (params :: [NullType]) (from :: FromType).
TypeExpression db (null ('PGrange ty))
-> Range (Expression grp lat with db params from ('NotNull ty))
-> Expression grp lat with db params from (null ('PGrange ty))
range TypeExpression db (null ('PGrange 'PGtimestamp))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGtimestamp))
tsrange (Range
   (Expression grp lat with db params from ('NotNull 'PGtimestamp))
 -> Expression
      grp lat with db params from (null ('PGrange 'PGtimestamp)))
-> (Range LocalTime
    -> Range
         (Expression grp lat with db params from ('NotNull 'PGtimestamp)))
-> Range LocalTime
-> Expression
     grp lat with db params from (null ('PGrange 'PGtimestamp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalTime
 -> Expression grp lat with db params from ('NotNull 'PGtimestamp))
-> Range LocalTime
-> Range
     (Expression grp lat with db params from ('NotNull 'PGtimestamp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LocalTime
y -> LocalTime -> Expr ('NotNull (PG LocalTime))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline LocalTime
y) (Range LocalTime
 -> Expression
      grp lat with db params from (null ('PGrange 'PGtimestamp)))
-> Range LocalTime
-> Expression
     grp lat with db params from (null ('PGrange 'PGtimestamp))
forall a b. (a -> b) -> a -> b
$ Range LocalTime
x
instance Inline (Range UTCTime) where
  inline :: Range UTCTime -> Expr (null (PG (Range UTCTime)))
inline Range UTCTime
x = TypeExpression db (null ('PGrange 'PGtimestamptz))
-> Range
     (Expression grp lat with db params from ('NotNull 'PGtimestamptz))
-> Expression
     grp lat with db params from (null ('PGrange 'PGtimestamptz))
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (params :: [NullType]) (from :: FromType).
TypeExpression db (null ('PGrange ty))
-> Range (Expression grp lat with db params from ('NotNull ty))
-> Expression grp lat with db params from (null ('PGrange ty))
range TypeExpression db (null ('PGrange 'PGtimestamptz))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGtimestamptz))
tstzrange (Range
   (Expression grp lat with db params from ('NotNull 'PGtimestamptz))
 -> Expression
      grp lat with db params from (null ('PGrange 'PGtimestamptz)))
-> (Range UTCTime
    -> Range
         (Expression grp lat with db params from ('NotNull 'PGtimestamptz)))
-> Range UTCTime
-> Expression
     grp lat with db params from (null ('PGrange 'PGtimestamptz))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime
 -> Expression
      grp lat with db params from ('NotNull 'PGtimestamptz))
-> Range UTCTime
-> Range
     (Expression grp lat with db params from ('NotNull 'PGtimestamptz))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UTCTime
y -> UTCTime -> Expr ('NotNull (PG UTCTime))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline UTCTime
y) (Range UTCTime
 -> Expression
      grp lat with db params from (null ('PGrange 'PGtimestamptz)))
-> Range UTCTime
-> Expression
     grp lat with db params from (null ('PGrange 'PGtimestamptz))
forall a b. (a -> b) -> a -> b
$ Range UTCTime
x
instance Inline (Range Day) where
  inline :: Range Day -> Expr (null (PG (Range Day)))
inline Range Day
x = TypeExpression db (null ('PGrange 'PGdate))
-> Range
     (Expression grp lat with db params from ('NotNull 'PGdate))
-> Expression grp lat with db params from (null ('PGrange 'PGdate))
forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (params :: [NullType]) (from :: FromType).
TypeExpression db (null ('PGrange ty))
-> Range (Expression grp lat with db params from ('NotNull ty))
-> Expression grp lat with db params from (null ('PGrange ty))
range TypeExpression db (null ('PGrange 'PGdate))
forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGdate))
daterange (Range (Expression grp lat with db params from ('NotNull 'PGdate))
 -> Expression
      grp lat with db params from (null ('PGrange 'PGdate)))
-> (Range Day
    -> Range
         (Expression grp lat with db params from ('NotNull 'PGdate)))
-> Range Day
-> Expression grp lat with db params from (null ('PGrange 'PGdate))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Day -> Expression grp lat with db params from ('NotNull 'PGdate))
-> Range Day
-> Range
     (Expression grp lat with db params from ('NotNull 'PGdate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Day
y -> Day -> Expr ('NotNull (PG Day))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Day
y) (Range Day
 -> Expression
      grp lat with db params from (null ('PGrange 'PGdate)))
-> Range Day
-> Expression grp lat with db params from (null ('PGrange 'PGdate))
forall a b. (a -> b) -> a -> b
$ Range Day
x
instance Inline UUID where
  inline :: UUID -> Expr (null (PG UUID))
inline UUID
x
    = Expression grp lat with db params from (null 'PGuuid)
-> Expression grp lat with db params from (null 'PGuuid)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype
    (Expression grp lat with db params from (null 'PGuuid)
 -> Expression grp lat with db params from (null 'PGuuid))
-> (UUID -> Expression grp lat with db params from (null 'PGuuid))
-> UUID
-> Expression grp lat with db params from (null 'PGuuid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGuuid)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    (ByteString
 -> Expression grp lat with db params from (null 'PGuuid))
-> (UUID -> ByteString)
-> UUID
-> Expression grp lat with db params from (null 'PGuuid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    (ByteString -> ByteString)
-> (UUID -> ByteString) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
toASCIIBytes
    (UUID -> Expression grp lat with db params from (null 'PGuuid))
-> UUID -> Expression grp lat with db params from (null 'PGuuid)
forall a b. (a -> b) -> a -> b
$ UUID
x
instance Inline Money where
  inline :: Money -> Expr (null (PG Money))
inline Money
moolah = Expression grp lat with db params from (null 'PGmoney)
-> Expression grp lat with db params from (null 'PGmoney)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype (Expression grp lat with db params from (null 'PGmoney)
 -> Expression grp lat with db params from (null 'PGmoney))
-> (ByteString
    -> Expression grp lat with db params from (null 'PGmoney))
-> ByteString
-> Expression grp lat with db params from (null 'PGmoney)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Expression grp lat with db params from (null 'PGmoney)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString
 -> Expression grp lat with db params from (null 'PGmoney))
-> ByteString
-> Expression grp lat with db params from (null 'PGmoney)
forall a b. (a -> b) -> a -> b
$
    String -> ByteString
forall a. IsString a => String -> a
fromString (Int64 -> String
forall a. Show a => a -> String
show Int64
dollars)
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString (Int64 -> String
forall a. Show a => a -> String
show Int64
pennies)
    where
      (Int64
dollars,Int64
pennies) = Money -> Int64
cents Money
moolah Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
100
instance InlineParam x (NullPG x)
  => Inline (VarArray [x]) where
    inline :: VarArray [x] -> Expr (null (PG (VarArray [x])))
inline (VarArray [x]
xs) = [Expression grp lat with db params from (NullPG x)]
-> Expression
     grp lat with db params from (null ('PGvararray (NullPG x)))
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType) (null :: PGType -> NullType).
[Expression grp lat with db params from ty]
-> Expression grp lat with db params from (null ('PGvararray ty))
array ((\x
x -> x -> Expr (NullPG x)
forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
x) (x -> Expression grp lat with db params from (NullPG x))
-> [x] -> [Expression grp lat with db params from (NullPG x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [x]
xs)
instance InlineParam x (NullPG x)
  => Inline (VarArray (Vector x)) where
    inline :: VarArray (Vector x) -> Expr (null (PG (VarArray (Vector x))))
inline (VarArray Vector x
xs) = [Expression grp lat with db params from (NullPG x)]
-> Expression
     grp lat with db params from (null ('PGvararray (NullPG x)))
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType) (null :: PGType -> NullType).
[Expression grp lat with db params from ty]
-> Expression grp lat with db params from (null ('PGvararray ty))
array ((\x
x -> x -> Expr (NullPG x)
forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
x) (x -> Expression grp lat with db params from (NullPG x))
-> [x] -> [Expression grp lat with db params from (NullPG x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector x -> [x]
forall a. Vector a -> [a]
toList Vector x
xs)
instance Inline Oid where
  inline :: Oid -> Expr (null (PG Oid))
inline (Oid CUInt
o) = Expression grp lat with db params from (null 'PGoid)
-> Expression grp lat with db params from (null 'PGoid)
forall (db :: SchemasType) (ty :: NullType) (lat :: Grouping)
       (common :: FromType) (grp :: FromType) (params :: [NullType])
       (from :: FromType).
NullTyped db ty =>
Expression lat common grp db params from ty
-> Expression lat common grp db params from ty
inferredtype (Expression grp lat with db params from (null 'PGoid)
 -> Expression grp lat with db params from (null 'PGoid))
-> (String -> Expression grp lat with db params from (null 'PGoid))
-> String
-> Expression grp lat with db params from (null 'PGoid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Expression grp lat with db params from (null 'PGoid)
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression (ByteString
 -> Expression grp lat with db params from (null 'PGoid))
-> (String -> ByteString)
-> String
-> Expression grp lat with db params from (null 'PGoid)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString (String -> Expression grp lat with db params from (null 'PGoid))
-> String -> Expression grp lat with db params from (null 'PGoid)
forall a b. (a -> b) -> a -> b
$ CUInt -> String
forall a. Show a => a -> String
show CUInt
o
instance
  ( SOP.IsEnumType x
  , SOP.HasDatatypeInfo x
  ) => Inline (Enumerated x) where
    inline :: Enumerated x -> Expr (null (PG (Enumerated x)))
inline (Enumerated x
x) =
      let
        gshowConstructor
          :: NP SOP.ConstructorInfo xss
          -> SOP.SOP SOP.I xss
          -> String
        gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor NP ConstructorInfo xss
Nil SOP I xss
_ = String
""
        gshowConstructor (ConstructorInfo x
constructor :* NP ConstructorInfo xs
_) (SOP.SOP (SOP.Z NP I x
_)) =
          ConstructorInfo x -> String
forall (xs :: [*]). ConstructorInfo xs -> String
SOP.constructorName ConstructorInfo x
constructor
        gshowConstructor (ConstructorInfo x
_ :* NP ConstructorInfo xs
constructors) (SOP.SOP (SOP.S NS (NP I) xs
xs)) =
          NP ConstructorInfo xs -> SOP I xs -> String
forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor NP ConstructorInfo xs
constructors (NS (NP I) xs -> SOP I xs
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP.SOP NS (NP I) xs
xs)
      in
        ByteString
-> Expression
     grp
     lat
     with
     db
     params
     from
     (null
        ('PGenum (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf x)))))
forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
        (ByteString
 -> Expression
      grp
      lat
      with
      db
      params
      from
      (null
         ('PGenum
            (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf x))))))
-> (x -> ByteString)
-> x
-> Expression
     grp
     lat
     with
     db
     params
     from
     (null
        ('PGenum (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf x)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
        (ByteString -> ByteString) -> (x -> ByteString) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
        (String -> ByteString) -> (x -> String) -> x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP ConstructorInfo (Code x) -> SOP I (Code x) -> String
forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor
            (DatatypeInfo (Code x) -> NP ConstructorInfo (Code x)
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
SOP.constructorInfo (Proxy x -> DatatypeInfo (Code x)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
SOP.datatypeInfo (Proxy x
forall k (t :: k). Proxy t
SOP.Proxy @x)))
        (SOP I (Code x) -> String) -> (x -> SOP I (Code x)) -> x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> SOP I (Code x)
forall a. Generic a => a -> Rep a
SOP.from
        (x
 -> Expression
      grp
      lat
      with
      db
      params
      from
      (null
         ('PGenum
            (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf x))))))
-> x
-> Expression
     grp
     lat
     with
     db
     params
     from
     (null
        ('PGenum (ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf x)))))
forall a b. (a -> b) -> a -> b
$ x
x
instance
  ( SOP.IsRecord x xs
  , SOP.AllZip InlineField xs (RowPG x)
  ) => Inline (Composite x) where
    inline :: Composite x -> Expr (null (PG (Composite x)))
inline (Composite x
x)
      = NP (Aliased (Expression grp lat with db params from)) (RowOf xs)
-> Expression
     grp lat with db params from (null ('PGcomposite (RowOf xs)))
forall (row :: [(Symbol, NullType)]) (grp :: Grouping)
       (lat :: FromType) (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (from :: FromType)
       (null :: PGType -> NullType).
SListI row =>
NP (Aliased (Expression grp lat with db params from)) row
-> Expression grp lat with db params from (null ('PGcomposite row))
row
      (NP (Aliased (Expression grp lat with db params from)) (RowOf xs)
 -> Expression
      grp lat with db params from (null ('PGcomposite (RowOf xs))))
-> (x
    -> NP
         (Aliased (Expression grp lat with db params from)) (RowOf xs))
-> x
-> Expression
     grp lat with db params from (null ('PGcomposite (RowOf xs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy InlineField
-> (forall (x :: (Symbol, *)) (y :: (Symbol, NullType)).
    InlineField x y =>
    P x -> Aliased (Expression grp lat with db params from) y)
-> NP P xs
-> NP (Aliased (Expression grp lat with db params from)) (RowOf xs)
forall k1 l1 k2 l2 (h1 :: (k1 -> *) -> l1 -> *)
       (h2 :: (k2 -> *) -> l2 -> *) (c :: k1 -> k2 -> Constraint)
       (xs :: l1) (ys :: l2) (proxy :: (k1 -> k2 -> Constraint) -> *)
       (f :: k1 -> *) (g :: k2 -> *).
(HTrans h1 h2, AllZipN (Prod h1) c xs ys) =>
proxy c
-> (forall (x :: k1) (y :: k2). c x y => f x -> g y)
-> h1 f xs
-> h2 g ys
SOP.htrans (Proxy InlineField
forall k (t :: k). Proxy t
SOP.Proxy @InlineField) forall (x :: (Symbol, *)) (y :: (Symbol, NullType)).
InlineField x y =>
P x -> Aliased (Expression grp lat with db params from) y
forall (field :: (Symbol, *)) (fieldpg :: (Symbol, NullType))
       (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
InlineField field fieldpg =>
P field -> Aliased (Expression grp lat with db params from) fieldpg
inlineField
      (NP P xs
 -> NP
      (Aliased (Expression grp lat with db params from)) (RowOf xs))
-> (x -> NP P xs)
-> x
-> NP (Aliased (Expression grp lat with db params from)) (RowOf xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> NP P xs
forall a (_r :: RecordCode). IsRecord a _r => a -> RecordRep a
SOP.toRecord
      (x
 -> Expression
      grp lat with db params from (null ('PGcomposite (RowOf xs))))
-> x
-> Expression
     grp lat with db params from (null ('PGcomposite (RowOf xs)))
forall a b. (a -> b) -> a -> b
$ x
x

-- | Lifts `Inline` to `NullType`s.
class InlineParam x ty where inlineParam :: x -> Expr ty
instance (Inline x, pg ~ PG x) => InlineParam x ('NotNull pg) where inlineParam :: x -> Expr ('NotNull pg)
inlineParam = x -> Expression grp lat with db params from ('NotNull pg)
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline
instance (Inline x, pg ~ PG x) => InlineParam (Maybe x) ('Null pg) where
  inlineParam :: Maybe x -> Expr ('Null pg)
inlineParam Maybe x
x = Expression grp lat with db params from ('Null pg)
-> (x -> Expression grp lat with db params from ('Null pg))
-> Maybe x
-> Expression grp lat with db params from ('Null pg)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expression grp lat with db params from ('Null pg)
forall (ty :: PGType). Expr ('Null ty)
null_ (\x
y -> x -> Expr ('Null (PG x))
forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline x
y) Maybe x
x

-- | Lifts `Inline` to fields.
class InlineField
  (field :: (Symbol, Type))
  (fieldpg :: (Symbol, NullType)) where
    inlineField
      :: SOP.P field
      -> Aliased (Expression grp lat with db params from) fieldpg
instance (KnownSymbol alias, InlineParam x ty)
  => InlineField (alias ::: x) (alias ::: ty) where
    inlineField :: P (alias ::: x)
-> Aliased (Expression grp lat with db params from) (alias ::: ty)
inlineField (SOP.P Snd (alias ::: x)
x) = x -> Expr ty
forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
Snd (alias ::: x)
x `as` Alias alias
forall (alias :: Symbol). Alias alias
Alias @alias

-- | Inline a Haskell record as a row of expressions.
inlineFields
  :: ( SOP.IsRecord hask fields
     , SOP.AllZip InlineField fields row )
  => hask -- ^ record
  -> NP (Aliased (Expression  'Ungrouped '[] with db params '[])) row
inlineFields :: hask
-> NP (Aliased (Expression 'Ungrouped '[] with db params '[])) row
inlineFields
  = Proxy InlineField
-> (forall (x :: (Symbol, *)) (y :: (Symbol, NullType)).
    InlineField x y =>
    P x -> Aliased (Expression 'Ungrouped '[] with db params '[]) y)
-> NP P fields
-> NP (Aliased (Expression 'Ungrouped '[] with db params '[])) row
forall k1 l1 k2 l2 (h1 :: (k1 -> *) -> l1 -> *)
       (h2 :: (k2 -> *) -> l2 -> *) (c :: k1 -> k2 -> Constraint)
       (xs :: l1) (ys :: l2) (proxy :: (k1 -> k2 -> Constraint) -> *)
       (f :: k1 -> *) (g :: k2 -> *).
(HTrans h1 h2, AllZipN (Prod h1) c xs ys) =>
proxy c
-> (forall (x :: k1) (y :: k2). c x y => f x -> g y)
-> h1 f xs
-> h2 g ys
SOP.htrans (Proxy InlineField
forall k (t :: k). Proxy t
SOP.Proxy @InlineField) forall (x :: (Symbol, *)) (y :: (Symbol, NullType)).
InlineField x y =>
P x -> Aliased (Expression 'Ungrouped '[] with db params '[]) y
forall (field :: (Symbol, *)) (fieldpg :: (Symbol, NullType))
       (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
InlineField field fieldpg =>
P field -> Aliased (Expression grp lat with db params from) fieldpg
inlineField
  (NP P fields
 -> NP (Aliased (Expression 'Ungrouped '[] with db params '[])) row)
-> (hask -> NP P fields)
-> hask
-> NP (Aliased (Expression 'Ungrouped '[] with db params '[])) row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. hask -> NP P fields
forall a (_r :: RecordCode). IsRecord a _r => a -> RecordRep a
SOP.toRecord


-- | Lifts `Inline` to a column entry
class InlineColumn
  (field :: (Symbol, Type))
  (column :: (Symbol, ColumnType)) where
  -- | Haskell record field as a inline column
  inlineColumn
    :: SOP.P field
    -> Aliased (Optional (Expression grp lat with db params from)) column
instance (KnownSymbol col, InlineParam x ty)
  => InlineColumn (col ::: x) (col ::: 'NoDef :=> ty) where
    inlineColumn :: P (col ::: x)
-> Aliased
     (Optional (Expression grp lat with db params from))
     (col ::: ('NoDef :=> ty))
inlineColumn (SOP.P Snd (col ::: x)
x) = Expression grp lat with db params from ty
-> Optional
     (Expression grp lat with db params from) ('NoDef :=> ty)
forall k (expr :: k -> *) (ty :: k) (def :: Optionality).
expr ty -> Optional expr (def :=> ty)
Set (x -> Expr ty
forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
Snd (col ::: x)
x) `as` (Alias col
forall (alias :: Symbol). Alias alias
Alias @col)
instance (KnownSymbol col, InlineParam x ty)
  => InlineColumn
    (col ::: Optional SOP.I ('Def :=> x))
    (col ::: 'Def :=> ty) where
    inlineColumn :: P (col ::: Optional I ('Def :=> x))
-> Aliased
     (Optional (Expression grp lat with db params from))
     (col ::: ('Def :=> ty))
inlineColumn (SOP.P Snd (col ::: Optional I ('Def :=> x))
optional) = case Snd (col ::: Optional I ('Def :=> x))
optional of
      Snd (col ::: Optional I ('Def :=> x))
Default -> Optional (Expression grp lat with db params from) ('Def :=> ty)
forall k (expr :: k -> *) (ty :: k). Optional expr ('Def :=> ty)
Default `as` (Alias col
forall (alias :: Symbol). Alias alias
Alias @col)
      Set (SOP.I x) -> Expression grp lat with db params from ty
-> Optional (Expression grp lat with db params from) ('Def :=> ty)
forall k (expr :: k -> *) (ty :: k) (def :: Optionality).
expr ty -> Optional expr (def :=> ty)
Set (x -> Expr ty
forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
x) `as` (Alias col
forall (alias :: Symbol). Alias alias
Alias @col)

-- | Inline a Haskell record as a list of columns.
inlineColumns
  :: ( SOP.IsRecord hask xs
     , SOP.AllZip InlineColumn xs columns )
  => hask -- ^ record
  -> NP (Aliased (Optional (Expression 'Ungrouped '[] with db params '[]))) columns
inlineColumns :: hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
inlineColumns
  = Proxy InlineColumn
-> (forall (x :: (Symbol, *))
           (y :: (Symbol, (Optionality, NullType))).
    InlineColumn x y =>
    P x
    -> Aliased
         (Optional (Expression 'Ungrouped '[] with db params '[])) y)
-> NP P xs
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
forall k1 l1 k2 l2 (h1 :: (k1 -> *) -> l1 -> *)
       (h2 :: (k2 -> *) -> l2 -> *) (c :: k1 -> k2 -> Constraint)
       (xs :: l1) (ys :: l2) (proxy :: (k1 -> k2 -> Constraint) -> *)
       (f :: k1 -> *) (g :: k2 -> *).
(HTrans h1 h2, AllZipN (Prod h1) c xs ys) =>
proxy c
-> (forall (x :: k1) (y :: k2). c x y => f x -> g y)
-> h1 f xs
-> h2 g ys
SOP.htrans (Proxy InlineColumn
forall k (t :: k). Proxy t
SOP.Proxy @InlineColumn) forall (x :: (Symbol, *)) (y :: (Symbol, (Optionality, NullType))).
InlineColumn x y =>
P x
-> Aliased
     (Optional (Expression 'Ungrouped '[] with db params '[])) y
forall (field :: (Symbol, *))
       (column :: (Symbol, (Optionality, NullType))) (grp :: Grouping)
       (lat :: FromType) (with :: FromType) (db :: SchemasType)
       (params :: [NullType]) (from :: FromType).
InlineColumn field column =>
P field
-> Aliased
     (Optional (Expression grp lat with db params from)) column
inlineColumn
  (NP P xs
 -> NP
      (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
      columns)
-> (hask -> NP P xs)
-> hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. hask -> NP P xs
forall a (_r :: RecordCode). IsRecord a _r => a -> RecordRep a
SOP.toRecord