-- |
-- Module      : Data.Express.Utils.String
-- Copyright   : (c) 2016-2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- Utilities for manipulating strings.
--
-- At some point, this file was part of the Speculate tool.
module Data.Express.Utils.String
  ( module Data.Char
  , unquote
  , atomic
  , outernmostPrec
  , isNegativeLiteral
  , isInfix, isPrefix, isInfixedPrefix
  , toPrefix
  , prec
  , variableNamesFromTemplate
  , primeCycle
  )
where

import Data.Char

-- | Unquotes a string if possible, otherwise, this is just an identity.
--
-- > > unquote "\"string\""
-- > "string"
--
-- > > unquote "something else"
-- > "something else"
unquote :: String -> String
unquote :: String -> String
unquote (Char
'"':String
s) | String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' = String -> String
forall a. [a] -> [a]
init String
s
unquote String
s = String
s

-- | Checks if a string-encoded Haskell expression is atomic.
--
-- > > atomic "123"
-- > True
-- > > atomic "42 + 1337"
-- > False
-- > > atomic "'a'"
-- > True
-- > > atomic "[1,2,3,4,5]"
-- > True
-- > > atomic "(1,2,3,4,5)"
-- > True
--
-- FIXME: The current implementation may produce false positives:
--
-- > > atomic "'a' < 'b'"
-- > True
-- > > atomic "\"asdf\" ++ \"qwer\""
-- > True
-- > > atomic "[1,2,3] ++ [4,5,6]"
-- > True
--
-- but this does not cause problems for (all?) most cases.
atomic :: String -> Bool
atomic :: String -> Bool
atomic String
s | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
s = Bool
True
atomic (Char
'\'':String
s) | String -> Char
forall a. [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. [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. [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. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'  = Bool
True
atomic String
_ = Bool
False

-- |
-- Returns the operator precedence of an infix string.
--
-- > > outernmostPrec "1 + 2"
-- > Just 6
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

-- |
-- Returns whether the given 'String' represents a negative literal.
--
-- > > isNegativeLiteral "1"
-- > False
-- > > isNegativeLiteral "-1"
-- > True
-- > > isNegativeLiteral "-x"
-- > False
-- > > isNegativeLiteral "1 - 3"
-- > False
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

-- | Check if a function / operator is infix
--
-- > isInfix "foo"   == False
-- > isInfix "(+)"   == False
-- > isInfix "`foo`" == True
-- > isInfix "+"     == True
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
"" = String -> Bool
forall a. HasCallStack => String -> a
error String
"isInfix: empty string"

-- | Returns the precedence of default Haskell operators
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

-- | Is the given string a prefix function?
--
-- > > isPrefix "abs"
-- > True
--
-- > > isPrefix "+"
-- > False
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

-- | Is the string of the form @\`string\`@
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. [a] -> a
last String
cs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`'
isInfixedPrefix String
_                  = Bool
False

-- | Transform an infix operator into an infix function:
--
-- > toPrefix "`foo`" == "foo"
-- > toPrefix "+"     == "(+)"
toPrefix :: String -> String
toPrefix :: String -> String
toPrefix (Char
'`':String
cs) = String -> String
forall a. [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
")"

-- |
-- Cycles through a list of variable names
-- priming them at each iteration.
--
-- > primeCycle ["x","y","z"]
-- ["x","y","z","x'","y'","z'","x''","y''","z''","x'''",...]
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)

-- |
-- Returns an infinite list of variable names based on the given template.
--
-- > > variableNamesFromTemplate "x"
-- > ["x", "y", "z", "x'", "y'", ...]
--
-- > > variableNamesFromTemplate "p"
-- > ["p", "q", "r", "p'", "q'", ...]
--
-- > > variableNamesFromTemplate "xy"
-- > ["xy", "zw", "xy'", "zw'", "xy''", ...]
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"] -- redundant, for clarity
  f String
"xy"                         =  [String
"xy", String
"zw"]
  f String
"xyz"                        =  [String
"xyz", String
"uvw"]
  f String
cs    | Char -> Bool
isDigit (String -> Char
forall a. [a] -> a
last String
cs)    =  (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> String -> String
forall a. [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. [a] -> a
last String
cs)..]
  f [Char
c]   | Char
c Char -> String -> 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. [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. [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]