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

module Dovetail.Core.Data.Ord 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.Ord"
      
      compareImpl :: a -> a -> a -> a -> a -> f a
compareImpl a
lt a
eq a
gt a
x a
y = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
          Ordering
LT -> a
lt
          Ordering
EQ -> a
eq
          Ordering
GT -> a
gt

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- ordBooleanImpl :: Ordering -> Ordering -> Ordering -> Boolean -> Boolean -> Ordering
      ModuleName
-> Text
-> (Value ctx
    -> Value ctx -> Value ctx -> Bool -> Bool -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Value ctx -> Value ctx -> Bool -> Bool -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"ordBooleanImpl" 
        Value ctx
-> Value ctx -> Value ctx -> Bool -> Bool -> Eval ctx (Value ctx)
forall (f :: * -> *) a a.
(Applicative f, Ord a) =>
a -> a -> a -> a -> a -> f a
compareImpl
    , -- ordIntImpl :: Ordering -> Ordering -> Ordering -> Int -> Int -> Ordering
      ModuleName
-> Text
-> (Value ctx
    -> Value ctx
    -> Value ctx
    -> Integer
    -> Integer
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Value ctx -> Value ctx -> Integer -> Integer -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"ordIntImpl" 
        Value ctx
-> Value ctx
-> Value ctx
-> Integer
-> Integer
-> Eval ctx (Value ctx)
forall (f :: * -> *) a a.
(Applicative f, Ord a) =>
a -> a -> a -> a -> a -> f a
compareImpl
    , -- ordNumberImpl :: Ordering -> Ordering -> Ordering -> Double -> Double -> Ordering
      ModuleName
-> Text
-> (Value ctx
    -> Value ctx
    -> Value ctx
    -> Double
    -> Double
    -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Value ctx -> Value ctx -> Double -> Double -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"ordNumberImpl" 
        Value ctx
-> Value ctx
-> Value ctx
-> Double
-> Double
-> Eval ctx (Value ctx)
forall (f :: * -> *) a a.
(Applicative f, Ord a) =>
a -> a -> a -> a -> a -> f a
compareImpl
    , -- ordStringImpl :: Ordering -> Ordering -> Ordering -> Text -> Text -> Ordering
      ModuleName
-> Text
-> (Value ctx
    -> Value ctx -> Value ctx -> Text -> Text -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Value ctx -> Value ctx -> Text -> Text -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"ordStringImpl" 
        Value ctx
-> Value ctx -> Value ctx -> Text -> Text -> Eval ctx (Value ctx)
forall (f :: * -> *) a a.
(Applicative f, Ord a) =>
a -> a -> a -> a -> a -> f a
compareImpl
    , -- ordCharImpl :: Ordering -> Ordering -> Ordering -> Char -> Char -> Ordering
      ModuleName
-> Text
-> (Value ctx
    -> Value ctx -> Value ctx -> Char -> Char -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Value ctx -> Value ctx -> Value ctx -> Char -> Char -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"ordCharImpl" 
        Value ctx
-> Value ctx -> Value ctx -> Char -> Char -> Eval ctx (Value ctx)
forall (f :: * -> *) a a.
(Applicative f, Ord a) =>
a -> a -> a -> a -> a -> f a
compareImpl
    , -- ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int
      ModuleName
-> Text
-> ((Value ctx -> Value ctx -> Eval ctx Integer)
    -> Vector (Value ctx) -> Vector (Value ctx) -> Eval ctx Integer)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Value ctx -> Value ctx -> Eval ctx Integer) -> Vector (Value ctx) -> Vector (Value ctx) -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"ordArrayImpl"
        \Value ctx -> Value ctx -> Eval ctx Integer
cmp Vector (Value ctx)
xs Vector (Value ctx)
ys ->
          (Integer -> Integer -> Integer)
-> Integer -> Vector Integer -> Integer
forall a b. (a -> b -> b) -> b -> Vector a -> b
Vector.foldr 
            (\Integer
new Integer
old -> if Integer
new Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Integer
old else Integer
new) 
            (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (Value ctx) -> Int
forall a. Vector a -> Int
Vector.length Vector (Value ctx)
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Vector (Value ctx) -> Int
forall a. Vector a -> Int
Vector.length Vector (Value ctx)
xs)) 
            (Vector Integer -> Integer)
-> Eval ctx (Vector Integer) -> Eval ctx Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value ctx -> Value ctx -> Eval ctx Integer)
-> Vector (Value ctx)
-> Vector (Value ctx)
-> Eval ctx (Vector Integer)
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 Integer
cmp Vector (Value ctx)
xs Vector (Value ctx)
ys
    ]