module Test.Hspec.Core.Formatters.Pretty.Parser (
  Value(..)
, parseValue
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           Test.Hspec.Core.Formatters.Pretty.Parser.Parser hiding (Parser)
import qualified Test.Hspec.Core.Formatters.Pretty.Parser.Parser as P

import           Language.Haskell.Lexer hiding (Pos(..))

type Name = String

data Value =
    Char Char
  | String String
  | Rational Value Value
  | Number String
  | Record Name [(Name, Value)]
  | Constructor Name [Value]
  | Tuple [Value]
  | List [Value]
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

type Parser = P.Parser (Token, String)

parseValue :: String -> Maybe Value
parseValue :: String -> Maybe Value
parseValue String
input = case Parser (Token, String) Value
-> [(Token, String)] -> Maybe (Value, [(Token, String)])
forall token a. Parser token a -> [token] -> Maybe (a, [token])
runParser Parser (Token, String) Value
value (String -> [(Token, String)]
tokenize String
input) of
  Just (Value
v, []) -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
  Maybe (Value, [(Token, String)])
_ -> Maybe Value
forall a. Maybe a
Nothing

value :: Parser Value
value :: Parser (Token, String) Value
value =
      Parser (Token, String) Value
char
  Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
string
  Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
rational
  Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
number
  Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
record
  Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
constructor
  Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
tuple
  Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
list

char :: Parser Value
char :: Parser (Token, String) Value
char = Char -> Value
Char (Char -> Value)
-> Parser (Token, String) Char -> Parser (Token, String) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> Parser String
token Token
CharLit Parser String
-> (String -> Parser (Token, String) Char)
-> Parser (Token, String) Char
forall a b.
Parser (Token, String) a
-> (a -> Parser (Token, String) b) -> Parser (Token, String) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser (Token, String) Char
forall (m :: * -> *) a. (Alternative m, Read a) => String -> m a
readA)

string :: Parser Value
string :: Parser (Token, String) Value
string = String -> Value
String (String -> Value) -> Parser String -> Parser (Token, String) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> Parser String
token Token
StringLit Parser String -> (String -> Parser String) -> Parser String
forall a b.
Parser (Token, String) a
-> (a -> Parser (Token, String) b) -> Parser (Token, String) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Parser String
forall (m :: * -> *) a. (Alternative m, Read a) => String -> m a
readA)

rational :: Parser Value
rational :: Parser (Token, String) Value
rational = Value -> Value -> Value
Rational (Value -> Value -> Value)
-> Parser (Token, String) Value
-> Parser (Token, String) (Value -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser (Token, String) Value
number Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
tuple) Parser (Token, String) (Value -> Value)
-> Parser (Token, String) ()
-> Parser (Token, String) (Value -> Value)
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Token, String) -> Parser (Token, String) ()
require (Token
Varsym, String
"%") Parser (Token, String) (Value -> Value)
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a b.
Parser (Token, String) (a -> b)
-> Parser (Token, String) a -> Parser (Token, String) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Token, String) Value
number

number :: Parser Value
number :: Parser (Token, String) Value
number = Parser (Token, String) Value
integer Parser (Token, String) Value
-> Parser (Token, String) Value -> Parser (Token, String) Value
forall a.
Parser (Token, String) a
-> Parser (Token, String) a -> Parser (Token, String) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Token, String) Value
float
  where
    integer :: Parser Value
    integer :: Parser (Token, String) Value
integer = String -> Value
Number (String -> Value) -> Parser String -> Parser (Token, String) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> Parser String
token Token
IntLit

    float :: Parser Value
    float :: Parser (Token, String) Value
float = String -> Value
Number (String -> Value) -> Parser String -> Parser (Token, String) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> Parser String
token Token
FloatLit

record :: Parser Value
record :: Parser (Token, String) Value
record = String -> [(String, Value)] -> Value
Record (String -> [(String, Value)] -> Value)
-> Parser String
-> Parser (Token, String) ([(String, Value)] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> Parser String
token Token
Conid Parser (Token, String) ([(String, Value)] -> Value)
-> Parser (Token, String) ()
-> Parser (Token, String) ([(String, Value)] -> Value)
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser (Token, String) ()
special String
"{" Parser (Token, String) ([(String, Value)] -> Value)
-> Parser (Token, String) [(String, Value)]
-> Parser (Token, String) Value
forall a b.
Parser (Token, String) (a -> b)
-> Parser (Token, String) a -> Parser (Token, String) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Token, String) [(String, Value)]
fields Parser (Token, String) Value
-> Parser (Token, String) () -> Parser (Token, String) Value
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser (Token, String) ()
special String
"}"
  where
    fields :: Parser [(Name, Value)]
    fields :: Parser (Token, String) [(String, Value)]
fields = Parser (String, Value)
field Parser (String, Value)
-> Parser (Token, String) ()
-> Parser (Token, String) [(String, Value)]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy1` Parser (Token, String) ()
comma

    field :: Parser (Name, Value)
    field :: Parser (String, Value)
field = (,) (String -> Value -> (String, Value))
-> Parser String
-> Parser (Token, String) (Value -> (String, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> Parser String
token Token
Varid Parser (Token, String) (Value -> (String, Value))
-> Parser (Token, String) ()
-> Parser (Token, String) (Value -> (String, Value))
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser (Token, String) ()
equals Parser (Token, String) (Value -> (String, Value))
-> Parser (Token, String) Value -> Parser (String, Value)
forall a b.
Parser (Token, String) (a -> b)
-> Parser (Token, String) a -> Parser (Token, String) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Token, String) Value
value

constructor :: Parser Value
constructor :: Parser (Token, String) Value
constructor = String -> [Value] -> Value
Constructor (String -> [Value] -> Value)
-> Parser String -> Parser (Token, String) ([Value] -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> Parser String
token Token
Conid Parser (Token, String) ([Value] -> Value)
-> Parser (Token, String) [Value] -> Parser (Token, String) Value
forall a b.
Parser (Token, String) (a -> b)
-> Parser (Token, String) a -> Parser (Token, String) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Token, String) Value -> Parser (Token, String) [Value]
forall a. Parser (Token, String) a -> Parser (Token, String) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser (Token, String) Value
value

tuple :: Parser Value
tuple :: Parser (Token, String) Value
tuple = [Value] -> Value
Tuple ([Value] -> Value)
-> Parser (Token, String) [Value] -> Parser (Token, String) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser (Token, String) ()
special String
"(" Parser (Token, String) ()
-> Parser (Token, String) [Value] -> Parser (Token, String) [Value]
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Token, String) [Value]
items) Parser (Token, String) Value
-> Parser (Token, String) () -> Parser (Token, String) Value
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser (Token, String) ()
special String
")"

list :: Parser Value
list :: Parser (Token, String) Value
list = [Value] -> Value
List ([Value] -> Value)
-> Parser (Token, String) [Value] -> Parser (Token, String) Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser (Token, String) ()
special String
"[" Parser (Token, String) ()
-> Parser (Token, String) [Value] -> Parser (Token, String) [Value]
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Token, String) [Value]
items) Parser (Token, String) Value
-> Parser (Token, String) () -> Parser (Token, String) Value
forall a b.
Parser (Token, String) a
-> Parser (Token, String) b -> Parser (Token, String) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser (Token, String) ()
special String
"]"

items :: Parser [Value]
items :: Parser (Token, String) [Value]
items = Parser (Token, String) Value
value Parser (Token, String) Value
-> Parser (Token, String) () -> Parser (Token, String) [Value]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy` Parser (Token, String) ()
comma

special :: String -> Parser ()
special :: String -> Parser (Token, String) ()
special String
s = (Token, String) -> Parser (Token, String) ()
require (Token
Special, String
s)

comma :: Parser ()
comma :: Parser (Token, String) ()
comma = String -> Parser (Token, String) ()
special String
","

equals :: Parser ()
equals :: Parser (Token, String) ()
equals = (Token, String) -> Parser (Token, String) ()
require (Token
Reservedop, String
"=")

token :: Token -> Parser String
token :: Token -> Parser String
token Token
t = (Token, String) -> String
forall a b. (a, b) -> b
snd ((Token, String) -> String)
-> Parser (Token, String) (Token, String) -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Token, String) -> Bool) -> Parser (Token, String) (Token, String)
forall token. (token -> Bool) -> Parser token token
satisfy ((Token, String) -> Token
forall a b. (a, b) -> a
fst ((Token, String) -> Token)
-> (Token -> Bool) -> (Token, String) -> Bool
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
t))

require :: (Token, String) -> Parser ()
require :: (Token, String) -> Parser (Token, String) ()
require (Token, String)
t = Parser (Token, String) (Token, String) -> Parser (Token, String) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser (Token, String) (Token, String)
 -> Parser (Token, String) ())
-> Parser (Token, String) (Token, String)
-> Parser (Token, String) ()
forall a b. (a -> b) -> a -> b
$ ((Token, String) -> Bool) -> Parser (Token, String) (Token, String)
forall token. (token -> Bool) -> Parser token token
satisfy ((Token, String) -> (Token, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (Token, String)
t)

tokenize :: String -> [(Token, String)]
tokenize :: String -> [(Token, String)]
tokenize = [(Token, String)] -> [(Token, String)]
go ([(Token, String)] -> [(Token, String)])
-> (String -> [(Token, String)]) -> String -> [(Token, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Token, (Pos, String)) -> (Token, String))
-> [(Token, (Pos, String))] -> [(Token, String)]
forall a b. (a -> b) -> [a] -> [b]
map (((Pos, String) -> String)
-> (Token, (Pos, String)) -> (Token, String)
forall a b. (a -> b) -> (Token, a) -> (Token, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pos, String) -> String
forall a b. (a, b) -> b
snd) ([(Token, (Pos, String))] -> [(Token, String)])
-> (String -> [(Token, (Pos, String))])
-> String
-> [(Token, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Token, (Pos, String))] -> [(Token, (Pos, String))]
rmSpace ([(Token, (Pos, String))] -> [(Token, (Pos, String))])
-> (String -> [(Token, (Pos, String))])
-> String
-> [(Token, (Pos, String))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Token, (Pos, String))]
lexerPass0
  where
    go :: [(Token, String)] -> [(Token, String)]
    go :: [(Token, String)] -> [(Token, String)]
go [(Token, String)]
tokens = case [(Token, String)]
tokens of
      [] -> []
      (Token
Varsym, String
"-") : (Token
IntLit, String
n) : [(Token, String)]
xs -> (Token
IntLit, String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n) (Token, String) -> [(Token, String)] -> [(Token, String)]
forall a. a -> [a] -> [a]
: [(Token, String)] -> [(Token, String)]
go [(Token, String)]
xs
      (Token
Varsym, String
"-") : (Token
FloatLit, String
n) : [(Token, String)]
xs -> (Token
FloatLit, String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n) (Token, String) -> [(Token, String)] -> [(Token, String)]
forall a. a -> [a] -> [a]
: [(Token, String)] -> [(Token, String)]
go [(Token, String)]
xs
      (Token, String)
x : [(Token, String)]
xs -> (Token, String)
x (Token, String) -> [(Token, String)] -> [(Token, String)]
forall a. a -> [a] -> [a]
: [(Token, String)] -> [(Token, String)]
go [(Token, String)]
xs