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

module Dovetail.Core.Test.Assert where

import Control.Monad (unless)
import Control.Monad.Error.Class (catchError)
import Data.Foldable (fold)
import Data.Text (Text)
import Dovetail
import Dovetail.Core.Effect (Effect)
import Dovetail.Evaluate (builtIn)

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

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- assertImpl :: String -> Boolean -> Effect Unit
      ModuleName
-> Text -> (Text -> Bool -> Effect ctx (Value ctx)) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> Bool -> Effect ctx (Value ctx))
        ModuleName
_ModuleName Text
"assertImpl" 
        \Text
message Bool
b Value ctx
_ -> do
          Bool -> Eval ctx () -> Eval ctx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (EvaluationErrorType ctx -> Eval ctx ()
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
message))
          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)
      -- checkThrows :: forall a. (Unit -> a) -> Effect Boolean
    , ModuleName
-> Text -> (Effect ctx (Value ctx) -> Effect ctx Bool) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx (Value ctx)) -> Effect ctx Bool)
        ModuleName
_ModuleName Text
"checkThrows"
        \Effect ctx (Value ctx)
f Value ctx
_ ->
          Eval ctx Bool
-> (EvaluationError ctx -> Eval ctx Bool) -> Eval ctx Bool
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError 
            (Effect ctx (Value ctx)
f (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) Eval ctx (Value ctx) -> Eval ctx Bool -> Eval ctx Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Eval ctx Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
            \EvaluationError ctx
_ -> Bool -> Eval ctx Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    ]