{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}
module Rel8.Query.Maybe
( optional
, catMaybeTable
, traverseMaybeTable
)
where
import Prelude
import Control.Comonad ( extract )
import qualified Opaleye.Internal.MaybeFields as Opaleye
import Rel8.Expr ( Expr )
import Rel8.Expr.Eq ( (==.) )
import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr )
import Rel8.Query ( Query )
import Rel8.Query.Filter ( where_ )
import Rel8.Query.Opaleye ( mapOpaleye )
import Rel8.Table.Maybe ( MaybeTable(..), isJustTable )
optional :: Query a -> Query (MaybeTable Expr a)
optional :: forall a. Query a -> Query (MaybeTable Expr a)
optional = forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye forall a b. (a -> b) -> a -> b
$ forall a r.
(FieldNullable SqlBool -> a -> r) -> Select a -> Select r
Opaleye.optionalInternal forall a b. (a -> b) -> a -> b
$ \FieldNullable SqlBool
tag a
a -> MaybeTable
{ tag :: Expr (Maybe MaybeTag)
tag = forall a. PrimExpr -> Expr a
fromPrimExpr forall a b. (a -> b) -> a -> b
$ forall (n :: Nullability) b. Field_ n b -> PrimExpr
fromColumn FieldNullable SqlBool
tag
, just :: Nullify Expr a
just = forall (f :: Context) a. Applicative f => a -> f a
pure a
a
}
catMaybeTable :: MaybeTable Expr a -> Query a
catMaybeTable :: forall a. MaybeTable Expr a -> Query a
catMaybeTable ma :: MaybeTable Expr a
ma@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr a
a) = do
Expr Bool -> Query ()
where_ forall a b. (a -> b) -> a -> b
$ forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr a
ma
forall (f :: Context) a. Applicative f => a -> f a
pure (forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr a
a)
traverseMaybeTable :: (a -> Query b) -> MaybeTable Expr a -> Query (MaybeTable Expr b)
traverseMaybeTable :: forall a b.
(a -> Query b) -> MaybeTable Expr a -> Query (MaybeTable Expr b)
traverseMaybeTable a -> Query b
query ma :: MaybeTable Expr a
ma@(MaybeTable Expr (Maybe MaybeTag)
input Nullify Expr a
_) = do
forall a. Query a -> Query (MaybeTable Expr a)
optional (a -> Query b
query forall (m :: Context) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. MaybeTable Expr a -> Query a
catMaybeTable MaybeTable Expr a
ma) forall (m :: Context) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
MaybeTable Expr (Maybe MaybeTag)
output Nullify Expr b
b -> do
Expr Bool -> Query ()
where_ forall a b. (a -> b) -> a -> b
$ Expr (Maybe MaybeTag)
output forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. Expr (Maybe MaybeTag)
input
forall (f :: Context) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable Expr (Maybe MaybeTag)
input Nullify Expr b
b