module Opaleye.Exists (exists) where

import           Opaleye.Field (Field)
import           Opaleye.Internal.Column (Field_(Column))
import           Opaleye.Internal.QueryArr (productQueryArr, runSimpleSelect)
import           Opaleye.Internal.PackMap (run, extractAttr)
import           Opaleye.Internal.PrimQuery (PrimQuery' (Exists))
import           Opaleye.Internal.Tag (fresh)
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 :: forall a. Select a -> Select (Field SqlBool)
exists Select a
q = forall a. State Tag (a, PrimQuery) -> Query a
productQueryArr forall a b. (a -> b) -> a -> b
$ do
  (a
_, PrimQuery
query) <- forall a. Select a -> State Tag (a, PrimQuery)
runSimpleSelect Select a
q
  Tag
tag <- State Tag Tag
fresh
  let (PrimExpr
result, [(Symbol
binding, ())]) = forall a r. PM [a] r -> (r, [a])
run (forall primExpr.
String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
extractAttr String
"exists" Tag
tag ())
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
Column PrimExpr
result, forall a. Symbol -> PrimQuery' a -> PrimQuery' a
Exists Symbol
binding PrimQuery
query)