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

{-# options_ghc -Wno-deprecations #-}

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

-- base
import Data.Foldable (traverse_)
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.HaskellDB.PrimQuery as Opaleye
import qualified Opaleye.Internal.Operators as Opaleye
import qualified Opaleye.Internal.Order as Opaleye
import qualified Opaleye.Internal.PackMap as Opaleye
import qualified Opaleye.Internal.Unpackspec as Opaleye
import qualified Opaleye.Internal.Values as Opaleye
import qualified Opaleye.Table as Opaleye

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

-- rel8
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.QualifiedName (QualifiedName (QualifiedName))
import Rel8.Schema.Spec ( Spec(..) )
import Rel8.Schema.Table ( TableSchema(..), ppTable )
import Rel8.Table ( Table, fromColumns, toColumns )
import Rel8.Type.Information ( typeName )
import Rel8.Type.Name (showTypeName)

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


attributes :: Selects names exprs => TableSchema names -> exprs
attributes :: forall names exprs.
Selects names exprs =>
TableSchema names -> exprs
attributes schema :: TableSchema names
schema@TableSchema {names
columns :: names
$sel:columns:TableSchema :: forall names. TableSchema names -> names
columns} = Columns exprs Expr -> exprs
forall (context :: 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 (context :: Context).
(forall a. HField (Columns exprs) a -> context a)
-> Columns exprs context
forall (t :: HTable) (context :: 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 (context :: Context) a.
Columns exprs context -> HField (Columns exprs) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: 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 :: forall (p :: * -> Context) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
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 a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns Columns a Expr -> a
forall (context :: 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 :: * -> Context) (f :: Context)
       (g :: Context).
(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 :: * -> Context) (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 :: forall a. Table Expr a => Binaryspec a a
binaryspec = Binaryspec (Field_ Any Any) (Field_ Any Any) -> Binaryspec a a
forall (p :: * -> Context) 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 :: forall a. Table Expr a => Distinctspec a a
distinctspec = Distinctspec (Field_ Any Any) (Field_ Any Any) -> Distinctspec a a
forall (p :: * -> Context) 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 :: forall a. Table Expr a => a -> NonEmpty PrimExpr
exprs (a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = Const (NonEmpty PrimExpr) (Columns a Any) -> NonEmpty PrimExpr
forall {k} a (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) (context :: 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 (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: 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 a. a -> NonEmpty a
forall (f :: Context) 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 :: forall names exprs.
Selects names exprs =>
names -> exprs -> NonEmpty (String, PrimExpr)
exprsWithNames names
names exprs
as = Const (NonEmpty (String, PrimExpr)) (Columns exprs Any)
-> NonEmpty (String, PrimExpr)
forall {k} a (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) (context :: 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 (context :: Context) a.
Columns exprs context -> HField (Columns exprs) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: 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 (context :: Context) a.
Columns exprs context -> HField (Columns exprs) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (exprs -> Columns exprs Expr
forall (context :: 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 a. a -> NonEmpty a
forall (f :: Context) a. Applicative f => a -> f a
pure (String
name, Expr a -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr a
expr))


ifPP :: Table Expr a => Opaleye.IfPP a a
ifPP :: forall a. Table Expr a => IfPP a a
ifPP = IfPP (Field_ Any Any) (Field_ Any Any) -> IfPP a a
forall (p :: * -> Context) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec IfPP (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a. IfPP (Field_ n a) (Field_ n a)
Opaleye.ifPPField


relExprPP :: Table Expr a => Opaleye.RelExprPP a a
relExprPP :: forall a. Table Expr a => RelExprPP a a
relExprPP = RelExprPP (Field_ Any Any) (Field_ Any Any) -> RelExprPP a a
forall (p :: * -> Context) a (n :: Nullability) x.
(ProductProfunctor p, Table Expr a) =>
p (Field_ n x) (Field_ n x) -> p a a
fromOpaleyespec RelExprPP (Field_ Any Any) (Field_ Any Any)
forall (n :: Nullability) a. RelExprPP (Field_ n a) (Field_ n a)
Opaleye.relExprColumn


table :: Selects names exprs => TableSchema names -> Opaleye.Table exprs exprs
table :: forall names exprs.
Selects names exprs =>
TableSchema names -> Table exprs exprs
table (TableSchema (QualifiedName 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 :: forall names exprs.
Selects names exprs =>
names -> TableFields exprs exprs
tableFields (names -> Columns names Name
forall (context :: 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 a b c d.
(a -> b) -> (c -> d) -> TableFields b c -> TableFields a d
forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap exprs -> Columns exprs Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns Columns exprs Expr -> exprs
forall (context :: 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 :: Context) 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) (context :: 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 :: Context) 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 (context :: Context) a.
Columns exprs context -> HField (Columns exprs) a -> context a
forall (t :: HTable) (context :: 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 a b c. (a -> b) -> TableFields b c -> TableFields a c
forall (p :: * -> Context) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Columns exprs Expr -> HField (Columns exprs) a -> Expr a
forall (context :: Context) a.
Columns exprs context -> HField (Columns exprs) a -> context a
forall (t :: HTable) (context :: 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 :: forall a. 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 :: * -> Context) (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 :: forall a. Table Expr a => Unpackspec a a
unpackspec = Unpackspec (Field_ Any Any) (Field_ Any Any) -> Unpackspec a a
forall (p :: * -> Context) 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 :: forall a. Table Expr a => Valuesspec a a
valuesspec = (a -> Columns a Expr)
-> (Columns a Expr -> a)
-> Valuesspec (Columns a Expr) (Columns a Expr)
-> Valuesspec a a
forall a b c d.
(a -> b) -> (c -> d) -> Valuesspec b c -> Valuesspec a d
forall (p :: * -> Context) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns Columns a Expr -> a
forall (context :: 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 :: * -> Context) (f :: Context)
       (g :: Context).
(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 :: * -> Context) (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 = TypeName -> String
showTypeName (TypeName -> String)
-> (HField (Columns a) a -> TypeName)
-> HField (Columns a) a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeInformation (Unnullify' (IsMaybe a) a) -> TypeName
forall a. TypeInformation a -> TypeName
Rel8.Type.Information.typeName (TypeInformation (Unnullify' (IsMaybe a) a) -> TypeName)
-> (HField (Columns a) a
    -> TypeInformation (Unnullify' (IsMaybe a) a))
-> HField (Columns a) a
-> TypeName
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 (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: 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 :: forall names exprs. Selects names exprs => names -> exprs
view names
columns = Columns exprs Expr -> exprs
forall (context :: 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 (context :: Context).
(forall a. HField (Columns exprs) a -> context a)
-> Columns exprs context
forall (t :: HTable) (context :: 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 (context :: Context) a.
Columns exprs context -> HField (Columns exprs) a -> context a
forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield (names -> Columns names Name
forall (context :: 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 :: forall a. Table Expr a => a -> a
castTable (a -> Columns a Expr
forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns -> Columns a Expr
as) = Columns a Expr -> a
forall (context :: 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 (context :: Context).
(forall a. HField (Columns a) a -> context a) -> Columns a context
forall (t :: HTable) (context :: 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 (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: 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 :: forall a. Spec a -> TypeInformation (Unnullify a)
info :: TypeInformation (Unnullify a)
info} -> case Columns a Expr -> HField (Columns a) a -> Expr a
forall (context :: Context) a.
Columns a context -> HField (Columns a) a -> context a
forall (t :: HTable) (context :: 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


fromOrder :: Opaleye.Order a -> Opaleye.Unpackspec a a
fromOrder :: forall a. Order a -> Unpackspec a a
fromOrder (Opaleye.Order a -> [(OrderOp, PrimExpr)]
o) =
  PackMap PrimExpr PrimExpr a a -> Unpackspec a a
forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Opaleye.Unpackspec (PackMap PrimExpr PrimExpr a a -> Unpackspec a a)
-> PackMap PrimExpr PrimExpr a a -> Unpackspec a a
forall a b. (a -> b) -> a -> b
$ (forall (f :: Context).
 Applicative f =>
 (PrimExpr -> f PrimExpr) -> a -> f a)
-> PackMap PrimExpr PrimExpr a a
forall a b s t.
(forall (f :: Context). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
Opaleye.PackMap ((forall (f :: Context).
  Applicative f =>
  (PrimExpr -> f PrimExpr) -> a -> f a)
 -> PackMap PrimExpr PrimExpr a a)
-> (forall (f :: Context).
    Applicative f =>
    (PrimExpr -> f PrimExpr) -> a -> f a)
-> PackMap PrimExpr PrimExpr a a
forall a b. (a -> b) -> a -> b
$ \PrimExpr -> f PrimExpr
f a
a ->
    a
a a -> f () -> f a
forall a b. a -> f b -> f a
forall (f :: Context) a b. Functor f => a -> f b -> f a
<$ ((OrderOp, PrimExpr) -> f PrimExpr)
-> [(OrderOp, PrimExpr)] -> f ()
forall (t :: Context) (f :: Context) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (PrimExpr -> f PrimExpr
f (PrimExpr -> f PrimExpr)
-> ((OrderOp, PrimExpr) -> PrimExpr)
-> (OrderOp, PrimExpr)
-> f PrimExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OrderOp, PrimExpr) -> PrimExpr
forall a b. (a, b) -> b
snd) (a -> [(OrderOp, PrimExpr)]
o a
a)