module Opaleye.Exists (exists) where

import           Opaleye.Field (Field)
import           Opaleye.Internal.Column (Column (Column))
import           Opaleye.Internal.QueryArr (runSimpleQueryArr, productQueryArr)
import           Opaleye.Internal.PackMap (run, extractAttr)
import           Opaleye.Internal.PrimQuery (PrimQuery' (Exists))
import           Opaleye.Internal.Tag (next)
import           Opaleye.Select (Select)
import           Opaleye.SqlTypes (SqlBool)

-- | True if any rows are returned by the given query, false otherwise.
--
-- This operation is equivalent to Postgres's @EXISTS@ operator.
exists :: Select a -> Select (Field SqlBool)
exists :: Select a -> Select (Field SqlBool)
exists Select a
q = (((), Tag) -> (Column SqlBool, PrimQuery, Tag))
-> QueryArr () (Column SqlBool)
forall a b. ((a, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
productQueryArr ((a, PrimQuery, Tag) -> (Column SqlBool, PrimQuery, Tag)
forall a a pgType.
(a, PrimQuery' a, Tag) -> (Column pgType, PrimQuery' a, Tag)
f ((a, PrimQuery, Tag) -> (Column SqlBool, PrimQuery, Tag))
-> (((), Tag) -> (a, PrimQuery, Tag))
-> ((), Tag)
-> (Column SqlBool, PrimQuery, Tag)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select a -> ((), Tag) -> (a, PrimQuery, Tag)
forall a b. QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
runSimpleQueryArr Select a
q)
  where
    f :: (a, PrimQuery' a, Tag) -> (Column pgType, PrimQuery' a, Tag)
f (a
_, PrimQuery' a
query, Tag
tag) = (PrimExpr -> Column pgType
forall pgType. PrimExpr -> Column pgType
Column PrimExpr
result, Symbol -> PrimQuery' a -> PrimQuery' a
forall a. Symbol -> PrimQuery' a -> PrimQuery' a
Exists Symbol
binding PrimQuery' a
query, Tag
tag')
      where
        (PrimExpr
result, [(Symbol
binding, ())]) = PM [(Symbol, ())] PrimExpr -> (PrimExpr, [(Symbol, ())])
forall a r. PM [a] r -> (r, [a])
run (String -> Tag -> () -> PM [(Symbol, ())] PrimExpr
forall primExpr.
String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
extractAttr String
"exists" Tag
tag ())
        tag' :: Tag
tag' = Tag -> Tag
next Tag
tag