{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE ViewPatterns        #-}

module Dovetail.Core.Effect where

import Control.Monad (unless, when)
import Data.Foldable (fold, for_)
import Data.Vector (Vector)
import Dovetail
import Dovetail.Evaluate (builtIn)

type Effect ctx a = Value ctx -> Eval ctx a

env :: forall ctx. Env ctx
env :: Env ctx
env = do
  let _ModuleName :: ModuleName
_ModuleName = Text -> ModuleName
ModuleName Text
"Effect"

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- pureE :: forall a. a -> Effect a
      ModuleName
-> Text -> (Value ctx -> Effect ctx (Value ctx)) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Effect ctx (Value ctx))
        ModuleName
_ModuleName Text
"pureE" 
        \Value ctx
a Value ctx
_ -> Effect ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
a
      -- bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b
    , ModuleName
-> Text
-> (Effect ctx (Value ctx)
    -> (Value ctx -> Effect ctx (Value ctx)) -> Effect ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Effect ctx (Value ctx) -> (Value ctx -> Effect ctx (Value ctx)) -> Effect ctx (Value ctx))
        ModuleName
_ModuleName Text
"bindE" 
        \Effect ctx (Value ctx)
e Value ctx -> Effect ctx (Value ctx)
f Value ctx
rw -> do
          Value ctx
a <- Effect ctx (Value ctx)
e Value ctx
rw
          Value ctx -> Effect ctx (Value ctx)
f Value ctx
a Value ctx
rw
      -- untilE :: Effect Boolean -> Effect Unit
    , ModuleName
-> Text -> (Effect ctx Bool -> Effect ctx (Value ctx)) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Effect ctx Bool -> Effect ctx (Value ctx))
        ModuleName
_ModuleName Text
"untilE"
        \Effect ctx Bool
cond Value ctx
rw -> do
          let loop :: Eval ctx ()
loop = do
                Bool
b <- Effect ctx Bool
cond Value ctx
rw
                Bool -> Eval ctx () -> Eval ctx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b Eval ctx ()
loop
          Eval ctx ()
loop
          Effect ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (Value ctx) -> Value ctx
forall ctx. HashMap Text (Value ctx) -> Value ctx
Object HashMap Text (Value ctx)
forall a. Monoid a => a
mempty)
      -- whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit
    , ModuleName
-> Text
-> (Effect ctx Bool
    -> Effect ctx (Value ctx) -> Effect ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Effect ctx Bool -> Effect ctx (Value ctx) -> Effect ctx (Value ctx))
        ModuleName
_ModuleName Text
"whileE"
        \Effect ctx Bool
cond Effect ctx (Value ctx)
body Value ctx
rw -> do
          let loop :: Eval ctx ()
loop = do
                Bool
b <- Effect ctx Bool
cond Value ctx
rw
                Bool -> Eval ctx () -> Eval ctx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (Effect ctx (Value ctx)
body Value ctx
rw Eval ctx (Value ctx) -> Eval ctx () -> Eval ctx ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Eval ctx ()
loop)
          Eval ctx ()
loop
          Effect ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (Value ctx) -> Value ctx
forall ctx. HashMap Text (Value ctx) -> Value ctx
Object HashMap Text (Value ctx)
forall a. Monoid a => a
mempty)
      -- for :: forall r a. Int -> Int -> (Int ->  a) ->  Unit
    , ModuleName
-> Text
-> (Integer
    -> Integer
    -> (Integer -> Effect ctx (Value ctx))
    -> Effect ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> (Integer -> Effect ctx (Value ctx)) -> Effect ctx (Value ctx))
        ModuleName
_ModuleName Text
"for"
        \Integer
from Integer
to Integer -> Effect ctx (Value ctx)
body Value ctx
rw -> do
          [Integer] -> (Integer -> Eval ctx (Value ctx)) -> Eval ctx ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Integer
from .. Integer
to] \Integer
i -> 
            Integer -> Effect ctx (Value ctx)
body Integer
i Value ctx
rw
          Effect ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (Value ctx) -> Value ctx
forall ctx. HashMap Text (Value ctx) -> Value ctx
Object HashMap Text (Value ctx)
forall a. Monoid a => a
mempty)
      -- foreach :: forall r a. Array a -> (a ->  Unit) ->  Unit
    , ModuleName
-> Text
-> (Vector (Value ctx)
    -> (Value ctx -> Effect ctx (Value ctx)) -> Effect ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> (Value ctx -> Effect ctx (Value ctx)) -> Effect ctx (Value ctx))
        ModuleName
_ModuleName Text
"foreach"
        \Vector (Value ctx)
xs Value ctx -> Effect ctx (Value ctx)
f Value ctx
rw -> do
          Vector (Value ctx) -> Effect ctx (Value ctx) -> Eval ctx ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Vector (Value ctx)
xs \Value ctx
x -> 
            Value ctx -> Effect ctx (Value ctx)
f Value ctx
x Value ctx
rw
          Effect ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (Value ctx) -> Value ctx
forall ctx. HashMap Text (Value ctx) -> Value ctx
Object HashMap Text (Value ctx)
forall a. Monoid a => a
mempty)
    ]