{-|
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 :: forall (null :: PGType -> NullType). Bool -> Expr (null (PG Bool))
inline = \case
    Bool
True -> forall (null :: PGType -> NullType). Expr (null 'PGbool)
true
    Bool
False -> forall (null :: PGType -> NullType). Expr (null 'PGbool)
false
instance JSON.ToJSON x => Inline (Json x) where
  inline :: forall (null :: PGType -> NullType).
Json x -> Expr (null (PG (Json x)))
inline (Json x
x)
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
JSON.encode
    forall a b. (a -> b) -> a -> b
$ x
x
instance JSON.ToJSON x => Inline (Jsonb x) where
  inline :: forall (null :: PGType -> NullType).
Jsonb x -> Expr (null (PG (Jsonb x)))
inline (Jsonb x
x)
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
JSON.encode
    forall a b. (a -> b) -> a -> b
$ x
x
instance Inline Char where
  inline :: forall (null :: PGType -> NullType). Char -> Expr (null (PG Char))
inline Char
chr = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$
    ByteString
"E\'" forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (Char -> String
escape Char
chr) forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
instance Inline String where inline :: forall (null :: PGType -> NullType).
String -> Expr (null (PG String))
inline String
x = forall a. IsString a => String -> a
fromString String
x
instance Inline Int16 where
  inline :: forall (null :: PGType -> NullType).
Int16 -> Expr (null (PG Int16))
inline Int16
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
int16Dec
    forall a b. (a -> b) -> a -> b
$ Int16
x
instance Inline Int32 where
  inline :: forall (null :: PGType -> NullType).
Int32 -> Expr (null (PG Int32))
inline Int32
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
int32Dec
    forall a b. (a -> b) -> a -> b
$ Int32
x
instance Inline Int64 where
  inline :: forall (null :: PGType -> NullType).
Int64 -> Expr (null (PG Int64))
inline Int64
x =
    if Int64
x forall a. Eq a => a -> a -> Bool
== 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 forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline (Int64
xforall a. Num a => a -> a -> a
+Int64
1) forall a. Num a => a -> a -> a
- Expression grp lat with db params from (null 'PGint8)
1
    else 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    forall a b. (a -> b) -> a -> b
$ Int64 -> Builder
int64Dec Int64
x
instance Inline Float where
  inline :: forall (null :: PGType -> NullType).
Float -> Expr (null (PG Float))
inline Float
x = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$
    if forall a. RealFloat a => a -> Bool
isNaN Float
x Bool -> Bool -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
floatDec
instance Inline Double where
  inline :: forall (null :: PGType -> NullType).
Double -> Expr (null (PG Double))
inline Double
x = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$
    if forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
doubleDec
instance Inline Scientific where
  inline :: forall (null :: PGType -> NullType).
Scientific -> Expr (null (PG Scientific))
inline Scientific
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Builder
scientificBuilder
    forall a b. (a -> b) -> a -> b
$ Scientific
x
instance Inline Text where inline :: forall (null :: PGType -> NullType). Text -> Expr (null (PG Text))
inline Text
x = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Text
x
instance Inline Lazy.Text where inline :: forall (null :: PGType -> NullType). Text -> Expr (null (PG Text))
inline Text
x = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Lazy.Text.unpack forall a b. (a -> b) -> a -> b
$ Text
x
instance (KnownNat n, 1 <= n) => Inline (VarChar n) where
  inline :: forall (null :: PGType -> NullType).
VarChar n -> Expr (null (PG (VarChar n)))
inline VarChar n
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
escapeQuotedText
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural). VarChar n -> Text
getVarChar
    forall a b. (a -> b) -> a -> b
$ VarChar n
x
instance (KnownNat n, 1 <= n) => Inline (FixChar n) where
  inline :: forall (null :: PGType -> NullType).
FixChar n -> Expr (null (PG (FixChar n)))
inline FixChar n
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
escapeQuotedText
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural). FixChar n -> Text
getFixChar
    forall a b. (a -> b) -> a -> b
$ FixChar n
x
instance Inline x => Inline (Const x tag) where inline :: forall (null :: PGType -> NullType).
Const x tag -> Expr (null (PG (Const x tag)))
inline (Const x
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 :: forall (null :: PGType -> NullType).
K x tag -> Expr (null (PG (K x tag)))
inline (SOP.K x
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 :: forall (null :: PGType -> NullType).
Constant x tag -> Expr (null (PG (Constant x tag)))
inline (Constant x
x) = forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline x
x
instance Inline DiffTime where
  inline :: forall (null :: PGType -> NullType).
DiffTime -> Expr (null (PG DiffTime))
inline DiffTime
dt =
    let
      picosecs :: Integer
picosecs = DiffTime -> Integer
diffTimeToPicoseconds DiffTime
dt
      (Integer
secs,Integer
leftover) = Integer
picosecs forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
1000000000000
      microsecs :: Integer
microsecs = Integer
leftover forall a. Integral a => a -> a -> a
`quot` Integer
1000000
    in
      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 forall a b. (a -> b) -> a -> b
$
        forall (null :: PGType -> NullType).
Milli -> TimeUnit -> Expr (null 'PGinterval)
interval_ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
secs) TimeUnit
Seconds
        forall {k} (time :: k) (diff :: k) (null :: k -> NullType).
TimeOp time diff =>
Operator (null diff) (null time) (null time)
+! forall (null :: PGType -> NullType).
Milli -> TimeUnit -> Expr (null 'PGinterval)
interval_ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
microsecs) TimeUnit
Microseconds
instance Inline Day where
  inline :: forall (null :: PGType -> NullType). Day -> Expr (null (PG Day))
inline Day
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
iso8601Show
    forall a b. (a -> b) -> a -> b
$ Day
x
instance Inline UTCTime where
  inline :: forall (null :: PGType -> NullType).
UTCTime -> Expr (null (PG UTCTime))
inline UTCTime
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
iso8601Show
    forall a b. (a -> b) -> a -> b
$ UTCTime
x
instance Inline (TimeOfDay, TimeZone) where
  inline :: forall (null :: PGType -> NullType).
(TimeOfDay, TimeZone) -> Expr (null (PG (TimeOfDay, TimeZone)))
inline (TimeOfDay, TimeZone)
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Format t -> t -> String
formatShow (FormatExtension -> Format (TimeOfDay, TimeZone)
timeOfDayAndOffsetFormat FormatExtension
ExtendedFormat)
    forall a b. (a -> b) -> a -> b
$ (TimeOfDay, TimeZone)
x
instance Inline TimeOfDay where
  inline :: forall (null :: PGType -> NullType).
TimeOfDay -> Expr (null (PG TimeOfDay))
inline TimeOfDay
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
iso8601Show
    forall a b. (a -> b) -> a -> b
$ TimeOfDay
x
instance Inline LocalTime where
  inline :: forall (null :: PGType -> NullType).
LocalTime -> Expr (null (PG LocalTime))
inline LocalTime
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ISO8601 t => t -> String
iso8601Show
    forall a b. (a -> b) -> a -> b
$ LocalTime
x
instance Inline (Range Int32) where
  inline :: forall (null :: PGType -> NullType).
Range Int32 -> Expr (null (PG (Range Int32)))
inline Range Int32
x = 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 forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGint4))
int4range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int32
y -> forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Int32
y) forall a b. (a -> b) -> a -> b
$ Range Int32
x
instance Inline (Range Int64) where
  inline :: forall (null :: PGType -> NullType).
Range Int64 -> Expr (null (PG (Range Int64)))
inline Range Int64
x = 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 forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGint8))
int8range forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int64
y -> forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Int64
y) forall a b. (a -> b) -> a -> b
$ Range Int64
x
instance Inline (Range Scientific) where
  inline :: forall (null :: PGType -> NullType).
Range Scientific -> Expr (null (PG (Range Scientific)))
inline Range Scientific
x = 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 forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGnumeric))
numrange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Scientific
y -> forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Scientific
y) forall a b. (a -> b) -> a -> b
$ Range Scientific
x
instance Inline (Range LocalTime) where
  inline :: forall (null :: PGType -> NullType).
Range LocalTime -> Expr (null (PG (Range LocalTime)))
inline Range LocalTime
x = 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 forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGtimestamp))
tsrange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LocalTime
y -> forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline LocalTime
y) forall a b. (a -> b) -> a -> b
$ Range LocalTime
x
instance Inline (Range UTCTime) where
  inline :: forall (null :: PGType -> NullType).
Range UTCTime -> Expr (null (PG (Range UTCTime)))
inline Range UTCTime
x = 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 forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGtimestamptz))
tstzrange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UTCTime
y -> forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline UTCTime
y) forall a b. (a -> b) -> a -> b
$ Range UTCTime
x
instance Inline (Range Day) where
  inline :: forall (null :: PGType -> NullType).
Range Day -> Expr (null (PG (Range Day)))
inline Range Day
x = 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 forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null ('PGrange 'PGdate))
daterange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Day
y -> forall x (null :: PGType -> NullType).
Inline x =>
x -> Expr (null (PG x))
inline Day
y) forall a b. (a -> b) -> a -> b
$ Range Day
x
instance Inline UUID where
  inline :: forall (null :: PGType -> NullType). UUID -> Expr (null (PG UUID))
inline UUID
x
    = 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> ByteString
toASCIIBytes
    forall a b. (a -> b) -> a -> b
$ UUID
x
instance Inline Money where
  inline :: forall (null :: PGType -> NullType).
Money -> Expr (null (PG Money))
inline Money
moolah = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$
    forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int64
dollars)
    forall a. Semigroup a => a -> a -> a
<> ByteString
"." forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Int64
pennies)
    where
      (Int64
dollars,Int64
pennies) = Money -> Int64
cents Money
moolah forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
100
instance InlineParam x (NullPG x)
  => Inline (VarArray [x]) where
    inline :: forall (null :: PGType -> NullType).
VarArray [x] -> Expr (null (PG (VarArray [x])))
inline (VarArray [x]
xs) = 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 -> forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
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 :: forall (null :: PGType -> NullType).
VarArray (Vector x) -> Expr (null (PG (VarArray (Vector x))))
inline (VarArray Vector x
xs) = 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 -> forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Vector a -> [a]
toList Vector x
xs)
instance Inline Oid where
  inline :: forall (null :: PGType -> NullType). Oid -> Expr (null (PG Oid))
inline (Oid CUInt
o) = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show CUInt
o
instance
  ( SOP.IsEnumType x
  , SOP.HasDatatypeInfo x
  ) => Inline (Enumerated x) where
    inline :: forall (null :: PGType -> NullType).
Enumerated x -> Expr (null (PG (Enumerated x)))
inline (Enumerated x
x) =
      let
        gshowConstructor
          :: NP SOP.ConstructorInfo xss
          -> SOP.SOP SOP.I xss
          -> String
        gshowConstructor :: forall (xss :: [[*]]).
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
_)) =
          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)) =
          forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor NP ConstructorInfo xs
constructors (forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP.SOP NS (NP I) xs
xs)
      in
        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
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
singleQuotedUtf8
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor
            (forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
SOP.constructorInfo (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
SOP.datatypeInfo (forall {k} (t :: k). Proxy t
SOP.Proxy @x)))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => a -> Rep a
SOP.from
        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 :: forall (null :: PGType -> NullType).
Composite x -> Expr (null (PG (Composite x)))
inline (Composite x
x)
      = 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
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall {k} (t :: k). Proxy t
SOP.Proxy @InlineField) 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
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (_r :: RecordCode). IsRecord a _r => a -> RecordRep a
SOP.toRecord
      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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (ty :: PGType). Expr ('Null ty)
null_ (\x
y -> 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 :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
P (alias ::: x)
-> Aliased (Expression grp lat with db params from) (alias ::: ty)
inlineField (SOP.P Snd (alias ::: x)
x) = forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam Snd (alias ::: x)
x `as` 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 :: forall hask (fields :: RecordCode) (row :: [(Symbol, NullType)])
       (with :: FromType) (db :: SchemasType) (params :: [NullType]).
(IsRecord hask fields, AllZip InlineField fields row) =>
hask
-> NP (Aliased (Expression 'Ungrouped '[] with db params '[])) row
inlineFields
  = 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 (forall {k} (t :: k). Proxy t
SOP.Proxy @InlineField) 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
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
P (col ::: x)
-> Aliased
     (Optional (Expression grp lat with db params from))
     (col ::: ('NoDef :=> ty))
inlineColumn (SOP.P Snd (col ::: x)
x) = forall {k} (expr :: k -> *) (ty :: k) (def :: Optionality).
expr ty -> Optional expr (def :=> ty)
Set (forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam Snd (col ::: x)
x) `as` (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 :: forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType).
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))
Optional I ('Def :=> x)
Default -> forall {k} (expr :: k -> *) (ty :: k). Optional expr ('Def :=> ty)
Default `as` (forall (alias :: Symbol). Alias alias
Alias @col)
      Set (SOP.I x
x) -> forall {k} (expr :: k -> *) (ty :: k) (def :: Optionality).
expr ty -> Optional expr (def :=> ty)
Set (forall x (ty :: NullType). InlineParam x ty => x -> Expr ty
inlineParam x
x) `as` (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 :: forall hask (xs :: RecordCode)
       (columns :: [(Symbol, (Optionality, NullType))]) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]).
(IsRecord hask xs, AllZip InlineColumn xs columns) =>
hask
-> NP
     (Aliased (Optional (Expression 'Ungrouped '[] with db params '[])))
     columns
inlineColumns
  = 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 (forall {k} (t :: k). Proxy t
SOP.Proxy @InlineColumn) 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
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (_r :: RecordCode). IsRecord a _r => a -> RecordRep a
SOP.toRecord