module Test.Speculate.Utils.String
( module Data.String
, module Data.Char
, unquote
, atomic
, outernmostPrec
, isNegativeLiteral
, isInfix, isPrefix, isInfixedPrefix
, toPrefix
, prec
, prime, primeCycle
, namesFromTemplate
, indent, alignRight, alignLeft
, splitAtCommas
)
where
import Data.String
import Data.Char
import Data.Functor ((<$>))
unquote :: String -> String
unquote ('"':s) | last s == '"' = init s
unquote s = s
atomic :: String -> Bool
atomic s | all (not . isSpace) s = True
atomic ('\'':s) | last s == '\'' = True
atomic ('"':s) | last s == '"' = True
atomic ('[':s) | last s == ']' = True
atomic ('(':s) | last s == ')' = True
atomic _ = False
outernmostPrec :: String -> Maybe Int
outernmostPrec s =
case words s of
[l,o,r] | isInfix o -> Just (prec o)
_ -> Nothing
isNegativeLiteral :: String -> Bool
isNegativeLiteral s | not (atomic s) = False
isNegativeLiteral "-" = False
isNegativeLiteral ('-':cs) = all isDigit cs
isNegativeLiteral _ = False
isInfix :: String -> Bool
isInfix (c:_) = c `notElem` "()'\"[" && not (isAlphaNum c)
prec :: String -> Int
prec " " = 10
prec "!!" = 9
prec "." = 9
prec "^" = 8
prec "^^" = 8
prec "**" = 8
prec "*" = 7
prec "/" = 7
prec "%" = 7
prec "+" = 6
prec "-" = 6
prec ":" = 5
prec "++" = 5
prec "\\" = 5
prec ">" = 4
prec "<" = 4
prec ">=" = 4
prec "<=" = 4
prec "==" = 4
prec "/=" = 4
prec "`elem`" = 4
prec "&&" = 3
prec "||" = 2
prec ">>=" = 1
prec ">>" = 1
prec ">=>" = 1
prec "<=<" = 1
prec "$" = 0
prec "`seq`" = 0
prec "==>" = 0
prec "<==>" = 0
prec _ = 9
isPrefix :: String -> Bool
isPrefix = not . isInfix
isInfixedPrefix :: String -> Bool
isInfixedPrefix s | not (atomic s) = False
isInfixedPrefix ('`':cs) = last cs == '`'
isInfixedPrefix _ = False
toPrefix :: String -> String
toPrefix ('`':cs) = init cs
toPrefix cs = '(':cs ++ ")"
prime :: String -> String
prime ('`':cs) = '`':init cs ++ "'`"
prime ('(':cs) = '(':init cs ++ "-)"
prime cs | isInfix cs = cs ++ "-"
| otherwise = cs ++ "'"
primeCycle :: [String] -> [String]
primeCycle [] = []
primeCycle ss = ss ++ map (++ "'") (primeCycle ss)
namesFromTemplate :: String -> [String]
namesFromTemplate = primeCycle . f
where
f "" = f "x"
f cs | isDigit (last cs) = map (\n -> init cs ++ show n) [digitToInt (last cs)..]
f [c] = map ((:[]) . chr) [x,x+1,x+2] where x = ord c
f cs | last cs == 's' = (++ "s") <$> f (init cs)
f "xy" = ["xy","zw"]
f [c,d] | ord d - ord c == 1 = [[c,d], [chr $ ord c + 2, chr $ ord d + 2]]
f cs = [cs]
alignRight :: Int -> String -> String
alignRight n cs = replicate (n - length cs) ' ' ++ cs
alignLeft :: Int -> String -> String
alignLeft n cs = cs ++ replicate (n - length cs) ' '
indent :: Int -> String -> String
indent n = unlines . map (replicate n ' ' ++) . lines
splitAtCommas :: String -> [String]
splitAtCommas = words . map commaToSpace
where
commaToSpace ',' = ' '
commaToSpace c = c