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

module Rel8.Query.Evaluate
  ( evaluate
  )
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

-- rel8
import Rel8.Expr ( Expr )
import Rel8.Expr.Bool ( (&&.) )
import Rel8.Expr.Opaleye ( fromPrimExpr )
import Rel8.Query ( Query( Query ) )
import Rel8.Query.Rebind ( rebind )
import Rel8.Table ( Table )
import Rel8.Table.Bool ( case_ )
import Rel8.Table.Undefined ( 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
>=> String -> a -> Query a
forall a. Table Expr a => String -> a -> Query a
rebind String
"eval"


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


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