{-# language BlockArguments #-}
{-# language DataKinds #-}
{-# language DisambiguateRecordFields #-}
{-# language FlexibleContexts #-}
{-# language NamedFieldPuns #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language ViewPatterns #-}

{-# options_ghc -Wno-deprecations #-}

module Rel8.Table.Opaleye
  ( aggregator
  , attributes
  , binaryspec
  , distinctspec
  , exprs
  , exprsWithNames
  , table
  , tableFields
  , unpackspec
  , valuesspec
  , view
  , castTable
  )
where

-- base
import Data.Functor.Const ( Const( Const ), getConst )
import Data.List.NonEmpty ( NonEmpty )
import Prelude

-- opaleye
import qualified Opaleye.Adaptors as Opaleye
import qualified Opaleye.Field as Opaleye ( Field_ )
import qualified Opaleye.Internal.Aggregate as Opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye
import qualified Opaleye.Internal.Values as Opaleye
import qualified Opaleye.Table as Opaleye

-- profunctors
import Data.Profunctor ( dimap, lmap )

-- rel8
import Rel8.Aggregate ( Aggregate( Aggregate ), Aggregates )
import Rel8.Expr ( Expr )
import Rel8.Expr.Opaleye
  ( fromPrimExpr, toPrimExpr
  , scastExpr, traverseFieldP
  )
import Rel8.Schema.HTable ( htabulateA, hfield, hspecs, htabulate,
                            htraverseP, htraversePWithField )
import Rel8.Schema.Name ( Name( Name ), Selects, ppColumn )
import Rel8.Schema.Spec ( Spec(..) )
import Rel8.Schema.Table ( TableSchema(..), ppTable )
import Rel8.Table ( Table, fromColumns, toColumns )
import Rel8.Type.Information ( typeName )

-- semigroupoids
import Data.Functor.Apply ( WrappedApplicative(..) )
import Data.Profunctor.Product ( ProductProfunctor )


aggregator :: Aggregates aggregates exprs => Opaleye.Aggregator aggregates exprs
aggregator :: Aggregator aggregates exprs
aggregator = (aggregates -> Columns exprs Aggregate)
-> (Columns exprs Expr -> exprs)
-> Aggregator (Columns exprs Aggregate) (Columns exprs Expr)
-> Aggregator aggregates exprs
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap aggregates -> Columns exprs Aggregate
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Aggregator (Columns exprs Aggregate) (Columns exprs Expr)
 -> Aggregator aggregates exprs)
-> Aggregator (Columns exprs Aggregate) (Columns exprs Expr)
-> Aggregator aggregates exprs
forall a b. (a -> b) -> a -> b
$
             (forall a. Aggregator (Aggregate a) (Expr a))
-> Aggregator (Columns exprs Aggregate) (Columns exprs Expr)
forall (t :: HTable) (p :: * -> * -> *) (f :: * -> *)
       (g :: * -> *).
(HTable t, ProductProfunctor p) =>
(forall a. p (f a) (g a)) -> p (t f) (t g)
htraverseP ((forall a. Aggregator (Aggregate a) (Expr a))
 -> Aggregator (Columns exprs Aggregate) (Columns exprs Expr))
-> (forall a. Aggregator (Aggregate a) (Expr a))
-> Aggregator (Columns exprs Aggregate) (Columns exprs Expr)
forall a b. (a -> b) -> a -> b
$
             (Aggregate a -> (Aggregator () (Expr a), ()))
-> Aggregator (Aggregator () (Expr a), ()) (Expr a)
-> Aggregator (Aggregate a) (Expr a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (\(Aggregate Aggregator () (Expr a)
a) -> (Aggregator () (Expr a)
a, ())) Aggregator (Aggregator () (Expr a), ()) (Expr a)
forall a b. Aggregator (Aggregator a b, a) b
Opaleye.aggregatorApply


attributes :: Selects names exprs => TableSchema names -> exprs
attributes :: TableSchema names -> exprs
attributes schema :: TableSchema names
schema@TableSchema {names
columns :: forall names. TableSchema names -> names
columns :: names
columns} = Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns exprs Expr -> exprs) -> Columns exprs Expr -> exprs
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (Columns exprs) a -> Expr a)
 -> Columns exprs Expr)
-> (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
  case Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns names
columns) HField (Columns exprs) a
field of
    Name String
column -> PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> PrimExpr -> Expr a
forall a b. (a -> b) -> a -> b
$ Literal -> PrimExpr
Opaleye.ConstExpr (Literal -> PrimExpr) -> Literal -> PrimExpr
forall a b. (a -> b) -> a -> b
$
      String -> Literal
Opaleye.OtherLit (String -> Literal) -> String -> Literal
forall a b. (a -> b) -> a -> b
$
        Doc -> String
forall a. Show a => a -> String
show (TableSchema names -> Doc
forall a. TableSchema a -> Doc
ppTable TableSchema names
schema) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Doc -> String
forall a. Show a => a -> String
show (String -> Doc
ppColumn String
column)


fromOpaleyespec :: (ProductProfunctor p, Table Expr a)
  => p (Opaleye.Field_ n x) (Opaleye.Field_ n x)
  -> p a a
fromOpaleyespec :: p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec p (Field_ n x) (Field_ n x)
x =
  (a -> Columns a Expr)
-> (Columns a Expr -> a)
-> p (Columns a Expr) (Columns a Expr)
-> p a a
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns ((forall a. p (Expr a) (Expr a))
-> p (Columns a Expr) (Columns a Expr)
forall (t :: HTable) (p :: * -> * -> *) (f :: * -> *)
       (g :: * -> *).
(HTable t, ProductProfunctor p) =>
(forall a. p (f a) (g a)) -> p (t f) (t g)
htraverseP (p (Field_ n x) (Field_ n x) -> p (Expr a) (Expr a)
forall (p :: * -> * -> *) (n :: Nullability) x (m :: Nullability) y
       a b.
Profunctor p =>
p (Field_ n x) (Field_ m y) -> p (Expr a) (Expr b)
traverseFieldP p (Field_ n x) (Field_ n x)
x))


binaryspec :: Table Expr a => Opaleye.Binaryspec a a
binaryspec :: Binaryspec a a
binaryspec = Binaryspec (Field_ Any Any) (Field_ Any Any) -> Binaryspec a a
forall (p :: * -> * -> *) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec Binaryspec (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a. Binaryspec (Field_ n a) (Field_ n a)
Opaleye.binaryspecField


distinctspec :: Table Expr a => Opaleye.Distinctspec a a
distinctspec :: Distinctspec a a
distinctspec = Distinctspec (Field_ Any Any) (Field_ Any Any) -> Distinctspec a a
forall (p :: * -> * -> *) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec Distinctspec (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a. Distinctspec (Field_ n a) (Field_ n a)
Opaleye.distinctspecField


exprs :: Table Expr a => a -> NonEmpty Opaleye.PrimExpr
exprs :: a -> NonEmpty PrimExpr
exprs (a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = Const (NonEmpty PrimExpr) (Columns a Any) -> NonEmpty PrimExpr
forall a k (b :: k). Const a b -> a
getConst (Const (NonEmpty PrimExpr) (Columns a Any) -> NonEmpty PrimExpr)
-> Const (NonEmpty PrimExpr) (Columns a Any) -> NonEmpty PrimExpr
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns a) a -> Const (NonEmpty PrimExpr) (Any a))
-> Const (NonEmpty PrimExpr) (Columns a Any)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns a) a -> Const (NonEmpty PrimExpr) (Any a))
 -> Const (NonEmpty PrimExpr) (Columns a Any))
-> (forall a.
    HField (Columns a) a -> Const (NonEmpty PrimExpr) (Any a))
-> Const (NonEmpty PrimExpr) (Columns a Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns a) a
field ->
  case Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
as HField (Columns a) a
field of
    Expr a
expr -> NonEmpty PrimExpr -> Const (NonEmpty PrimExpr) (Any a)
forall k a (b :: k). a -> Const a b
Const (PrimExpr -> NonEmpty PrimExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
expr))


exprsWithNames :: Selects names exprs
  => names -> exprs -> NonEmpty (String, Opaleye.PrimExpr)
exprsWithNames :: names -> exprs -> NonEmpty (String, PrimExpr)
exprsWithNames names
names exprs
as = Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
-> NonEmpty (String, PrimExpr)
forall a k (b :: k). Const a b -> a
getConst (Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
 -> NonEmpty (String, PrimExpr))
-> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
-> NonEmpty (String, PrimExpr)
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns exprs) a
 -> Const (NonEmpty (String, PrimExpr)) (Any a))
-> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns exprs) a
  -> Const (NonEmpty (String, PrimExpr)) (Any a))
 -> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any))
-> (forall a.
    HField (Columns exprs) a
    -> Const (NonEmpty (String, PrimExpr)) (Any a))
-> Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
  case (Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns names
names) HField (Columns exprs) a
field, Columns exprs Expr -> HField (Columns exprs) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (exprs -> Columns exprs Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns exprs
as) HField (Columns exprs) a
field) of
    (Name String
name, Expr a
expr) -> NonEmpty (String, PrimExpr)
-> Const (NonEmpty (String, PrimExpr)) (Any a)
forall k a (b :: k). a -> Const a b
Const ((String, PrimExpr) -> NonEmpty (String, PrimExpr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
name, Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
expr))


table :: Selects names exprs => TableSchema names -> Opaleye.Table exprs exprs
table :: TableSchema names -> Table exprs exprs
table (TableSchema String
name Maybe String
schema names
columns) =
  case Maybe String
schema of
    Maybe String
Nothing -> String -> TableFields exprs exprs -> Table exprs exprs
forall writeFields viewFields.
String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.table String
name (names -> TableFields exprs exprs
forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields names
columns)
    Just String
schemaName -> String -> String -> TableFields exprs exprs -> Table exprs exprs
forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Opaleye.tableWithSchema String
schemaName String
name (names -> TableFields exprs exprs
forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields names
columns)


tableFields :: Selects names exprs
  => names -> Opaleye.TableFields exprs exprs
tableFields :: names -> TableFields exprs exprs
tableFields (names -> Columns names Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns -> Columns names Name
names) = (exprs -> Columns exprs Expr)
-> (Columns exprs Expr -> exprs)
-> TableFields (Columns exprs Expr) (Columns exprs Expr)
-> TableFields exprs exprs
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap exprs -> Columns exprs Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (TableFields (Columns exprs Expr) (Columns exprs Expr)
 -> TableFields exprs exprs)
-> TableFields (Columns exprs Expr) (Columns exprs Expr)
-> TableFields exprs exprs
forall a b. (a -> b) -> a -> b
$
  WrappedApplicative
  (TableFields (Columns exprs Expr)) (Columns exprs Expr)
-> TableFields (Columns exprs Expr) (Columns exprs Expr)
forall (f :: * -> *) a. WrappedApplicative f a -> f a
unwrapApplicative (WrappedApplicative
   (TableFields (Columns exprs Expr)) (Columns exprs Expr)
 -> TableFields (Columns exprs Expr) (Columns exprs Expr))
-> WrappedApplicative
     (TableFields (Columns exprs Expr)) (Columns exprs Expr)
-> TableFields (Columns exprs Expr) (Columns exprs Expr)
forall a b. (a -> b) -> a -> b
$ (forall a.
 HField (Columns exprs) a
 -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
-> WrappedApplicative
     (TableFields (Columns exprs Expr)) (Columns exprs Expr)
forall (t :: HTable) (m :: * -> *) (context :: * -> *).
(HTable t, Apply m) =>
(forall a. HField t a -> m (context a)) -> m (t context)
htabulateA ((forall a.
  HField (Columns exprs) a
  -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
 -> WrappedApplicative
      (TableFields (Columns exprs Expr)) (Columns exprs Expr))
-> (forall a.
    HField (Columns exprs) a
    -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
-> WrappedApplicative
     (TableFields (Columns exprs Expr)) (Columns exprs Expr)
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field -> TableFields (Columns exprs Expr) (Expr a)
-> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a)
forall (f :: * -> *) a. f a -> WrappedApplicative f a
WrapApplicative (TableFields (Columns exprs Expr) (Expr a)
 -> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a))
-> TableFields (Columns exprs Expr) (Expr a)
-> WrappedApplicative (TableFields (Columns exprs Expr)) (Expr a)
forall a b. (a -> b) -> a -> b
$
    case Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns names Name
Columns exprs Name
names HField (Columns exprs) a
field of
      Name a
name -> (Columns exprs Expr -> Expr a)
-> TableFields (Expr a) (Expr a)
-> TableFields (Columns exprs Expr) (Expr a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Columns exprs Expr -> HField (Columns exprs) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
`hfield` HField (Columns exprs) a
field) (Name a -> TableFields (Expr a) (Expr a)
forall a. Name a -> TableFields (Expr a) (Expr a)
go Name a
name)
  where
    go :: Name a -> Opaleye.TableFields (Expr a) (Expr a)
    go :: Name a -> TableFields (Expr a) (Expr a)
go (Name String
name) =
      TableFields (Field_ Any Any) (Field_ Any Any)
-> TableFields (Expr a) (Expr a)
forall (p :: * -> * -> *) (n :: Nullability) x (m :: Nullability) y
       a b.
Profunctor p =>
p (Field_ n x) (Field_ m y) -> p (Expr a) (Expr b)
traverseFieldP (TableFields (Field_ Any Any) (Field_ Any Any)
 -> TableFields (Expr a) (Expr a))
-> TableFields (Field_ Any Any) (Field_ Any Any)
-> TableFields (Expr a) (Expr a)
forall a b. (a -> b) -> a -> b
$
        String -> TableFields (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a.
String -> TableFields (Field_ n a) (Field_ n a)
Opaleye.requiredTableField String
name


unpackspec :: Table Expr a => Opaleye.Unpackspec a a
unpackspec :: Unpackspec a a
unpackspec = Unpackspec (Field_ Any Any) (Field_ Any Any) -> Unpackspec a a
forall (p :: * -> * -> *) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec Unpackspec (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
Opaleye.unpackspecField
{-# INLINABLE unpackspec #-}


valuesspec :: Table Expr a => Opaleye.Valuesspec a a
valuesspec :: Valuesspec a a
valuesspec = (a -> Columns a Expr)
-> (Columns a Expr -> a)
-> Valuesspec (Columns a Expr) (Columns a Expr)
-> Valuesspec a a
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Valuesspec (Columns a Expr) (Columns a Expr) -> Valuesspec a a)
-> Valuesspec (Columns a Expr) (Columns a Expr) -> Valuesspec a a
forall a b. (a -> b) -> a -> b
$
  (forall a. HField (Columns a) a -> Valuesspec (Expr a) (Expr a))
-> Valuesspec (Columns a Expr) (Columns a Expr)
forall (t :: HTable) (p :: * -> * -> *) (f :: * -> *)
       (g :: * -> *).
(HTable t, ProductProfunctor p) =>
(forall a. HField t a -> p (f a) (g a)) -> p (t f) (t g)
htraversePWithField (Valuesspec (Field_ Any Any) (Field_ Any Any)
-> Valuesspec (Expr a) (Expr a)
forall (p :: * -> * -> *) (n :: Nullability) x (m :: Nullability) y
       a b.
Profunctor p =>
p (Field_ n x) (Field_ m y) -> p (Expr a) (Expr b)
traverseFieldP (Valuesspec (Field_ Any Any) (Field_ Any Any)
 -> Valuesspec (Expr a) (Expr a))
-> (HField (Columns a) a
    -> Valuesspec (Field_ Any Any) (Field_ Any Any))
-> HField (Columns a) a
-> Valuesspec (Expr a) (Expr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Valuesspec (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a.
String -> Valuesspec (Field_ n a) (Field_ n a)
Opaleye.valuesspecFieldType (String -> Valuesspec (Field_ Any Any) (Field_ Any Any))
-> (HField (Columns a) a -> String)
-> HField (Columns a) a
-> Valuesspec (Field_ Any Any) (Field_ Any Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HField (Columns a) a -> String
forall a. HField (Columns a) a -> String
typeName)
  where typeName :: HField (Columns a) a -> String
typeName = TypeInformation (Unnullify' (IsMaybe a) a) -> String
forall a. TypeInformation a -> String
Rel8.Type.Information.typeName (TypeInformation (Unnullify' (IsMaybe a) a) -> String)
-> (HField (Columns a) a
    -> TypeInformation (Unnullify' (IsMaybe a) a))
-> HField (Columns a) a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec a -> TypeInformation (Unnullify' (IsMaybe a) a)
forall a. Spec a -> TypeInformation (Unnullify a)
info (Spec a -> TypeInformation (Unnullify' (IsMaybe a) a))
-> (HField (Columns a) a -> Spec a)
-> HField (Columns a) a
-> TypeInformation (Unnullify' (IsMaybe a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns a Spec -> HField (Columns a) a -> Spec a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Spec
forall (t :: HTable). HTable t => t Spec
hspecs


view :: Selects names exprs => names -> exprs
view :: names -> exprs
view names
columns = Columns exprs Expr -> exprs
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns exprs Expr -> exprs) -> Columns exprs Expr -> exprs
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate ((forall a. HField (Columns exprs) a -> Expr a)
 -> Columns exprs Expr)
-> (forall a. HField (Columns exprs) a -> Expr a)
-> Columns exprs Expr
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) a
field ->
  case Columns exprs Name -> HField (Columns exprs) a -> Name a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns names
columns) HField (Columns exprs) a
field of
    Name String
column -> PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a) -> PrimExpr -> Expr a
forall a b. (a -> b) -> a -> b
$ String -> PrimExpr
Opaleye.BaseTableAttrExpr String
column


-- | Transform a table by adding 'CAST' to all columns. This is most useful for
-- finalising a SELECT or RETURNING statement, guaranteed that the output
-- matches what is encoded in each columns TypeInformation.
castTable :: Table Expr a => a -> a
castTable :: a -> a
castTable (a -> Columns a Expr
forall (context :: * -> *) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = Columns a Expr -> a
forall (context :: * -> *) a.
Table context a =>
Columns a context -> a
fromColumns (Columns a Expr -> a) -> Columns a Expr -> a
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns a) a -> Expr a) -> Columns a Expr
forall (t :: HTable) (context :: * -> *).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate \HField (Columns a) a
field ->
  case Columns a Spec -> HField (Columns a) a -> Spec a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Spec
forall (t :: HTable). HTable t => t Spec
hspecs HField (Columns a) a
field of
    Spec {TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info :: forall a. Spec a -> TypeInformation (Unnullify a)
info} -> case Columns a Expr -> HField (Columns a) a -> Expr a
forall (t :: HTable) (context :: * -> *) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a Expr
as HField (Columns a) a
field of
        Expr a
expr -> TypeInformation (Unnullify a) -> Expr a -> Expr a
forall a. TypeInformation (Unnullify a) -> Expr a -> Expr a
scastExpr TypeInformation (Unnullify a)
info Expr a
expr