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

module Dovetail.Core.Data.Array.ST where

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

type STArray a = ForeignType (IOVector a)

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

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- unsafeFreeze :: forall h a. STArray h a -> ST h (Array a)
      ModuleName
-> Text
-> (STArray (Value ctx) -> ST ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(STArray (Value ctx) -> ST ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"unsafeFreeze"
        \(ForeignType IOVector (Value ctx)
v) Value ctx
_ -> 
          IO (Vector (Value ctx)) -> Eval ctx (Vector (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVector (PrimState IO) (Value ctx) -> IO (Vector (Value ctx))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.freeze IOVector (Value ctx)
MVector (PrimState IO) (Value ctx)
v)
      -- unsafeThaw :: forall h a. Array a -> ST h (STArray h a)
    , ModuleName
-> Text
-> (Vector (Value ctx) -> ST ctx (STArray (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> ST ctx (STArray (Value ctx)))
        ModuleName
_ModuleName Text
"unsafeThaw"
        \Vector (Value ctx)
v Value ctx
_ -> 
          IOVector (Value ctx) -> STArray (Value ctx)
forall a. a -> ForeignType a
ForeignType (IOVector (Value ctx) -> STArray (Value ctx))
-> Eval ctx (IOVector (Value ctx))
-> Eval ctx (STArray (Value ctx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IOVector (Value ctx)) -> Eval ctx (IOVector (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Vector (Value ctx) -> IO (MVector (PrimState IO) (Value ctx))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Vector.thaw Vector (Value ctx)
v)
      -- new :: forall h a. ST h (STArray h a)
    , ModuleName -> Text -> ST ctx (STArray (Value ctx)) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(ST ctx (STArray (Value ctx)))
        ModuleName
_ModuleName Text
"new"
        \Value ctx
_ -> 
          IOVector (Value ctx) -> STArray (Value ctx)
forall a. a -> ForeignType a
ForeignType (IOVector (Value ctx) -> STArray (Value ctx))
-> Eval ctx (IOVector (Value ctx))
-> Eval ctx (STArray (Value ctx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IOVector (Value ctx)) -> Eval ctx (IOVector (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO (MVector (PrimState IO) (Value ctx))
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
Mutable.new Int
0)
      -- freeze :: forall h a. STArray h a -> ST h (Array a)
    , ModuleName
-> Text
-> (STArray (Value ctx) -> ST ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(STArray (Value ctx) -> ST ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"freeze"
        \(ForeignType IOVector (Value ctx)
v) Value ctx
_ -> 
          IO (Vector (Value ctx)) -> Eval ctx (Vector (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MVector (PrimState IO) (Value ctx) -> IO (Vector (Value ctx))
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
Vector.freeze IOVector (Value ctx)
MVector (PrimState IO) (Value ctx)
v)
      -- thaw :: forall h a. Array a -> ST h (STArray h a)
    , ModuleName
-> Text
-> (Vector (Value ctx) -> ST ctx (STArray (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> ST ctx (STArray (Value ctx)))
        ModuleName
_ModuleName Text
"thaw"
        \Vector (Value ctx)
v Value ctx
_ -> 
          IOVector (Value ctx) -> STArray (Value ctx)
forall a. a -> ForeignType a
ForeignType (IOVector (Value ctx) -> STArray (Value ctx))
-> Eval ctx (IOVector (Value ctx))
-> Eval ctx (STArray (Value ctx))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IOVector (Value ctx)) -> Eval ctx (IOVector (Value ctx))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Vector (Value ctx) -> IO (MVector (PrimState IO) (Value ctx))
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
Vector.thaw Vector (Value ctx)
v)
      -- shiftImpl :: forall h a
      --    . (forall b. b -> Maybe b)
      --   -> (forall b. Maybe b)
      --   -> STArray h a
      --   -> ST h (Maybe a)
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> STArray (Value 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 (Value ctx)) -> Value ctx -> STArray (Value ctx) -> ST ctx (Value ctx))
        ModuleName
_ModuleName Text
"shiftImpl"
        \Value ctx -> Eval ctx (Value ctx)
_just Value ctx
_nothing STArray (Value ctx)
_xs Value ctx
_ ->
          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
"shiftImpl is not implemented")
      -- sortByImpl :: forall a h
      --    . (a -> a -> Ordering)
      --   -> (Ordering -> Int)
      --   -> STArray h a
      --   -> ST h (STArray h a)
    , ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx (Value ctx))
    -> (Value ctx -> Eval ctx Integer)
    -> STArray (Value ctx)
    -> ST ctx (STArray (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Value ctx -> Eval ctx (Value ctx)) -> (Value ctx -> Eval ctx Integer) -> STArray (Value ctx) -> ST ctx (STArray (Value ctx)))
        ModuleName
_ModuleName Text
"sortByImpl"
        \Value ctx -> Value ctx -> Eval ctx (Value ctx)
_cmp Value ctx -> Eval ctx Integer
_f STArray (Value ctx)
_xs Value ctx
_ ->
          EvaluationErrorType ctx -> Eval ctx (STArray (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
"sortByImpl is not implemented")
      -- peekImpl :: forall h a r
      --    . (a -> r)
      --   -> r
      --   -> Int
      --   -> STArray h a
      --   -> ST h r
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> Integer
    -> STArray (Value 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 (Value ctx)) -> Value ctx -> Integer -> STArray (Value ctx) -> ST ctx (Value ctx))
        ModuleName
_ModuleName Text
"peekImpl"
        \Value ctx -> Eval ctx (Value ctx)
_just Value ctx
_nothing 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 Value ctx -> Eval ctx (Value ctx)
_just (Value ctx -> Eval ctx (Value ctx))
-> Eval ctx (Value ctx) -> Eval ctx (Value ctx)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing
      -- poke :: forall h a. Int -> a -> STArray h a -> ST h Boolean
    , ModuleName
-> Text
-> (Integer -> Value ctx -> STArray (Value ctx) -> ST ctx Bool)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Value ctx -> STArray (Value ctx) -> ST ctx Bool)
        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 () -> Bool -> Eval ctx Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
            else Bool -> Eval ctx Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      -- popImpl :: forall h a
      --    . (forall b. b -> Maybe b)
      --   -> (forall b. Maybe b)
      --   -> STArray h a
      --   -> ST h (Maybe a)
    , ModuleName
-> Text
-> ((Value ctx -> Eval ctx (Value ctx))
    -> Value ctx
    -> STArray (Value 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 (Value ctx)) -> Value ctx -> STArray (Value ctx) -> ST ctx (Value ctx))
        ModuleName
_ModuleName Text
"popImpl"
        \Value ctx -> Eval ctx (Value ctx)
_just Value ctx
_nothing STArray (Value ctx)
_ Value ctx
_ ->
          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
"popImpl is not implemented")
      -- pushAll :: forall h a
      --    . Array a
      --   -> STArray h a
      --   -> ST h Int
    , ModuleName
-> Text
-> (Vector (Value ctx)
    -> STArray (Value ctx) -> Value ctx -> Eval ctx Integer)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> STArray (Value ctx) -> ST ctx Integer)
        ModuleName
_ModuleName Text
"pushAll"
        \Vector (Value ctx)
_ STArray (Value ctx)
_ Value ctx
_ ->
          EvaluationErrorType ctx -> Eval ctx Integer
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
"pushAll is not implemented")
      -- unshiftAll :: forall h a
      --    . Array a
      --   -> STArray h a
      --   -> ST h Int
    , ModuleName
-> Text
-> (Vector (Value ctx)
    -> STArray (Value ctx) -> Value ctx -> Eval ctx Integer)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector (Value ctx) -> STArray (Value ctx) -> ST ctx Integer)
        ModuleName
_ModuleName Text
"unshiftAll"
        \Vector (Value ctx)
_ STArray (Value ctx)
_ Value ctx
_ ->
          EvaluationErrorType ctx -> Eval ctx Integer
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
"unshiftAll is not implemented")
      -- splice :: forall h a
      --    . Int
      --   -> Int
      --   -> Array a
      --   -> STArray h a
      --   -> ST h (Array a)
    , ModuleName
-> Text
-> (Integer
    -> Integer
    -> Vector (Value ctx)
    -> STArray (Value ctx)
    -> ST ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Vector (Value ctx) -> STArray (Value ctx) -> ST ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"splice"
        \Integer
_ Integer
_ Vector (Value ctx)
_ STArray (Value ctx)
_ Value ctx
_ ->
          EvaluationErrorType ctx -> Eval ctx (Vector (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
"splice is not implemented")
      -- toAssocArray :: forall h a. STArray h a -> ST h (Array (Assoc a))
    , ModuleName
-> Text
-> (STArray (Value ctx) -> ST ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(STArray (Value ctx) -> ST ctx (Vector (Value ctx)))
        ModuleName
_ModuleName Text
"toAssocArray"
        \STArray (Value ctx)
_ Value ctx
_ ->
          EvaluationErrorType ctx -> Eval ctx (Vector (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
"toAssocArray is not implemented")
    ]