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

module Dovetail.Core.Data.Array.ST.Partial where

import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (fold)
import Data.Functor (($>))
import Data.Typeable (Typeable)
import Data.Vector.Mutable qualified as Mutable
import Dovetail
import Dovetail.Core.Control.Monad.ST.Internal (ST)
import Dovetail.Core.Data.Array.ST (STArray)
import Dovetail.Evaluate (ForeignType(..), builtIn)
import Language.PureScript qualified as P

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

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- peekImpl :: forall h a. Int -> STArray h a -> ST h a
      ModuleName
-> Text
-> (Integer -> STArray (Value ctx) -> ST ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> STArray (Value ctx) -> ST ctx (Value ctx))
        ModuleName
_ModuleName Text
"peekImpl"
        \Integer
i (ForeignType IOVector (Value ctx)
xs) Value ctx
_ ->
          if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= IOVector (Value ctx) -> Int
forall s a. MVector s a -> Int
Mutable.length IOVector (Value ctx)
xs 
            then IO (Value ctx) -> Eval ctx (Value ctx)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVector (PrimState IO) (Value ctx) -> Int -> IO (Value ctx)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
Mutable.read IOVector (Value ctx)
MVector (PrimState IO) (Value ctx)
xs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i))
            else EvaluationErrorType ctx -> Eval ctx (Value 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
"peekImpl: index out of range")
      -- poke :: forall h a. Int -> a -> STArray h a -> ST h Unit
    , ModuleName
-> Text
-> (Integer
    -> Value ctx -> STArray (Value ctx) -> ST ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Value ctx -> STArray (Value ctx) -> ST ctx (Value ctx))
        ModuleName
_ModuleName Text
"poke"
        \Integer
i Value ctx
x (ForeignType IOVector (Value ctx)
xs) Value ctx
_ ->
          if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= IOVector (Value ctx) -> Int
forall s a. MVector s a -> Int
Mutable.length IOVector (Value ctx)
xs 
            then IO () -> Eval ctx ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVector (PrimState IO) (Value ctx) -> Int -> Value ctx -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
Mutable.write IOVector (Value ctx)
MVector (PrimState IO) (Value ctx)
xs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Value ctx
x) Eval ctx () -> ST ctx (Value ctx)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> 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
            else EvaluationErrorType ctx -> Eval ctx (Value 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
"poke: index out of range")
    ]