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

module Dovetail.Core.Data.Traversable where

import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Dovetail
import Dovetail.Evaluate (builtIn)
import Language.PureScript qualified as P

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

  -- traverseArrayImpl
  --   :: forall m a b
  --    . (m (a -> b) -> m a -> m b)
  --   -> ((a -> b) -> m a -> m b)
  --   -> (a -> m a)
  --   -> (a -> m b)
  --   -> Array a
  --   -> m (Array b)
  ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx (Value ctx))
    -> ((Vector (Value ctx)
         -> Value ctx -> Eval ctx (Vector (Value ctx)))
        -> Value ctx -> Eval ctx (Value ctx))
    -> (Vector (Value ctx) -> Eval ctx (Value ctx))
    -> (Value ctx -> Eval ctx (Value ctx))
    -> Vector (Value ctx)
    -> Eval ctx (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))
    -> ((Vector (Value ctx) -> Value ctx -> Eval ctx (Vector (Value ctx))) -> Value ctx -> Eval ctx (Value ctx))
    -> (Vector (Value ctx) -> Eval ctx (Value ctx))
    -> (Value ctx -> Eval ctx (Value ctx))
    -> Vector (Value ctx)
    -> Eval ctx (Value ctx)
    )
    ModuleName
_ModuleName Text
"traverseArrayImpl"
    \Value ctx -> Value ctx -> Eval ctx (Value ctx)
_apply (Vector (Value ctx) -> Value ctx -> Eval ctx (Vector (Value ctx)))
-> Value ctx -> Eval ctx (Value ctx)
_fmap Vector (Value ctx) -> Eval ctx (Value ctx)
_pure Value ctx -> Eval ctx (Value ctx)
f Vector (Value ctx)
xs -> do
      Value ctx
bs0 <- Vector (Value ctx) -> Eval ctx (Value ctx)
_pure Vector (Value ctx)
forall a. Vector a
Vector.empty
      let _cons :: Value ctx -> Value ctx -> Eval ctx (Value ctx)
          _cons :: Value ctx -> Value ctx -> Eval ctx (Value ctx)
_cons Value ctx
bs Value ctx
a = do
            Value ctx
b <- Value ctx -> Eval ctx (Value ctx)
f Value ctx
a
            (Vector (Value ctx) -> Value ctx -> Eval ctx (Vector (Value ctx)))
-> Value ctx -> Eval ctx (Value ctx)
_fmap (\Vector (Value ctx)
ys Value ctx
y -> Vector (Value ctx) -> Eval ctx (Vector (Value ctx))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (Value ctx) -> Value ctx -> Vector (Value ctx)
forall a. Vector a -> a -> Vector a
Vector.snoc Vector (Value ctx)
ys Value ctx
y)) Value ctx
bs Eval ctx (Value ctx)
-> (Value ctx -> Eval ctx (Value ctx)) -> Eval ctx (Value ctx)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value ctx -> Value ctx -> Eval ctx (Value ctx)
`_apply` Value ctx
b)
      (Value ctx -> Value ctx -> Eval ctx (Value ctx))
-> Value ctx -> Vector (Value ctx) -> Eval ctx (Value ctx)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
Vector.foldM Value ctx -> Value ctx -> Eval ctx (Value ctx)
_cons Value ctx
bs0 Vector (Value ctx)
xs