{-# language GADTs #-}
{-# language LambdaCase #-}
{-# language NamedFieldPuns #-}

module Rel8.Query.Maybe
  ( optional
  , catMaybeTable
  , traverseMaybeTable
  )
where

-- base
import Prelude

-- comonad
import Control.Comonad ( extract )

-- opaleye
import qualified Opaleye.Internal.MaybeFields as Opaleye

-- rel8
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 )


-- | Convert a query that might return zero rows to a query that always returns
-- at least one row.
--
-- To speak in more concrete terms, 'optional' is most useful to write @LEFT
-- JOIN@s.
optional :: Query a -> Query (MaybeTable Expr a)
optional :: Query a -> Query (MaybeTable Expr a)
optional = (Select a -> Select (MaybeTable Expr a))
-> Query a -> Query (MaybeTable Expr a)
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye ((Select a -> Select (MaybeTable Expr a))
 -> Query a -> Query (MaybeTable Expr a))
-> (Select a -> Select (MaybeTable Expr a))
-> Query a
-> Query (MaybeTable Expr a)
forall a b. (a -> b) -> a -> b
$ (FieldNullable SqlBool -> a -> MaybeTable Expr a)
-> Select a -> Select (MaybeTable Expr a)
forall a r.
(FieldNullable SqlBool -> a -> r) -> Select a -> Select r
Opaleye.optionalInternal ((FieldNullable SqlBool -> a -> MaybeTable Expr a)
 -> Select a -> Select (MaybeTable Expr a))
-> (FieldNullable SqlBool -> a -> MaybeTable Expr a)
-> Select a
-> Select (MaybeTable Expr a)
forall a b. (a -> b) -> a -> b
$ \FieldNullable SqlBool
tag a
a -> MaybeTable :: forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable
  { tag :: Expr (Maybe MaybeTag)
tag = PrimExpr -> Expr (Maybe MaybeTag)
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr (Maybe MaybeTag))
-> PrimExpr -> Expr (Maybe MaybeTag)
forall a b. (a -> b) -> a -> b
$ FieldNullable SqlBool -> PrimExpr
forall (n :: Nullability) b. Field_ n b -> PrimExpr
fromColumn FieldNullable SqlBool
tag
  , just :: Nullify Expr a
just = a -> Nullify Expr a
forall (f :: Context) a. Applicative f => a -> f a
pure a
a
  }


-- | Filter out 'MaybeTable's, returning only the tables that are not-null.
--
-- This operation can be used to "undo" the effect of 'optional', which
-- operationally is like turning a @LEFT JOIN@ back into a full @JOIN@.  You
-- can think of this as analogous to 'Data.Maybe.catMaybes'.
catMaybeTable :: MaybeTable Expr a -> Query a
catMaybeTable :: MaybeTable Expr a -> Query a
catMaybeTable ma :: MaybeTable Expr a
ma@(MaybeTable Expr (Maybe MaybeTag)
_ Nullify Expr a
a) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ MaybeTable Expr a -> Expr Bool
forall a. MaybeTable Expr a -> Expr Bool
isJustTable MaybeTable Expr a
ma
  a -> Query a
forall (f :: Context) a. Applicative f => a -> f a
pure (Nullify Expr a -> a
forall (w :: Context) a. Comonad w => w a -> a
extract Nullify Expr a
a)


-- | Extend an optional query with another query.  This is useful if you want
-- to step through multiple @LEFT JOINs@.
--
-- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means
-- you also have the ability to "expand" one row into multiple rows.  If the
-- @a -> Query b@ function returns no rows, then the resulting query will also
-- have no rows. However, regardless of the given @a -> Query b@ function, if
-- the input is @nothingTable@, you will always get exactly one @nothingTable@
-- back.
traverseMaybeTable :: (a -> Query b) -> MaybeTable Expr  a -> Query (MaybeTable Expr b)
traverseMaybeTable :: (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
  Query b -> Query (MaybeTable Expr b)
forall a. Query a -> Query (MaybeTable Expr a)
optional (a -> Query b
query (a -> Query b) -> Query a -> Query b
forall (m :: Context) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeTable Expr a -> Query a
forall a. MaybeTable Expr a -> Query a
catMaybeTable MaybeTable Expr a
ma) Query (MaybeTable Expr b)
-> (MaybeTable Expr b -> Query (MaybeTable Expr b))
-> Query (MaybeTable Expr b)
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_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ Expr (Maybe MaybeTag)
output Expr (Maybe MaybeTag) -> Expr (Maybe MaybeTag) -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. Expr (Maybe MaybeTag)
input
      MaybeTable Expr b -> Query (MaybeTable Expr b)
forall (f :: Context) a. Applicative f => a -> f a
pure (MaybeTable Expr b -> Query (MaybeTable Expr b))
-> MaybeTable Expr b -> Query (MaybeTable Expr b)
forall a b. (a -> b) -> a -> b
$ Expr (Maybe MaybeTag) -> Nullify Expr b -> MaybeTable Expr b
forall (context :: Context) a.
context (Maybe MaybeTag)
-> Nullify context a -> MaybeTable context a
MaybeTable Expr (Maybe MaybeTag)
input Nullify Expr b
b