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

composite functions
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , FlexibleContexts
  , FlexibleInstances
  , MultiParamTypeClasses
  , OverloadedLabels
  , OverloadedStrings
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Expression.Composite
  ( -- * Composite Functions
    row
  , rowStar
  , field
  ) where

import qualified Generics.SOP as SOP

import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL

-- | A row constructor is an expression that builds a row value
-- (also called a composite value) using values for its member fields.
--
-- >>> :{
-- type Complex = 'PGcomposite
--   '[ "real"      ::: 'NotNull 'PGfloat8
--    , "imaginary" ::: 'NotNull 'PGfloat8 ]
-- :}
--
-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression grp lat with db params from ('NotNull Complex)
-- >>> printSQL i
-- ROW((0.0 :: float8), (1.0 :: float8))
row
  :: SOP.SListI row
  => NP (Aliased (Expression grp lat with db params from)) row
  -- ^ zero or more expressions for the row field values
  -> Expression grp lat with db params from (null ('PGcomposite row))
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)) row
exprs = ByteString
-> Expression grp lat with db params from (null ('PGcomposite row))
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 ('PGcomposite row)))
-> ByteString
-> Expression grp lat with db params from (null ('PGcomposite row))
forall a b. (a -> b) -> a -> b
$ ByteString
"ROW" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
parenthesized
  ((forall (x :: (Symbol, NullType)).
 Aliased (Expression grp lat with db params from) x -> ByteString)
-> NP (Aliased (Expression grp lat with db params from)) row
-> ByteString
forall k (xs :: [k]) (expression :: k -> *).
SListI xs =>
(forall (x :: k). expression x -> ByteString)
-> NP expression xs -> ByteString
renderCommaSeparated (\ (expr `As` _) -> Expression grp lat with db params from ty -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ty
expr) NP (Aliased (Expression grp lat with db params from)) row
exprs)

-- | A row constructor on all columns in a table expression.
rowStar
  :: Has tab from row
  => Alias tab -- ^ intermediate table
  -> Expression grp lat with db params from (null ('PGcomposite row))
rowStar :: Alias tab
-> Expression grp lat with db params from (null ('PGcomposite row))
rowStar Alias tab
tab = ByteString
-> Expression grp lat with db params from (null ('PGcomposite row))
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 ('PGcomposite row)))
-> ByteString
-> Expression grp lat with db params from (null ('PGcomposite row))
forall a b. (a -> b) -> a -> b
$ ByteString
"ROW" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> ByteString
parenthesized (Alias tab -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias tab
tab ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".*")

-- | >>> :{
-- type Complex = 'PGcomposite
--   '[ "real"      ::: 'NotNull 'PGfloat8
--    , "imaginary" ::: 'NotNull 'PGfloat8 ]
-- type Schema = '["complex" ::: 'Typedef Complex]
-- :}
--
-- >>> let i = row (0 `as` #real :* 1 `as` #imaginary) :: Expression lat '[] grp (Public Schema) from params ('NotNull Complex)
-- >>> printSQL $ i & field #complex #imaginary
-- (ROW((0.0 :: float8), (1.0 :: float8))::"complex")."imaginary"
field
  :: ( Has sch db schema
     , Has tydef schema ('Typedef ('PGcomposite row))
     , Has field row ty)
  => QualifiedAlias sch tydef -- ^ row type
  -> Alias field -- ^ field name
  -> Expression grp lat with db params from ('NotNull ('PGcomposite row))
  -> Expression grp lat with db params from ty
field :: QualifiedAlias sch tydef
-> Alias field
-> Expression
     grp lat with db params from ('NotNull ('PGcomposite row))
-> Expression grp lat with db params from ty
field QualifiedAlias sch tydef
td Alias field
fld Expression
  grp lat with db params from ('NotNull ('PGcomposite row))
expr = ByteString -> Expression grp lat with db params from ty
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 ty)
-> ByteString -> Expression grp lat with db params from ty
forall a b. (a -> b) -> a -> b
$
  ByteString -> ByteString
parenthesized (Expression
  grp lat with db params from ('NotNull ('PGcomposite row))
-> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression
  grp lat with db params from ('NotNull ('PGcomposite row))
expr ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"::" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> QualifiedAlias sch tydef -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL QualifiedAlias sch tydef
td)
    ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Alias field -> ByteString
forall sql. RenderSQL sql => sql -> ByteString
renderSQL Alias field
fld