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

module Dovetail.Core.Data.Lazy where

import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (fold)
import Data.IORef qualified as IORef
import Data.Typeable (Typeable)
import Dovetail
import Dovetail.Evaluate (ForeignType(..), builtIn)
import Language.PureScript qualified as P

type Lazy ctx a = ForeignType (Eval ctx a)

env :: forall ctx. Typeable ctx => Env ctx
env :: Env ctx
env = do
  let _ModuleName :: ModuleName
_ModuleName = Text -> ModuleName
P.ModuleName Text
"Data.Lazy"

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- defer :: forall a. (Unit -> a) -> Lazy a
      ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> Eval ctx (Lazy ctx (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx (Value ctx)) -> Eval ctx (Lazy ctx (Value ctx)))
        ModuleName
_ModuleName Text
"defer"
        \Value ctx -> Eval ctx (Value ctx)
f -> do
          IORef (Maybe (Value ctx))
ref <- IO (IORef (Maybe (Value ctx)))
-> Eval ctx (IORef (Maybe (Value ctx)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe (Value ctx) -> IO (IORef (Maybe (Value ctx)))
forall a. a -> IO (IORef a)
IORef.newIORef Maybe (Value ctx)
forall a. Maybe a
Nothing)
          Lazy ctx (Value ctx) -> Eval ctx (Lazy ctx (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lazy ctx (Value ctx) -> Eval ctx (Lazy ctx (Value ctx)))
-> (Eval ctx (Value ctx) -> Lazy ctx (Value ctx))
-> Eval ctx (Value ctx)
-> Eval ctx (Lazy ctx (Value ctx))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eval ctx (Value ctx) -> Lazy ctx (Value ctx)
forall a. a -> ForeignType a
ForeignType (Eval ctx (Value ctx) -> Eval ctx (Lazy ctx (Value ctx)))
-> Eval ctx (Value ctx) -> Eval ctx (Lazy ctx (Value ctx))
forall a b. (a -> b) -> a -> b
$ do
            Maybe (Value ctx)
ma <- IO (Maybe (Value ctx)) -> Eval ctx (Maybe (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe (Value ctx)) -> IO (Maybe (Value ctx))
forall a. IORef a -> IO a
IORef.readIORef IORef (Maybe (Value ctx))
ref)
            case Maybe (Value ctx)
ma of
              Maybe (Value ctx)
Nothing -> do
                Value ctx
val <- Value ctx -> Eval 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)
                IO () -> Eval ctx ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Maybe (Value ctx)) -> Maybe (Value ctx) -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Maybe (Value ctx))
ref (Value ctx -> Maybe (Value ctx)
forall a. a -> Maybe a
Just Value ctx
val))
                Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
val
              Just Value ctx
a -> Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
a
      -- force :: forall a. Lazy a -> a
    , ModuleName
-> Text
-> (Lazy ctx (Value ctx) -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Lazy ctx (Value ctx) -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"force"
        \(ForeignType Eval ctx (Value ctx)
f) -> Eval ctx (Value ctx)
f
    ]