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

module Dovetail.Core.Data.Eq where

import Data.Foldable (fold)
import Data.Text (Text)
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.Eq"
  
      eqImpl :: Eq a => a -> a -> Eval ctx Bool
      eqImpl :: a -> a -> Eval ctx Bool
eqImpl a
x a
y = Bool -> Eval ctx Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y)

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- eqBooleanImpl :: Boolean -> Boolean -> Boolean
      ModuleName -> Text -> (Bool -> Bool -> Eval ctx Bool) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Bool -> Bool -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"eqBooleanImpl"
        (Eq Bool => Bool -> Bool -> Eval ctx Bool
forall a. Eq a => a -> a -> Eval ctx Bool
eqImpl @Bool)
      -- eqIntImpl :: Int -> Int -> Boolean
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Bool) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"eqIntImpl"
        (Eq Integer => Integer -> Integer -> Eval ctx Bool
forall a. Eq a => a -> a -> Eval ctx Bool
eqImpl @Integer)
      -- eqNumberImpl :: Number -> Number -> Boolean
    , ModuleName
-> Text -> (Double -> Double -> Eval ctx Bool) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Double -> Double -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"eqNumberImpl"
        (Eq Double => Double -> Double -> Eval ctx Bool
forall a. Eq a => a -> a -> Eval ctx Bool
eqImpl @Double)
      -- eqCharImpl :: Char -> Char -> Boolean
    , ModuleName -> Text -> (Char -> Char -> Eval ctx Bool) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Char -> Char -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"eqCharImpl"
        (Eq Char => Char -> Char -> Eval ctx Bool
forall a. Eq a => a -> a -> Eval ctx Bool
eqImpl @Char)
      -- eqStringImpl :: String -> String -> Boolean
    , ModuleName -> Text -> (Text -> Text -> Eval ctx Bool) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> Text -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"eqStringImpl"
        (Eq Text => Text -> Text -> Eval ctx Bool
forall a. Eq a => a -> a -> Eval ctx Bool
eqImpl @Text)
      -- eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean
    , ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx Bool)
    -> Vector (Value ctx) -> Vector (Value ctx) -> Eval ctx Bool)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Value ctx -> Eval ctx Bool) -> Vector (Value ctx) -> Vector (Value ctx) -> Eval ctx Bool)
        ModuleName
_ModuleName Text
"eqArrayImpl"
        \Value ctx -> Value ctx -> Eval ctx Bool
f Vector (Value ctx)
xs Vector (Value ctx)
ys -> 
          if Vector (Value ctx) -> Int
forall a. Vector a -> Int
Vector.length Vector (Value ctx)
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (Value ctx) -> Int
forall a. Vector a -> Int
Vector.length Vector (Value ctx)
ys
            then Vector Bool -> Bool
Vector.and (Vector Bool -> Bool) -> Eval ctx (Vector Bool) -> Eval ctx Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value ctx -> Value ctx -> Eval ctx Bool)
-> Vector (Value ctx)
-> Vector (Value ctx)
-> Eval ctx (Vector Bool)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
Vector.zipWithM Value ctx -> Value ctx -> Eval ctx Bool
f Vector (Value ctx)
xs Vector (Value ctx)
ys
            else Bool -> Eval ctx Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    ]