{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Dovetail.Core.Data.String.Unsafe where
import Data.Foldable (fold)
import Data.Text (Text)
import Data.Text qualified as Text
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.String.Unsafe"
[Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[
ModuleName -> Text -> (Integer -> Text -> Eval ctx Char) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Text -> Eval ctx Char)
ModuleName
_ModuleName Text
"charAt"
\Integer
i Text
str ->
if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
Text.length Text
str
then Char -> Eval ctx Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Int -> Char
Text.index Text
str (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i))
else EvaluationErrorType ctx -> Eval ctx Char
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
"charAt: index out of range")
, ModuleName -> Text -> (Text -> Eval ctx Char) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> Eval ctx Char)
ModuleName
_ModuleName Text
"char"
\Text
str ->
if Text -> Int
Text.length Text
str Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then Char -> Eval ctx Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Char
Text.head Text
str)
else EvaluationErrorType ctx -> Eval ctx Char
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
"char: not a singleton")
]