{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- At present this is a proof of concept. It might benefit from being
-- converted to a typeclass in the tagless final style.

-- |
-- Given an instantiated Technique Procedure, evalutate it at runtime.
module Technique.Evaluator where

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader.Class (MonadReader (..))
import Control.Monad.Trans.Reader (ReaderT (..))
import Core.Data
import Core.Text
import Data.UUID.Types (UUID)
import Technique.Internal

-- |
-- In order to execute a Procedure we need to supply a Context: an identifier
-- for the event (collection of procedure calls) it is a part of, and the path
-- history we took to get here.

-- TODO values needs to be somewhere, but here?
data Context = Context
  { Context -> UUID
contextEvent :: UUID,
    Context -> Rope
contextPath :: Rope, -- or a  list or a fingertree or...
    Context -> Map Name Promise
contextValues :: Map Name Promise -- TODO this needs to evolve to IVars or equivalent
  }

{-
data Expression b where
    Binding :: Variable b -> Expression a -> Expression b
    Comment :: Rope -> Expression ()
    Declaration :: (a -> b) -> Expression (a -> b)
    Application :: Expression (a -> b) -> Expression a -> Expression b
    Attribute :: Role -> Expression a -> Expression a
-}

-- Does this need to upgrade to a MonadEvaluate mtl style class in order to
-- support different interpeters / backends? This seems so cumbersome
-- compared to the elegent tagless final method.

newtype Evaluate a = Evaluate (ReaderT Context IO a)
  deriving (a -> Evaluate b -> Evaluate a
(a -> b) -> Evaluate a -> Evaluate b
(forall a b. (a -> b) -> Evaluate a -> Evaluate b)
-> (forall a b. a -> Evaluate b -> Evaluate a) -> Functor Evaluate
forall a b. a -> Evaluate b -> Evaluate a
forall a b. (a -> b) -> Evaluate a -> Evaluate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Evaluate b -> Evaluate a
$c<$ :: forall a b. a -> Evaluate b -> Evaluate a
fmap :: (a -> b) -> Evaluate a -> Evaluate b
$cfmap :: forall a b. (a -> b) -> Evaluate a -> Evaluate b
Functor, Functor Evaluate
a -> Evaluate a
Functor Evaluate
-> (forall a. a -> Evaluate a)
-> (forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b)
-> (forall a b c.
    (a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate b)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate a)
-> Applicative Evaluate
Evaluate a -> Evaluate b -> Evaluate b
Evaluate a -> Evaluate b -> Evaluate a
Evaluate (a -> b) -> Evaluate a -> Evaluate b
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
forall a. a -> Evaluate a
forall a b. Evaluate a -> Evaluate b -> Evaluate a
forall a b. Evaluate a -> Evaluate b -> Evaluate b
forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b
forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Evaluate a -> Evaluate b -> Evaluate a
$c<* :: forall a b. Evaluate a -> Evaluate b -> Evaluate a
*> :: Evaluate a -> Evaluate b -> Evaluate b
$c*> :: forall a b. Evaluate a -> Evaluate b -> Evaluate b
liftA2 :: (a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Evaluate a -> Evaluate b -> Evaluate c
<*> :: Evaluate (a -> b) -> Evaluate a -> Evaluate b
$c<*> :: forall a b. Evaluate (a -> b) -> Evaluate a -> Evaluate b
pure :: a -> Evaluate a
$cpure :: forall a. a -> Evaluate a
$cp1Applicative :: Functor Evaluate
Applicative, Applicative Evaluate
a -> Evaluate a
Applicative Evaluate
-> (forall a b. Evaluate a -> (a -> Evaluate b) -> Evaluate b)
-> (forall a b. Evaluate a -> Evaluate b -> Evaluate b)
-> (forall a. a -> Evaluate a)
-> Monad Evaluate
Evaluate a -> (a -> Evaluate b) -> Evaluate b
Evaluate a -> Evaluate b -> Evaluate b
forall a. a -> Evaluate a
forall a b. Evaluate a -> Evaluate b -> Evaluate b
forall a b. Evaluate a -> (a -> Evaluate b) -> Evaluate b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Evaluate a
$creturn :: forall a. a -> Evaluate a
>> :: Evaluate a -> Evaluate b -> Evaluate b
$c>> :: forall a b. Evaluate a -> Evaluate b -> Evaluate b
>>= :: Evaluate a -> (a -> Evaluate b) -> Evaluate b
$c>>= :: forall a b. Evaluate a -> (a -> Evaluate b) -> Evaluate b
$cp1Monad :: Applicative Evaluate
Monad, Monad Evaluate
Monad Evaluate
-> (forall a. IO a -> Evaluate a) -> MonadIO Evaluate
IO a -> Evaluate a
forall a. IO a -> Evaluate a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Evaluate a
$cliftIO :: forall a. IO a -> Evaluate a
$cp1MonadIO :: Monad Evaluate
MonadIO, MonadReader Context)

unEvaluate :: Evaluate a -> ReaderT Context IO a
unEvaluate :: Evaluate a -> ReaderT Context IO a
unEvaluate (Evaluate ReaderT Context IO a
r) = ReaderT Context IO a
r

-- |
-- The heart of the evaluation loop. Translate from the abstract syntax tree
-- into a monadic sequence which results in a Result.
evaluateStep :: Step -> Evaluate Value
evaluateStep :: Step -> Evaluate Value
evaluateStep Step
step = case Step
step of
  Known Offset
_ Value
value -> do
    Value -> Evaluate Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
value
  Depends Offset
_ Name
name -> do
    Name -> Evaluate Value
blockUntilValue Name
name
  Tuple Offset
_ [Step]
steps -> do
    [Value]
values <- (Step -> Evaluate Value) -> [Step] -> Evaluate [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Step -> Evaluate Value
evaluateStep [Step]
steps
    Value -> Evaluate Value
forall (m :: * -> *) a. Monad m => a -> m a
return ([Value] -> Value
Parametriq [Value]
values)
  Asynchronous Offset
_ [Name]
names Step
substep -> do
    Promise
promise <- [Name] -> Step -> Evaluate Promise
assignNames [Name]
names Step
substep
    Evaluate Value
forall a. HasCallStack => a
undefined -- TODO put promise into environment
  Invocation Offset
_ Attribute
attr Function
func Step
substep -> do
    Function -> Step -> Evaluate Value
functionApplication Function
func Step
substep -- TODO do something with role!

functionApplication :: Function -> Step -> Evaluate Value --  IO Promise ?
functionApplication :: Function -> Step -> Evaluate Value
functionApplication = Function -> Step -> Evaluate Value
forall a. HasCallStack => a
undefined

executeAction :: Function -> Step -> Evaluate Value --  IO Promise ?
executeAction :: Function -> Step -> Evaluate Value
executeAction = Function -> Step -> Evaluate Value
forall a. HasCallStack => a
undefined

blockUntilValue :: Name -> Evaluate Value
blockUntilValue :: Name -> Evaluate Value
blockUntilValue = Name -> Evaluate Value
forall a. HasCallStack => a
undefined

-- |
-- Take a step and lauch it asynchronously, binding its result to a name.
-- Returns a promise of a value that can be in evaluated (block on) when
-- needed.
assignNames :: [Name] -> Step -> Evaluate Promise
assignNames :: [Name] -> Step -> Evaluate Promise
assignNames = do
  -- dunno
  (Step -> Evaluate Promise) -> [Name] -> Step -> Evaluate Promise
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> Evaluate Promise
forall a. HasCallStack => a
undefined) -- fixme not empty list