{-# language DataKinds #-}

module Rel8.Query.Exists
  ( exists, inQuery
  , present, with, withBy
  , absent, without, withoutBy
  )
where

-- base
import Prelude hiding ( filter )

-- opaleye
import qualified Opaleye.Exists as Opaleye
import qualified Opaleye.Operators as Opaleye

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr )
import Rel8.Query ( Query )
import Rel8.Query.Filter ( filter )
import Rel8.Query.Opaleye ( mapOpaleye )
import Rel8.Table.Eq ( EqTable, (==:) )


-- | Checks if a query returns at least one row.
exists :: Query a -> Query (Expr Bool)
exists :: Query a -> Query (Expr Bool)
exists = (Field_ 'NonNullable SqlBool -> Expr Bool)
-> Query (Field_ 'NonNullable SqlBool) -> Query (Expr Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrimExpr -> Expr Bool
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr Bool)
-> (Field_ 'NonNullable SqlBool -> PrimExpr)
-> Field_ 'NonNullable SqlBool
-> Expr Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field_ 'NonNullable SqlBool -> PrimExpr
forall (n :: Nullability) b. Field_ n b -> PrimExpr
fromColumn) (Query (Field_ 'NonNullable SqlBool) -> Query (Expr Bool))
-> (Query a -> Query (Field_ 'NonNullable SqlBool))
-> Query a
-> Query (Expr Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Select a -> Select (Field_ 'NonNullable SqlBool))
-> Query a -> Query (Field_ 'NonNullable SqlBool)
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye Select a -> Select (Field_ 'NonNullable SqlBool)
forall a. Select a -> Select (Field_ 'NonNullable SqlBool)
Opaleye.exists


inQuery :: EqTable a => a -> Query a -> Query (Expr Bool)
inQuery :: a -> Query a -> Query (Expr Bool)
inQuery a
a = Query a -> Query (Expr Bool)
forall a. Query a -> Query (Expr Bool)
exists (Query a -> Query (Expr Bool))
-> (Query a -> Query a) -> Query a -> Query (Expr Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query a -> (a -> Query a) -> Query a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Expr Bool) -> a -> Query a
forall a. (a -> Expr Bool) -> a -> Query a
filter (a
a a -> a -> Expr Bool
forall a. EqTable a => a -> a -> Expr Bool
==:))


-- | Produce the empty query if the given query returns no rows. @present@
-- is equivalent to @WHERE EXISTS@ in SQL.
present :: Query a -> Query ()
present :: Query a -> Query ()
present = (Select a -> Select ()) -> Query a -> Query ()
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye Select a -> Select ()
forall a b. SelectArr a b -> SelectArr a ()
Opaleye.restrictExists


-- | Produce the empty query if the given query returns rows. @absent@
-- is equivalent to @WHERE NOT EXISTS@ in SQL.
absent :: Query a -> Query ()
absent :: Query a -> Query ()
absent = (Select a -> Select ()) -> Query a -> Query ()
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye Select a -> Select ()
forall a b. SelectArr a b -> SelectArr a ()
Opaleye.restrictNotExists


-- | @with@ is similar to 'filter', but allows the predicate to be a full query.
--
-- @with f a = a <$ present (f a)@, but this form matches 'filter'.
with :: (a -> Query b) -> a -> Query a
with :: (a -> Query b) -> a -> Query a
with a -> Query b
f a
a = a
a a -> Query () -> Query a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Query b -> Query ()
forall a. Query a -> Query ()
present (a -> Query b
f a
a)


-- | Like @with@, but with a custom membership test.
withBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a
withBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a
withBy a -> b -> Expr Bool
predicate Query b
bs = (a -> Query b) -> a -> Query a
forall a b. (a -> Query b) -> a -> Query a
with ((a -> Query b) -> a -> Query a) -> (a -> Query b) -> a -> Query a
forall a b. (a -> b) -> a -> b
$ \a
a -> Query b
bs Query b -> (b -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> Expr Bool) -> b -> Query b
forall a. (a -> Expr Bool) -> a -> Query a
filter (a -> b -> Expr Bool
predicate a
a)


-- | Filter rows where @a -> Query b@ yields no rows.
without :: (a -> Query b) -> a -> Query a
without :: (a -> Query b) -> a -> Query a
without a -> Query b
f a
a = a
a a -> Query () -> Query a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Query b -> Query ()
forall a. Query a -> Query ()
absent (a -> Query b
f a
a)


-- | Like @without@, but with a custom membership test.
withoutBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a
withoutBy :: (a -> b -> Expr Bool) -> Query b -> a -> Query a
withoutBy a -> b -> Expr Bool
predicate Query b
bs = (a -> Query b) -> a -> Query a
forall a b. (a -> Query b) -> a -> Query a
without ((a -> Query b) -> a -> Query a) -> (a -> Query b) -> a -> Query a
forall a b. (a -> b) -> a -> b
$ \a
a -> Query b
bs Query b -> (b -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> Expr Bool) -> b -> Query b
forall a. (a -> Expr Bool) -> a -> Query a
filter (a -> b -> Expr Bool
predicate a
a)