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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

type Parser = P.Parser (Token, String)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

tokenize :: String -> [(Token, String)]
tokenize :: String -> [(Token, String)]
tokenize = [(Token, String)] -> [(Token, String)]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Token, (Pos, String))] -> [(Token, (Pos, String))]
rmSpace 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
"-" forall a. [a] -> [a] -> [a]
++ String
n) 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
"-" forall a. [a] -> [a] -> [a]
++ String
n) forall a. a -> [a] -> [a]
: [(Token, String)] -> [(Token, String)]
go [(Token, String)]
xs
      (Token, String)
x : [(Token, String)]
xs -> (Token, String)
x forall a. a -> [a] -> [a]
: [(Token, String)] -> [(Token, String)]
go [(Token, String)]
xs