module Opaleye.Exists (exists) where

import           Opaleye.Field (Field)
import           Opaleye.Internal.Column (Field_(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) -> (Field SqlBool, PrimQuery, Tag))
-> Select (Field SqlBool)
forall a b. ((a, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
productQueryArr ((a, PrimQuery, Tag) -> (Field SqlBool, PrimQuery, Tag)
forall a a (n :: Nullability) sqlType.
(a, PrimQuery' a, Tag) -> (Field_ n sqlType, PrimQuery' a, Tag)
f ((a, PrimQuery, Tag) -> (Field SqlBool, PrimQuery, Tag))
-> (((), Tag) -> (a, PrimQuery, Tag))
-> ((), Tag)
-> (Field 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) -> (Field_ n sqlType, PrimQuery' a, Tag)
f (a
_, PrimQuery' a
query, Tag
tag) = (PrimExpr -> Field_ n sqlType
forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
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