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

module Dovetail.Core.Data.FunctorWithIndex where

import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Dovetail
import Dovetail.Evaluate (builtIn)

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

  -- mapWithIndexArray :: forall i a b. (i -> a -> b) -> Array a -> Array b
  ModuleName
-> Text
-> ((Integer -> Value ctx -> Eval ctx (Value ctx))
    -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Integer -> Value ctx -> Eval ctx (Value ctx)) -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx)))
    ModuleName
_ModuleName Text
"mapWithIndexArray"
    \Integer -> Value ctx -> Eval ctx (Value ctx)
f -> 
      (Int -> Value ctx -> Eval ctx (Value ctx))
-> Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m (Vector b)
Vector.imapM (Integer -> Value ctx -> Eval ctx (Value ctx)
f (Integer -> Value ctx -> Eval ctx (Value ctx))
-> (Int -> Integer) -> Int -> Value ctx -> Eval ctx (Value ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral)