-- |
-- Module      : Test.Speculate.Utils.String
-- Copyright   : (c) 2016-2019 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Speculate.
--
-- Utilities for manipulating strings.
module Test.Speculate.Utils.String
  ( module Data.String
  , module Data.Char
  , unquote
  , atomic
  , outernmostPrec
  , isNegativeLiteral
  , isInfix, isPrefix, isInfixedPrefix
  , toPrefix
  , prec
  , prime
  , indent, alignRight, alignLeft
  , splitAtCommas
  )
where

import Data.String
import Data.Char
import Data.Functor ((<$>)) -- for GHC < 7.10

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

-- wrong but will work for a lot of 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

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

-- | 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

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
")"

-- Primeify the name of a function by appending prime @'@ to functions and
-- minus @-@ to operators.
--
-- > prime "(+)"   == "(+-)"
-- > prime "foo"   == "foo'"
-- > prime "`foo`" == "`foo'`"
-- > prime "*"     == "*-
prime :: String -> String
prime :: String -> String
prime (Char
'`':String
cs) = Char
'`'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
forall a. [a] -> [a]
init String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'`" -- `foo` to `foo'`
prime (Char
'(':String
cs) = Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
forall a. [a] -> [a]
init String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-)" -- (+) to (+-)
prime String
cs | String -> Bool
isInfix String
cs = String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-"    -- + to +-
         | Bool
otherwise  = String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"    -- foo to foo'

alignRight :: Int -> String -> String
alignRight :: Int -> String -> String
alignRight Int
n String
cs = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs

alignLeft :: Int -> String -> String
alignLeft :: Int -> String -> String
alignLeft Int
n String
cs = String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs) Char
' '

indent :: Int -> String -> String
indent :: Int -> String -> String
indent Int
n = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

splitAtCommas :: String -> [String]
splitAtCommas :: String -> [String]
splitAtCommas = String -> [String]
words (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
commaToSpace
  where
  commaToSpace :: Char -> Char
commaToSpace Char
',' = Char
' '
  commaToSpace  Char
c  =  Char
c
-- FIXME (uncomma): quick-and-dirty implementation
-- weird behaviour: uncomma "123 456,789" == ["123","456","789"]
-- but that's fine for speculate (Haskell symbols cannot have spaces)