{-# LANGUAGE BlockArguments        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE ImportQualifiedPost   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE ViewPatterns          #-}

module Dovetail.Core.Effect.Ref where

import Control.Monad.Fix (mfix)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (fold)
import Data.IORef (IORef)
import Data.IORef qualified as IORef
import Data.Typeable (Typeable)
import Dovetail
import Dovetail.Evaluate (ForeignType(..), builtIn)
import GHC.Generics (Generic)

type Ref ctx = ForeignType (IORef (Value ctx))

data ModifyResult ctx = ModifyResult
  { ModifyResult ctx -> Value ctx
state :: Value ctx
  , ModifyResult ctx -> Value ctx
value :: Value ctx 
  } deriving (forall x. ModifyResult ctx -> Rep (ModifyResult ctx) x)
-> (forall x. Rep (ModifyResult ctx) x -> ModifyResult ctx)
-> Generic (ModifyResult ctx)
forall x. Rep (ModifyResult ctx) x -> ModifyResult ctx
forall x. ModifyResult ctx -> Rep (ModifyResult ctx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ctx x. Rep (ModifyResult ctx) x -> ModifyResult ctx
forall ctx x. ModifyResult ctx -> Rep (ModifyResult ctx) x
$cto :: forall ctx x. Rep (ModifyResult ctx) x -> ModifyResult ctx
$cfrom :: forall ctx x. ModifyResult ctx -> Rep (ModifyResult ctx) x
Generic
  
instance ToValue ctx (ModifyResult ctx) 

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

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- new :: forall s. s -> Effect (Ref s)
      ModuleName
-> Text
-> (Value ctx -> Value ctx -> Eval ctx (Ref ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Value ctx -> Eval ctx (Ref ctx))
        ModuleName
_ModuleName Text
"new"
        \Value ctx
s Value ctx
_ -> 
          IORef (Value ctx) -> Ref ctx
forall a. a -> ForeignType a
ForeignType (IORef (Value ctx) -> Ref ctx)
-> Eval ctx (IORef (Value ctx)) -> Eval ctx (Ref ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IORef (Value ctx)) -> Eval ctx (IORef (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Value ctx -> IO (IORef (Value ctx))
forall a. a -> IO (IORef a)
IORef.newIORef Value ctx
s)
      -- newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s)
    , ModuleName
-> Text
-> ((Ref ctx -> Eval ctx (Value ctx))
    -> Value ctx -> Eval ctx (Ref ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Ref ctx -> Eval ctx (Value ctx)) -> Value ctx -> Eval ctx (Ref ctx))
        ModuleName
_ModuleName Text
"newWithSelf"
        \Ref ctx -> Eval ctx (Value ctx)
f Value ctx
_ -> 
          (Ref ctx -> Eval ctx (Ref ctx)) -> Eval ctx (Ref ctx)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix \Ref ctx
r -> do
            Value ctx
s <- Ref ctx -> Eval ctx (Value ctx)
f Ref ctx
r
            IORef (Value ctx) -> Ref ctx
forall a. a -> ForeignType a
ForeignType (IORef (Value ctx) -> Ref ctx)
-> Eval ctx (IORef (Value ctx)) -> Eval ctx (Ref ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IORef (Value ctx)) -> Eval ctx (IORef (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Value ctx -> IO (IORef (Value ctx))
forall a. a -> IO (IORef a)
IORef.newIORef Value ctx
s)
      -- read :: forall s. Ref s -> Effect s
    , ModuleName
-> Text
-> (Ref ctx -> Value ctx -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Ref ctx -> Value ctx -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"read"
        \(ForeignType IORef (Value ctx)
ref) Value ctx
_ ->
          IO (Value ctx) -> Eval ctx (Value ctx)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Value ctx) -> IO (Value ctx)
forall a. IORef a -> IO a
IORef.readIORef IORef (Value ctx)
ref)
      -- write :: forall s. s -> Ref s -> Effect Unit
    , ModuleName
-> Text
-> (Value ctx -> Ref ctx -> Value ctx -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Ref ctx -> Value ctx -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"write"
        \Value ctx
s (ForeignType IORef (Value ctx)
ref) Value ctx
_ -> do
          IO () -> Eval ctx ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Value ctx) -> Value ctx -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Value ctx)
ref Value ctx
s)
          Value ctx -> Eval 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)
      -- modifyImpl :: forall s b.           
      --   (s                  
      --    -> { state :: s    
      --       , value :: b    
      --       }               
      --   )                   
      --   -> Ref s -> Effect b
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (ModifyResult ctx))
    -> Ref ctx -> Value ctx -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Eval ctx (ModifyResult ctx)) -> Ref ctx -> Value ctx -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"modifyImpl"
        \Value ctx -> Eval ctx (ModifyResult ctx)
f (ForeignType IORef (Value ctx)
ref) Value ctx
_ -> do
          Value ctx
s <- IO (Value ctx) -> Eval ctx (Value ctx)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Value ctx) -> IO (Value ctx)
forall a. IORef a -> IO a
IORef.readIORef IORef (Value ctx)
ref)
          ModifyResult Value ctx
newState Value ctx
result <- Value ctx -> Eval ctx (ModifyResult ctx)
f Value ctx
s
          IO () -> Eval ctx ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (Value ctx) -> Value ctx -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Value ctx)
ref Value ctx
newState)
          Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
result
    ]