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

module Dovetail.Core.Data.Semiring where

import Data.Foldable (fold)
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.Semiring"

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- intAdd :: Int -> Int -> Int
      ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"intAdd"
        \Integer
a Integer
b -> Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)
      -- intMul :: Int -> Int -> Int
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Integer)
        ModuleName
_ModuleName Text
"intMul"
        \Integer
a Integer
b -> Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b)
      -- numAdd :: Number -> Number -> Number
    , ModuleName
-> Text -> (Double -> Double -> Eval ctx Double) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Double -> Double -> Eval ctx Double)
        ModuleName
_ModuleName Text
"numAdd"
        \Double
a Double
b -> Double -> Eval ctx Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b)
      -- numMul :: Number -> Number -> Number
    , ModuleName
-> Text -> (Double -> Double -> Eval ctx Double) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Double -> Double -> Eval ctx Double)
        ModuleName
_ModuleName Text
"numMul"
        \Double
a Double
b -> Double -> Eval ctx Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b)
    ]