{-# language FlexibleContexts #-}
{-# language TupleSections #-}

module Rel8.Query.Evaluate
  ( evaluate
  , rebind
  )
where

-- base
import Control.Monad ( (>=>) )
import Data.Foldable ( foldl' )
import Data.List.NonEmpty ( NonEmpty( (:|) ), nonEmpty )
import Data.Monoid ( Any( Any ) )
import Prelude hiding ( undefined )

-- opaleye
import qualified Opaleye.Internal.HaskellDB.PrimQuery as 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 ( Expr )
import Rel8.Expr.Bool ( (&&.) )
import Rel8.Expr.Opaleye ( fromPrimExpr )
import Rel8.Query ( Query( Query ) )
import Rel8.Table ( Table )
import Rel8.Table.Bool ( case_ )
import Rel8.Table.Opaleye ( unpackspec )
import Rel8.Table.Undefined


-- | 'evaluate' takes expressions that could potentially have side effects and
-- \"runs\" them in the 'Query' monad. The returned expressions have no side
-- effects and can safely be reused.
evaluate :: Table Expr a => a -> Query a
evaluate :: a -> Query a
evaluate = a -> Query a
forall a. Table Expr a => a -> Query a
laterally (a -> Query a) -> (a -> Query a) -> a -> Query a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Query a
forall a. Table Expr a => a -> Query a
rebind


laterally :: Table Expr a => a -> Query a
laterally :: a -> Query a
laterally a
a = ([PrimExpr] -> Select (Any, a)) -> Query a
forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query (([PrimExpr] -> Select (Any, a)) -> Query a)
-> ([PrimExpr] -> Select (Any, a)) -> Query a
forall a b. (a -> b) -> a -> b
$ \[PrimExpr]
bindings -> (Any, a) -> Select (Any, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Any, a) -> Select (Any, a)) -> (Any, a) -> Select (Any, a)
forall a b. (a -> b) -> a -> b
$ (Bool -> Any
Any Bool
True,) (a -> (Any, a)) -> a -> (Any, a)
forall a b. (a -> b) -> a -> b
$
  case [PrimExpr] -> Maybe (NonEmpty PrimExpr)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [PrimExpr]
bindings of
    Maybe (NonEmpty PrimExpr)
Nothing -> a
a
    Just NonEmpty PrimExpr
bindings' -> [(Expr Bool, a)] -> a -> a
forall a. Table Expr a => [(Expr Bool, a)] -> a -> a
case_ [(Expr Bool
condition, a
a)] a
forall a. Table Expr a => a
undefined
      where
        condition :: Expr Bool
condition = (Expr Bool -> Expr Bool -> Expr Bool)
-> NonEmpty (Expr Bool) -> Expr Bool
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' Expr Bool -> Expr Bool -> Expr Bool
(&&.) ((PrimExpr -> Expr Bool)
-> NonEmpty PrimExpr -> NonEmpty (Expr Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimExpr -> Expr Bool
forall a. PrimExpr -> Expr a
go NonEmpty PrimExpr
bindings')
          where
            go :: PrimExpr -> Expr a
go = PrimExpr -> Expr a
forall a. PrimExpr -> Expr a
fromPrimExpr (PrimExpr -> Expr a)
-> (PrimExpr -> PrimExpr) -> PrimExpr -> Expr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnOp -> PrimExpr -> PrimExpr
Opaleye.UnExpr UnOp
Opaleye.OpIsNotNull


-- | 'rebind' takes some expressions, and binds each of them to a new
-- variable in the SQL. The @a@ returned consists only of these
-- variables. It's essentially a @let@ binding for Postgres expressions.
rebind :: Table Expr a => a -> Query a
rebind :: a -> Query a
rebind a
a = ([PrimExpr] -> Select (Any, a)) -> Query a
forall a. ([PrimExpr] -> Select (Any, a)) -> Query a
Query (([PrimExpr] -> Select (Any, a)) -> Query a)
-> ([PrimExpr] -> Select (Any, a)) -> Query a
forall a b. (a -> b) -> a -> b
$ \[PrimExpr]
_ -> (((), Tag) -> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, a)
forall a b.
((a, Tag) -> (b, Lateral -> PrimQuery -> PrimQuery, Tag))
-> SelectArr a b
Opaleye.QueryArr ((((), Tag) -> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag))
 -> Select (Any, a))
-> (((), Tag)
    -> ((Any, a), Lateral -> PrimQuery -> PrimQuery, Tag))
-> Select (Any, a)
forall a b. (a -> b) -> a -> b
$ \(()
_, Tag
tag) ->
  let
    tag' :: Tag
tag' = Tag -> Tag
Opaleye.next Tag
tag
    (a
a', [(Symbol, PrimExpr)]
bindings) = PM [(Symbol, PrimExpr)] a -> (a, [(Symbol, PrimExpr)])
forall a r. PM [a] r -> (r, [a])
Opaleye.run (PM [(Symbol, PrimExpr)] a -> (a, [(Symbol, PrimExpr)]))
-> PM [(Symbol, PrimExpr)] a -> (a, [(Symbol, PrimExpr)])
forall a b. (a -> b) -> a -> b
$
      Unpackspec a a
-> (PrimExpr
    -> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr)
-> a
-> PM [(Symbol, PrimExpr)] a
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
Opaleye.runUnpackspec Unpackspec a a
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
"eval" Tag
tag) a
a
  in
    ((Any
forall a. Monoid a => a
mempty, a
a'), \Lateral
_ -> Bool -> [(Symbol, PrimExpr)] -> PrimQuery -> PrimQuery
forall a.
Bool -> [(Symbol, PrimExpr)] -> PrimQuery' a -> PrimQuery' a
Opaleye.Rebind Bool
True [(Symbol, PrimExpr)]
bindings, Tag
tag')


foldl1' :: (a -> a -> a) -> NonEmpty a -> a
foldl1' :: (a -> a -> a) -> NonEmpty a -> a
foldl1' a -> a -> a
f (a
a :| [a]
as) = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
f a
a [a]
as