module Data.Express.Utils.String
( module Data.Char
, unquote
, atomic
, outernmostPrec
, isNegativeLiteral
, isInfix, isPrefix, isInfixedPrefix
, toPrefix
, prec
, variableNamesFromTemplate
, primeCycle
)
where
import Data.Char
import Data.Express.Utils.List
unquote :: String -> String
unquote :: String -> String
unquote (Char
'"':String
s) | String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' = String -> String
forall a. HasCallStack => [a] -> [a]
init String
s
unquote String
s = String
s
atomic :: String -> Bool
atomic :: String -> Bool
atomic String
s | (Char -> Bool) -> String -> Bool
forall a. (a -> Bool) -> [a] -> Bool
none Char -> Bool
isSpace String
s = Bool
True
atomic (Char
'\'':String
s) | String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' = Bool
True
atomic (Char
'"':String
s) | String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' = Bool
True
atomic (Char
'[':String
s) | String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']' = Bool
True
atomic (Char
'(':String
s) | String -> Char
forall a. HasCallStack => [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' = Bool
True
atomic String
_ = Bool
False
outernmostPrec :: String -> Maybe Int
outernmostPrec :: String -> Maybe Int
outernmostPrec String
s =
case String -> [String]
words String
s of
[String
l,String
o,String
r] | String -> Bool
isInfix String
o -> Int -> Maybe Int
forall a. a -> Maybe a
Just (String -> Int
prec String
o)
[String]
_ -> Maybe Int
forall a. Maybe a
Nothing
isNegativeLiteral :: String -> Bool
isNegativeLiteral :: String -> Bool
isNegativeLiteral String
s | Bool -> Bool
not (String -> Bool
atomic String
s) = Bool
False
isNegativeLiteral String
"-" = Bool
False
isNegativeLiteral (Char
'-':String
cs) = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
cs
isNegativeLiteral String
_ = Bool
False
isInfix :: String -> Bool
isInfix :: String -> Bool
isInfix (Char
c:String
_) = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"()'\"[_" Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isAlphaNum Char
c)
isInfix String
"" = Bool
False
prec :: String -> Int
prec :: String -> Int
prec String
" " = Int
10
prec String
"!!" = Int
9
prec String
"." = Int
9
prec String
"^" = Int
8
prec String
"^^" = Int
8
prec String
"**" = Int
8
prec String
"*" = Int
7
prec String
"/" = Int
7
prec String
"%" = Int
7
prec String
"+" = Int
6
prec String
"-" = Int
6
prec String
":" = Int
5
prec String
"++" = Int
5
prec String
"\\" = Int
5
prec String
">" = Int
4
prec String
"<" = Int
4
prec String
">=" = Int
4
prec String
"<=" = Int
4
prec String
"==" = Int
4
prec String
"/=" = Int
4
prec String
"`elem`" = Int
4
prec String
"&&" = Int
3
prec String
"||" = Int
2
prec String
">>=" = Int
1
prec String
">>" = Int
1
prec String
">=>" = Int
1
prec String
"<=<" = Int
1
prec String
"$" = Int
0
prec String
"`seq`" = Int
0
prec String
"==>" = Int
0
prec String
"<==>" = Int
0
prec String
_ = Int
9
isPrefix :: String -> Bool
isPrefix :: String -> Bool
isPrefix = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isInfix
isInfixedPrefix :: String -> Bool
isInfixedPrefix :: String -> Bool
isInfixedPrefix String
s | Bool -> Bool
not (String -> Bool
atomic String
s) = Bool
False
isInfixedPrefix (Char
'`':String
cs) = String -> Char
forall a. HasCallStack => [a] -> a
last String
cs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
isInfixedPrefix String
_ = Bool
False
toPrefix :: String -> String
toPrefix :: String -> String
toPrefix (Char
'`':String
cs) = String -> String
forall a. HasCallStack => [a] -> [a]
init String
cs
toPrefix String
cs = Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
primeCycle :: [String] -> [String]
primeCycle :: [String] -> [String]
primeCycle [] = []
primeCycle [String]
ss = [String]
ss [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") ([String] -> [String]
primeCycle [String]
ss)
variableNamesFromTemplate :: String -> [String]
variableNamesFromTemplate :: String -> [String]
variableNamesFromTemplate = [String] -> [String]
primeCycle ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
f
where
f :: String -> [String]
f String
"" = String -> [String]
f String
"x"
f String
"x" = [String
"x", String
"y", String
"z"]
f String
"xy" = [String
"xy", String
"zw"]
f String
"xyz" = [String
"xyz", String
"uvw"]
f String
cs | Char -> Bool
isDigit (String -> Char
forall a. HasCallStack => [a] -> a
last String
cs) = (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> String -> String
forall a. HasCallStack => [a] -> [a]
init String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) [Char -> Int
digitToInt (String -> Char
forall a. HasCallStack => [a] -> a
last String
cs)..]
f [Char
c] | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'a'..Char
'x'] = let x :: Int
x = Char -> Int
ord Char
c in (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String) -> (Int -> Char) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr) [Int
x,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2]
f String
cs | String -> Char
forall a. HasCallStack => [a] -> a
last String
cs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
's' = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s") (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
`map` String -> [String]
f (String -> String
forall a. HasCallStack => [a] -> [a]
init String
cs)
f [Char
c,Char
d] | Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [[Char
c,Char
d], [Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2, Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2]]
f String
cs | String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"y" Bool -> Bool -> Bool
|| String
cs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"z" = String
cs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n) [Integer
1..]
f String
cs = [String
cs]