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

-- base
import Prelude

-- opaleye
import qualified Opaleye.Internal.PackMap as Opaleye
import qualified Opaleye.Internal.PrimQuery as Opaleye
import qualified Opaleye.Internal.QueryArr as Opaleye
import qualified Opaleye.Internal.Tag as Opaleye
import qualified Opaleye.Internal.Unpackspec as Opaleye

-- rel8
import Rel8.Expr.Bool ( true )
import Rel8.Expr.Eq ( (==.) )
import Rel8.Expr.Opaleye ( toPrimExpr )
import Rel8.Query ( Query )
import Rel8.Query.Filter ( where_ )
import Rel8.Query.Opaleye ( mapOpaleye )
import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )
import Rel8.Table.Opaleye ( unpackspec )
import Rel8.Table.Tag ( Tag(..), fromExpr )


-- | 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 a)
optional :: Query a -> Query (MaybeTable a)
optional = (Select a -> Select (MaybeTable a))
-> Query a -> Query (MaybeTable a)
forall a b. (Select a -> Select b) -> Query a -> Query b
mapOpaleye ((Select a -> Select (MaybeTable a))
 -> Query a -> Query (MaybeTable a))
-> (Select a -> Select (MaybeTable a))
-> Query a
-> Query (MaybeTable a)
forall a b. (a -> b) -> a -> b
$ (((), PrimQuery, Tag) -> (MaybeTable a, PrimQuery, Tag))
-> Select (MaybeTable a)
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> SelectArr a b
Opaleye.QueryArr ((((), PrimQuery, Tag) -> (MaybeTable a, PrimQuery, Tag))
 -> Select (MaybeTable a))
-> (Select a
    -> ((), PrimQuery, Tag) -> (MaybeTable a, PrimQuery, Tag))
-> Select a
-> Select (MaybeTable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select a -> ((), PrimQuery, Tag) -> (MaybeTable a, PrimQuery, Tag)
forall a a.
SelectArr a a
-> (a, PrimQuery, Tag) -> (MaybeTable a, PrimQuery, Tag)
go
  where
    go :: SelectArr a a
-> (a, PrimQuery, Tag) -> (MaybeTable a, PrimQuery, Tag)
go SelectArr a a
query (a
i, PrimQuery
left, Tag
tag) =
      (Tag "isJust" (Maybe MaybeTag) -> a -> MaybeTable a
forall a. Tag "isJust" (Maybe MaybeTag) -> a -> MaybeTable a
MaybeTable (Expr (Maybe MaybeTag) -> Tag "isJust" (Maybe MaybeTag)
forall (label :: Symbol) a.
(KnownSymbol label, Taggable a) =>
Expr a -> Tag label a
fromExpr Expr (Maybe MaybeTag)
t') a
a, PrimQuery
join, Tag -> Tag
Opaleye.next Tag
tag')
      where
        (MaybeTable Tag {expr :: forall (label :: Symbol) a. Tag label a -> Expr a
expr = Expr (Maybe MaybeTag)
t} a
a, PrimQuery
right, Tag
tag') =
          QueryArr a (MaybeTable a)
-> (a, Tag) -> (MaybeTable a, PrimQuery, Tag)
forall a b. QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
Opaleye.runSimpleQueryArr (a -> MaybeTable a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> MaybeTable a) -> SelectArr a a -> QueryArr a (MaybeTable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectArr a a
query) (a
i, Tag
tag)
        (Expr (Maybe MaybeTag)
t', [(Symbol, PrimExpr)]
bindings) = PM [(Symbol, PrimExpr)] (Expr (Maybe MaybeTag))
-> (Expr (Maybe MaybeTag), [(Symbol, PrimExpr)])
forall a r. PM [a] r -> (r, [a])
Opaleye.run (PM [(Symbol, PrimExpr)] (Expr (Maybe MaybeTag))
 -> (Expr (Maybe MaybeTag), [(Symbol, PrimExpr)]))
-> PM [(Symbol, PrimExpr)] (Expr (Maybe MaybeTag))
-> (Expr (Maybe MaybeTag), [(Symbol, PrimExpr)])
forall a b. (a -> b) -> a -> b
$
          Unpackspec (Expr (Maybe MaybeTag)) (Expr (Maybe MaybeTag))
-> (PrimExpr
    -> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr)
-> Expr (Maybe MaybeTag)
-> PM [(Symbol, PrimExpr)] (Expr (Maybe MaybeTag))
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
Opaleye.runUnpackspec Unpackspec (Expr (Maybe MaybeTag)) (Expr (Maybe MaybeTag))
forall a. Table Expr a => Unpackspec a a
unpackspec (String
-> Tag
-> PrimExpr
-> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr
forall primExpr.
String -> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
Opaleye.extractAttr String
"maybe" Tag
tag') Expr (Maybe MaybeTag)
t
        join :: PrimQuery
join = JoinType
-> PrimExpr
-> [(Symbol, PrimExpr)]
-> [(Symbol, PrimExpr)]
-> PrimQuery
-> PrimQuery
-> PrimQuery
forall a.
JoinType
-> PrimExpr
-> [(Symbol, PrimExpr)]
-> [(Symbol, PrimExpr)]
-> PrimQuery' a
-> PrimQuery' a
-> PrimQuery' a
Opaleye.Join JoinType
Opaleye.LeftJoin PrimExpr
condition [] [(Symbol, PrimExpr)]
bindings PrimQuery
left PrimQuery
right
        condition :: PrimExpr
condition = Expr Bool -> PrimExpr
forall a. Expr a -> PrimExpr
toPrimExpr Expr Bool
true


-- | 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 a -> Query a
catMaybeTable :: MaybeTable a -> Query a
catMaybeTable ma :: MaybeTable a
ma@(MaybeTable Tag "isJust" (Maybe MaybeTag)
_ a
a) = do
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ MaybeTable a -> Expr Bool
forall a. MaybeTable a -> Expr Bool
isJustTable MaybeTable a
ma
  a -> Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 a -> Query (MaybeTable b)
traverseMaybeTable :: (a -> Query b) -> MaybeTable a -> Query (MaybeTable b)
traverseMaybeTable a -> Query b
query ma :: MaybeTable a
ma@(MaybeTable Tag "isJust" (Maybe MaybeTag)
input a
_) = do
  MaybeTable Tag "isJust" (Maybe MaybeTag)
output b
b <- Query b -> Query (MaybeTable b)
forall a. Query a -> Query (MaybeTable a)
optional (a -> Query b
query (a -> Query b) -> Query a -> Query b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeTable a -> Query a
forall a. MaybeTable a -> Query a
catMaybeTable MaybeTable a
ma)
  Expr Bool -> Query ()
where_ (Expr Bool -> Query ()) -> Expr Bool -> Query ()
forall a b. (a -> b) -> a -> b
$ Tag "isJust" (Maybe MaybeTag) -> Expr (Maybe MaybeTag)
forall (label :: Symbol) a. Tag label a -> Expr a
expr Tag "isJust" (Maybe MaybeTag)
output Expr (Maybe MaybeTag) -> Expr (Maybe MaybeTag) -> Expr Bool
forall a. Sql DBEq a => Expr a -> Expr a -> Expr Bool
==. Tag "isJust" (Maybe MaybeTag) -> Expr (Maybe MaybeTag)
forall (label :: Symbol) a. Tag label a -> Expr a
expr Tag "isJust" (Maybe MaybeTag)
input
  MaybeTable b -> Query (MaybeTable b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeTable b -> Query (MaybeTable b))
-> MaybeTable b -> Query (MaybeTable b)
forall a b. (a -> b) -> a -> b
$ Tag "isJust" (Maybe MaybeTag) -> b -> MaybeTable b
forall a. Tag "isJust" (Maybe MaybeTag) -> a -> MaybeTable a
MaybeTable Tag "isJust" (Maybe MaybeTag)
input b
b