module Data.DSON.Parse(parseDson, DSON(..)) where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (liftM)
import Text.Parsec hiding (Empty)
import Text.Parsec.String
import Text.Parsec.Combinator
import Text.Parsec.Language (javaStyle)
import qualified Text.Parsec.Token as P
data DSON = Str String
| Object [(String, DSON)]
| Array [DSON]
| Number Double
| No
| Yes
| Empty
deriving (Show, Eq)
parseDson :: String -> Maybe DSON
parseDson s = either (const Nothing) Just result
where result = parse topLevel "" s
topLevel :: Parser DSON
topLevel = try objectP <|> arrayP
valueP :: Parser DSON
valueP = try strP
<|> try numberP
<|> try objectP
<|> try arrayP
<|> try (symbol "yes" >> return Yes)
<|> try (symbol "no" >> return No)
<|> (symbol "empty" >> return Empty)
objectP :: Parser DSON
objectP = do symbol "such"
tups <- optTuplesP
symbol "wow"
return $ Object tups
where optTuplesP = option [] ((:) <$> tupleP <*> tuplesP)
tuplesP = many (separatorP >> tupleP)
tupleP = do str <- stringLiteral
symbol "is"
v <- valueP
return (str, v)
separatorP = try (symbol "next")
<|> try (symbol ",")
<|> try (symbol ".")
<|> try (symbol "!")
<|> symbol "?"
arrayP :: Parser DSON
arrayP = do symbol "so"
vs <- valuesP
symbol "many"
return $ Array vs
where valuesP = (:) <$> valueP <*> many (separatorP >> valueP)
separatorP = try (symbol "and") <|> symbol "also"
strP :: Parser DSON
strP = fmap Str stringLiteral
numberP :: Parser DSON
numberP = do factor <- option 1 (char '-' >> return (1))
n <- natOrFloat
ex <- option 1 (veryP >> integer)
return $ Number ((factor * n) ** fromInteger ex)
where veryP = try (symbol "very") <|> symbol "VERY"
natOrFloat = liftM (either fromInteger id) naturalOrFloat
lexer = P.makeTokenParser javaStyle
symbol = P.symbol lexer
stringLiteral = P.stringLiteral lexer
float = P.float lexer
integer = P.integer lexer
naturalOrFloat = P.naturalOrFloat lexer