{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Dovetail.Core.Data.String.CodeUnits where
import Data.Foldable (fold)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
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.String.CodeUnits"
let indexOf :: Text -> Text -> Maybe Int
indexOf :: Text -> Text -> Maybe Int
indexOf Text
p Text
s =
case Text -> Text -> (Text, Text)
Text.breakOn Text
p Text
s of
(Text
_, Text
"") -> Maybe Int
forall a. Maybe a
Nothing
(Text
prefix, Text
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Text -> Int
Text.length Text
prefix)
[Env ctx] -> Env ctx
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ ModuleName -> Text -> (Char -> Eval ctx Text) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Char -> Eval ctx Text)
ModuleName
_ModuleName Text
"singleton"
\Char
c ->
Text -> Eval ctx Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Text
Text.singleton Char
c)
, ModuleName -> Text -> (Vector Char -> Eval ctx Text) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Vector Char -> Eval ctx Text)
ModuleName
_ModuleName Text
"fromCharArray"
\Vector Char
cs ->
Text -> Eval ctx Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
Text.pack (Vector Char -> String
forall a. Vector a -> [a]
Vector.toList Vector Char
cs))
, ModuleName -> Text -> (Text -> Eval ctx (Vector Char)) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> Eval ctx (Vector Char))
ModuleName
_ModuleName Text
"toCharArray"
\Text
s ->
Vector Char -> Eval ctx (Vector Char)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Vector Char
forall a. [a] -> Vector a
Vector.fromList (Text -> String
Text.unpack Text
s))
, ModuleName
-> Text
-> ((Char -> Eval ctx (Value ctx))
-> Value ctx -> Text -> Eval ctx (Value ctx))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Char -> Eval ctx (Value ctx)) -> Value ctx -> Text -> Eval ctx (Value ctx))
ModuleName
_ModuleName Text
"_toChar"
\Char -> Eval ctx (Value ctx)
_just Value ctx
_nothing Text
s ->
case Text -> Maybe (Char, Text)
Text.uncons Text
s of
Just (Char
c, Text
s') | Text -> Bool
Text.null Text
s' -> Char -> Eval ctx (Value ctx)
_just Char
c
Maybe (Char, Text)
_ -> Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing
, ModuleName
-> Text
-> ((Char -> 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 @((Char -> Eval ctx (Value ctx)) -> Value ctx -> Integer -> Text -> Eval ctx (Value ctx))
ModuleName
_ModuleName Text
"_charAt"
\Char -> Eval ctx (Value ctx)
_just Value ctx
_nothing Integer
i Text
s ->
if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
s)
then Char -> Eval ctx (Value ctx)
_just (Text -> Int -> Char
Text.index Text
s (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i))
else Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing
, ModuleName -> Text -> (Text -> Eval ctx Integer) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Text -> Eval ctx Integer)
ModuleName
_ModuleName Text
"length"
\Text
s ->
Integer -> Eval ctx Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
Text.length Text
s))
, ModuleName
-> Text
-> ((Char -> Eval ctx Bool) -> Text -> Eval ctx Integer)
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @((Char -> Eval ctx Bool) -> Text -> Eval ctx Integer)
ModuleName
_ModuleName Text
"countPrefix"
\Char -> Eval ctx Bool
p Text
s ->
let loop :: a -> String -> Eval ctx a
loop a
n [] = a -> Eval ctx a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
loop !a
n (Char
c : String
cs) = do
Bool
b <- Char -> Eval ctx Bool
p Char
c
if Bool
b then a -> String -> Eval ctx a
loop (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) String
cs
else a -> Eval ctx a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
in Integer -> String -> Eval ctx Integer
forall a. Num a => a -> String -> Eval ctx a
loop Integer
0 (Text -> String
Text.unpack Text
s)
, ModuleName
-> Text
-> ((Integer -> Eval 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 @((Integer -> Eval ctx (Value ctx)) -> Value ctx -> Text -> Text -> Eval ctx (Value ctx))
ModuleName
_ModuleName Text
"_lastIndexOf"
\Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing Text
p Text
s ->
let len :: Int
len = Text -> Int
Text.length Text
s
in Eval ctx (Value ctx)
-> (Int -> Eval ctx (Value ctx))
-> Maybe Int
-> Eval ctx (Value ctx)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing) (Integer -> Eval ctx (Value ctx)
_just (Integer -> Eval ctx (Value ctx))
-> (Int -> Integer) -> Int -> Eval ctx (Value ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
(((Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Int
indexOf Text
p (Text -> Text
Text.reverse Text
s))
, ModuleName
-> Text
-> ((Integer -> Eval ctx (Value ctx))
-> Value ctx -> Text -> 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 -> Text -> Integer -> Text -> Eval ctx (Value ctx))
ModuleName
_ModuleName Text
"_indexOfStartingAt"
\Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing Text
p (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
startAt) Text
s ->
Eval ctx (Value ctx)
-> (Int -> Eval ctx (Value ctx))
-> Maybe Int
-> Eval ctx (Value ctx)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing) (Integer -> Eval ctx (Value ctx)
_just (Integer -> Eval ctx (Value ctx))
-> (Int -> Integer) -> Int -> Eval ctx (Value ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
((Int
startAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Int
indexOf Text
p (Int -> Text -> Text
Text.drop Int
startAt Text
s))
, ModuleName
-> Text
-> ((Integer -> Eval 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 @((Integer -> Eval ctx (Value ctx)) -> Value ctx -> Text -> Text -> Eval ctx (Value ctx))
ModuleName
_ModuleName Text
"_indexOf"
\Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing Text
p Text
s ->
Eval ctx (Value ctx)
-> (Int -> Eval ctx (Value ctx))
-> Maybe Int
-> Eval ctx (Value ctx)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing) (Integer -> Eval ctx (Value ctx)
_just (Integer -> Eval ctx (Value ctx))
-> (Int -> Integer) -> Int -> Eval ctx (Value ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
(Text -> Text -> Maybe Int
indexOf Text
p Text
s)
, ModuleName
-> Text
-> ((Integer -> Eval ctx (Value ctx))
-> Value ctx -> Text -> 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 -> Text -> Integer -> Text -> Eval ctx (Value ctx))
ModuleName
_ModuleName Text
"_lastIndexOfStartingAt"
\Integer -> Eval ctx (Value ctx)
_just Value ctx
_nothing Text
p (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
startAt) Text
s ->
Eval ctx (Value ctx)
-> (Int -> Eval ctx (Value ctx))
-> Maybe Int
-> Eval ctx (Value ctx)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value ctx -> Eval ctx (Value ctx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value ctx
_nothing) (Integer -> Eval ctx (Value ctx)
_just (Integer -> Eval ctx (Value ctx))
-> (Int -> Integer) -> Int -> Eval ctx (Value ctx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
(((Int
startAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
Text.length Text
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Text -> Text -> Maybe Int
indexOf Text
p (Text -> Text
Text.reverse (Int -> Text -> Text
Text.take (Int
startAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
Text.length Text
p) Text
s)))
, ModuleName -> Text -> (Integer -> Text -> Eval ctx Text) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Text -> Eval ctx Text)
ModuleName
_ModuleName Text
"take"
\Integer
n Text
s ->
Text -> Eval ctx Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> Text
Text.take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) Text
s)
, ModuleName -> Text -> (Integer -> Text -> Eval ctx Text) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Text -> Eval ctx Text)
ModuleName
_ModuleName Text
"drop"
\Integer
n Text
s ->
Text -> Eval ctx Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> Text
Text.drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) Text
s)
, ModuleName
-> Text -> (Integer -> Integer -> Text -> Eval ctx Text) -> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Integer -> Text -> Eval ctx Text)
ModuleName
_ModuleName Text
"_slice"
\Integer
from Integer
to Text
s ->
Text -> Eval ctx Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> Text
Text.take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
from) (Int -> Text -> Text
Text.drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
from) Text
s))
, ModuleName
-> Text
-> (Integer -> Text -> Eval ctx (HashMap Text Text))
-> Env ctx
forall ctx a. ToValue ctx a => ModuleName -> Text -> a -> Env ctx
builtIn @ctx @(Integer -> Text -> Eval ctx (HashMap Text Text))
ModuleName
_ModuleName Text
"splitAt"
\Integer
i Text
s ->
case Int -> Text -> (Text, Text)
Text.splitAt (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Text
s of
(Text
before, Text
after) ->
HashMap Text Text -> Eval ctx (HashMap Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text Text -> Eval ctx (HashMap Text Text))
-> HashMap Text Text -> Eval ctx (HashMap Text Text)
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text
"before", Text
before), (Text
"after", Text
after)]
]