-- |
-- AST traversal extracting output types.
module Hasql.TH.Extraction.OutputTypeList where

import Hasql.TH.Prelude
import PostgresqlSyntax.Ast

foldable :: Foldable f => (a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable :: (a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable a -> Either Text [Typename]
fn = ([[Typename]] -> [Typename])
-> Either Text [[Typename]] -> Either Text [Typename]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Typename]] -> [Typename]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either Text [[Typename]] -> Either Text [Typename])
-> (f a -> Either Text [[Typename]])
-> f a
-> Either Text [Typename]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Either Text [Typename]) -> [a] -> Either Text [[Typename]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Either Text [Typename]
fn ([a] -> Either Text [[Typename]])
-> (f a -> [a]) -> f a -> Either Text [[Typename]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

preparableStmt :: PreparableStmt -> Either Text [Typename]
preparableStmt = \case
  SelectPreparableStmt SelectStmt
a -> SelectStmt -> Either Text [Typename]
selectStmt SelectStmt
a
  InsertPreparableStmt InsertStmt
a -> InsertStmt -> Either Text [Typename]
insertStmt InsertStmt
a
  UpdatePreparableStmt UpdateStmt
a -> UpdateStmt -> Either Text [Typename]
updateStmt UpdateStmt
a
  DeletePreparableStmt DeleteStmt
a -> DeleteStmt -> Either Text [Typename]
deleteStmt DeleteStmt
a
  CallPreparableStmt CallStmt
a -> CallStmt -> Either Text [Typename]
forall a b. IsString a => CallStmt -> Either a b
callStmt CallStmt
a

-- * Call

callStmt :: CallStmt -> Either a b
callStmt (CallStmt FuncApplication
a) =
  a -> Either a b
forall a b. a -> Either a b
Left a
"CALL statement is not supported. Use SELECT function_name()"

-- * Insert

insertStmt :: InsertStmt -> Either Text [Typename]
insertStmt (InsertStmt Maybe WithClause
a InsertTarget
b InsertRest
c Maybe OnConflict
d Maybe ReturningClause
e) = (ReturningClause -> Either Text [Typename])
-> Maybe ReturningClause -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable ReturningClause -> Either Text [Typename]
forall (f :: * -> *).
Foldable f =>
f TargetEl -> Either Text [Typename]
returningClause Maybe ReturningClause
e

returningClause :: f TargetEl -> Either Text [Typename]
returningClause = f TargetEl -> Either Text [Typename]
forall (f :: * -> *).
Foldable f =>
f TargetEl -> Either Text [Typename]
targetList

-- * Update

updateStmt :: UpdateStmt -> Either Text [Typename]
updateStmt (UpdateStmt Maybe WithClause
_ RelationExprOptAlias
_ SetClauseList
_ Maybe FromClause
_ Maybe WhereOrCurrentClause
_ Maybe ReturningClause
a) = (ReturningClause -> Either Text [Typename])
-> Maybe ReturningClause -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable ReturningClause -> Either Text [Typename]
forall (f :: * -> *).
Foldable f =>
f TargetEl -> Either Text [Typename]
returningClause Maybe ReturningClause
a

-- * Delete

deleteStmt :: DeleteStmt -> Either Text [Typename]
deleteStmt (DeleteStmt Maybe WithClause
_ RelationExprOptAlias
_ Maybe FromClause
_ Maybe WhereOrCurrentClause
_ Maybe ReturningClause
a) = (ReturningClause -> Either Text [Typename])
-> Maybe ReturningClause -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable ReturningClause -> Either Text [Typename]
forall (f :: * -> *).
Foldable f =>
f TargetEl -> Either Text [Typename]
returningClause Maybe ReturningClause
a

-- * Select

selectStmt :: SelectStmt -> Either Text [Typename]
selectStmt = \case
  Left SelectNoParens
a -> SelectNoParens -> Either Text [Typename]
selectNoParens SelectNoParens
a
  Right SelectWithParens
a -> SelectWithParens -> Either Text [Typename]
selectWithParens SelectWithParens
a

selectNoParens :: SelectNoParens -> Either Text [Typename]
selectNoParens (SelectNoParens Maybe WithClause
_ SelectClause
a Maybe SortClause
_ Maybe SelectLimit
_ Maybe ForLockingClause
_) = SelectClause -> Either Text [Typename]
selectClause SelectClause
a

selectWithParens :: SelectWithParens -> Either Text [Typename]
selectWithParens = \case
  NoParensSelectWithParens SelectNoParens
a -> SelectNoParens -> Either Text [Typename]
selectNoParens SelectNoParens
a
  WithParensSelectWithParens SelectWithParens
a -> SelectWithParens -> Either Text [Typename]
selectWithParens SelectWithParens
a

selectClause :: SelectClause -> Either Text [Typename]
selectClause = (SimpleSelect -> Either Text [Typename])
-> (SelectWithParens -> Either Text [Typename])
-> SelectClause
-> Either Text [Typename]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SimpleSelect -> Either Text [Typename]
simpleSelect SelectWithParens -> Either Text [Typename]
selectWithParens

simpleSelect :: SimpleSelect -> Either Text [Typename]
simpleSelect = \case
  NormalSimpleSelect Maybe Targeting
a Maybe IntoClause
_ Maybe FromClause
_ Maybe WhereClause
_ Maybe GroupClause
_ Maybe WhereClause
_ Maybe WindowClause
_ -> (Targeting -> Either Text [Typename])
-> Maybe Targeting -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable Targeting -> Either Text [Typename]
targeting Maybe Targeting
a
  ValuesSimpleSelect ValuesClause
a -> ValuesClause -> Either Text [Typename]
forall (f :: * -> *) (f :: * -> *).
(Foldable f, Foldable f) =>
f (f WhereClause) -> Either Text [Typename]
valuesClause ValuesClause
a
  TableSimpleSelect RelationExpr
_ -> Text -> Either Text [Typename]
forall a b. a -> Either a b
Left Text
"TABLE cannot be used as a final statement, since it's impossible to specify the output types"
  BinSimpleSelect SelectBinOp
_ SelectClause
a Maybe Bool
_ SelectClause
b -> do
    [Typename]
c <- SelectClause -> Either Text [Typename]
selectClause SelectClause
a
    [Typename]
d <- SelectClause -> Either Text [Typename]
selectClause SelectClause
b
    if [Typename]
c [Typename] -> [Typename] -> Bool
forall a. Eq a => a -> a -> Bool
== [Typename]
d
      then [Typename] -> Either Text [Typename]
forall (m :: * -> *) a. Monad m => a -> m a
return [Typename]
c
      else Text -> Either Text [Typename]
forall a b. a -> Either a b
Left Text
"Merged queries produce results of incompatible types"

targeting :: Targeting -> Either Text [Typename]
targeting = \case
  NormalTargeting ReturningClause
a -> ReturningClause -> Either Text [Typename]
forall (f :: * -> *).
Foldable f =>
f TargetEl -> Either Text [Typename]
targetList ReturningClause
a
  AllTargeting Maybe ReturningClause
a -> (ReturningClause -> Either Text [Typename])
-> Maybe ReturningClause -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable ReturningClause -> Either Text [Typename]
forall (f :: * -> *).
Foldable f =>
f TargetEl -> Either Text [Typename]
targetList Maybe ReturningClause
a
  DistinctTargeting Maybe ExprList
_ ReturningClause
b -> ReturningClause -> Either Text [Typename]
forall (f :: * -> *).
Foldable f =>
f TargetEl -> Either Text [Typename]
targetList ReturningClause
b

targetList :: f TargetEl -> Either Text [Typename]
targetList = (TargetEl -> Either Text [Typename])
-> f TargetEl -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable TargetEl -> Either Text [Typename]
forall a. IsString a => TargetEl -> Either a [Typename]
targetEl

targetEl :: TargetEl -> Either a [Typename]
targetEl = \case
  AliasedExprTargetEl WhereClause
a Ident
_ -> WhereClause -> Either a [Typename]
forall a. IsString a => WhereClause -> Either a [Typename]
aExpr WhereClause
a
  ImplicitlyAliasedExprTargetEl WhereClause
a Ident
_ -> WhereClause -> Either a [Typename]
forall a. IsString a => WhereClause -> Either a [Typename]
aExpr WhereClause
a
  ExprTargetEl WhereClause
a -> WhereClause -> Either a [Typename]
forall a. IsString a => WhereClause -> Either a [Typename]
aExpr WhereClause
a
  TargetEl
AsteriskTargetEl ->
    a -> Either a [Typename]
forall a b. a -> Either a b
Left
      a
"Target of all fields is not allowed, \
      \because it leaves the output types unspecified. \
      \You have to be specific."

valuesClause :: f (f WhereClause) -> Either Text [Typename]
valuesClause = (f WhereClause -> Either Text [Typename])
-> f (f WhereClause) -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable ((WhereClause -> Either Text [Typename])
-> f WhereClause -> Either Text [Typename]
forall (f :: * -> *) a.
Foldable f =>
(a -> Either Text [Typename]) -> f a -> Either Text [Typename]
foldable WhereClause -> Either Text [Typename]
forall a. IsString a => WhereClause -> Either a [Typename]
aExpr)

aExpr :: WhereClause -> Either a [Typename]
aExpr = \case
  CExprAExpr CExpr
a -> CExpr -> Either a [Typename]
cExpr CExpr
a
  TypecastAExpr WhereClause
_ Typename
a -> [Typename] -> Either a [Typename]
forall a b. b -> Either a b
Right [Typename
a]
  WhereClause
a -> a -> Either a [Typename]
forall a b. a -> Either a b
Left a
"Result expression is missing a typecast"

cExpr :: CExpr -> Either a [Typename]
cExpr = \case
  InParensCExpr WhereClause
a Maybe Indirection
Nothing -> WhereClause -> Either a [Typename]
aExpr WhereClause
a
  CExpr
a -> a -> Either a [Typename]
forall a b. a -> Either a b
Left a
"Result expression is missing a typecast"