Update: I've modified this to use Data.Map instead of a list of key value pairs for the record / object implementation. I've also removed the 'identifier' feature as it isn't really part of JSON proper. Also, I've noticed that this seems to have acquired some sort of presence on google. This isn't really very good code - it's more a demonstration of parsec than it is an actually useful parser. (I mean, it works fine, and it's probably sufficient for trivial uses, but I wouldn't e.g. guarantee it to be bug free). I strongly recommend using this one instead.
import Text.ParserCombinators.Parsec import System import qualified Data.Map as Map -- Main method. Currently not very interesting - just a test piece of code which accepts -- a file and prints out a representation of the parsed type (or an error message if it is -- invalid. mainParser = do { val <- valueParser ; skipMany space ; eof ; return val } main :: IO () main = do { args <- getArgs ; val <- parseFromFile mainParser $ args !! 0 ; print(val) } -- Matches string literals. literalString :: Parser JSON literalString = do { char '"' ; val <- many1 letter ; char '"' ; return $ LiteralString val} -- Data type representing a JSON AST. Roughly corresponds to a Javascript object. data JSON = ListValue [JSON] | LiteralString String | LiteralInt Integer | LiteralBoolean Bool | RecordValue (Map.Map String JSON) deriving Show -- Combined parser. valueParser :: Parser JSON valueParser = literalString <|> literalInt <|> literalBoolean <|> recordParser <|> listParser -- Matches literal integers. literalInt :: Parser JSON literalInt = do { ; val <- many1 digit ; return $ LiteralInt (read val) } -- Matches boolean literals literalBoolean :: Parser JSON literalBoolean = do{ string "true" ; return $ LiteralBoolean True} <|> do{ string "false" ; return $ LiteralBoolean False} -- Code for parsing lists. -- Matches comma separated lists enclosed in [ ] listParser :: Parser JSON listParser = do{ char '[' ; words <- sepBy1 valueParser listSeparator ; char ']' ; return $ ListValue words } -- Matches ',' with any amount of space on either side. listSeparator :: Parser () listSeparator = do{ skipMany space ; char ',' ; skipMany space } -- Code for parsing records. -- Matches { word : JSON; word : JSON; word : value; ... } recordParser :: Parser JSON recordParser = do{ char '{' ; defs <- endBy definitionParser definitionSeparator ; char '}' ; return $ RecordValue $ Map.fromList defs } -- Matches things of the form word : JSON definitionParser :: Parser (String, JSON) definitionParser = do{ skipMany space ; key <- many1 letter ; skipMany space ; char ':' ; skipMany space ; val <- valueParser ; return (key, val) } -- Matches ';' with any amount of space on either side. definitionSeparator :: Parser () definitionSeparator = do { skipMany space ; char ';' ; skipMany space ; return () }