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

module Dovetail.Core.Data.Int where

import Control.Monad (when)
import Data.Char (chr, ord)
import Data.Foldable (fold)
import Data.Text (Text)
import Data.Text qualified as Text
import Dovetail
import Dovetail.Evaluate (builtIn)
import Numeric qualified

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

  [Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    [ -- fromNumberImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Number -> Maybe Int
      ModuleName
-> Text
-> ((Integer -> Eval ctx (Value ctx))
    -> Value ctx -> Double -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Integer -> Eval ctx (Value ctx)) -> Value ctx -> Double -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"fromNumberImpl" 
        \Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing (Double -> (Integer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction -> (Integer
n, Double
d)) ->
          if Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0 then Integer -> Eval ctx (Value ctx)
_just Integer
n else Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing
      -- toNumber :: Int -> Number
    , ModuleName -> Text -> (Integer -> Eval ctx Double) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Eval ctx Double)
        ModuleName
_ModuleName Text
"toNumber"
        \Integer
a -> 
          Double -> Eval ctx Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a)
      -- quot :: 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
"quot"
        \Integer
a Integer
b -> 
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
b)
      -- rem :: 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
"rem"
        \Integer
a Integer
b -> 
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
b)
      -- pow :: 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
"pow"
        \Integer
a Integer
b -> 
          Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
b)
      -- fromStringAsImpl :: (forall a. a -> Maybe a) -> (forall a. Maybe a) -> Radix -> String -> Maybe Int
    , ModuleName
-> Text
-> ((Integer -> Eval ctx (Value ctx))
    -> Value ctx -> Integer -> Text -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Integer -> Eval ctx (Value ctx)) -> Value ctx -> Integer -> Text -> Eval ctx (Value ctx))
        ModuleName
_ModuleName Text
"fromStringAsImpl"
        \Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing Integer
r Text
s -> do
          Bool -> Eval ctx () -> Eval ctx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 Bool -> Bool -> Bool
|| Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
36) do
            EvaluationErrorType ctx -> Eval ctx ()
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"fromStringAsImpl: radix must be between 2 and 36")
          let readDigit :: Char -> Int
              readDigit :: Char -> Int
readDigit Char
c 
                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
                | Bool
otherwise = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"readDigit: invalid input"
                
              isValidDigit :: Char -> Bool
              isValidDigit :: Char -> Bool
isValidDigit Char
c
                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' = Bool
True
                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z' = Bool
True
                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' = Bool
True
                | Bool
otherwise = Bool
False
          case Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
Numeric.readInt Integer
r Char -> Bool
isValidDigit Char -> Int
readDigit (Text -> [Char]
Text.unpack Text
s) of
            [(Integer
x, [Char]
"")] -> Integer -> Eval ctx (Value ctx)
_just Integer
x
            [(Integer, [Char])]
_ -> Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing
      -- toStringAs :: Radix -> Int -> String
    , ModuleName
-> Text -> (Integer -> Integer -> Eval ctx Text) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Eval ctx Text)
        ModuleName
_ModuleName Text
"toStringAs"
        \Integer
r Integer
i -> do
          Bool -> Eval ctx () -> Eval ctx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 Bool -> Bool -> Bool
|| Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
36) do
            EvaluationErrorType ctx -> Eval ctx ()
forall x (m :: * -> *) a.
(MonadError (EvaluationError x) m,
 MonadReader (EvaluationContext x) m) =>
EvaluationErrorType x -> m a
throwErrorWithContext (Text -> EvaluationErrorType ctx
forall ctx. Text -> EvaluationErrorType ctx
OtherError Text
"toStringAs: radix must be between 2 and 36")
          let showDigit :: Int -> Char
              showDigit :: Int -> Char
showDigit Int
n 
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
                | Bool
otherwise = [Char] -> Char
forall a. HasCallStack => [Char] -> a
error [Char]
"showDigit: invalid input"
          Text -> Eval ctx Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Eval ctx Text)
-> ([Char] -> Text) -> [Char] -> Eval ctx Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack ([Char] -> Eval ctx Text) -> [Char] -> Eval ctx Text
forall a b. (a -> b) -> a -> b
$ Integer -> (Int -> Char) -> Integer -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
Numeric.showIntAtBase Integer
r Int -> Char
showDigit Integer
i [Char]
""
    ]