I've been having trouble writing parsers recently, and I've been meaning to get to grips with Haskell at some point, so I figured I'd write a simple JSON parser using Haskell's Parsec library. Here's the code for it:

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.

   1  
   2  import Text.ParserCombinators.Parsec
   3  import System
   4  import qualified Data.Map as Map
   5  
   6  -- Main method. Currently not very interesting - just a test piece of code which accepts
   7  -- a file and prints out a representation of the parsed type (or an error message if it is
   8  -- invalid.
   9  mainParser = do {
  10      val <- valueParser
  11      ; skipMany space
  12      ; eof
  13      ; return val }
  14  
  15  main :: IO ()
  16  main = do {
  17      args <- getArgs 
  18    ; val <- parseFromFile mainParser $ args !! 0 
  19    ; print(val) } 
  20  
  21  -- Matches string literals. 
  22  literalString :: Parser JSON 
  23  literalString = do {
  24          char '"'
  25        ;  val <-  many1 letter
  26        ;  char '"'
  27        ; return $ LiteralString val}
  28  
  29  
  30  -- Data type representing a JSON AST. Roughly corresponds to a Javascript object.
  31  data JSON = ListValue [JSON] 
  32            | LiteralString String
  33            | LiteralInt Integer
  34            | LiteralBoolean Bool
  35            | RecordValue (Map.Map String JSON)
  36              deriving Show         
  37  
  38  
  39  -- Combined parser.
  40  valueParser :: Parser JSON
  41  valueParser =       
  42          literalString
  43      <|> literalInt
  44      <|> literalBoolean
  45      <|> recordParser
  46      <|> listParser 
  47  
  48  -- Matches literal integers.
  49  literalInt :: Parser JSON
  50  literalInt = do {
  51      ; val <- many1 digit
  52      ; return $ LiteralInt (read val)
  53          }
  54  
  55  -- Matches boolean literals
  56  literalBoolean :: Parser JSON
  57  literalBoolean =
  58                  do{ 
  59                    string "true"
  60                  ; return $ LiteralBoolean True}
  61              <|> do{
  62                    string "false"
  63                  ; return $ LiteralBoolean False}
  64  
  65  -- Code for parsing lists.
  66  -- Matches comma separated lists enclosed in [ ]
  67  listParser :: Parser JSON 
  68  listParser = do{ 
  69                  char '['
  70                ; words <- sepBy1 valueParser listSeparator
  71                ; char ']'
  72                ; return $ ListValue words
  73                }
  74  
  75  -- Matches ',' with any amount of space on either side.
  76  listSeparator :: Parser ()
  77  listSeparator = do{ 
  78        skipMany space 
  79      ; char ','
  80      ; skipMany space
  81  }
  82  
  83  -- Code for parsing records.
  84  -- Matches { word : JSON; word : JSON; word : value; ... }
  85  recordParser :: Parser JSON 
  86  recordParser = do{
  87        char '{'
  88      ; defs <- endBy definitionParser definitionSeparator
  89      ; char '}'
  90      ; return $ RecordValue $ Map.fromList defs 
  91  }
  92  
  93  -- Matches things of the form word : JSON
  94  definitionParser :: Parser (String, JSON)
  95  definitionParser = do{
  96        skipMany space
  97      ; key <- many1 letter 
  98      ; skipMany space
  99      ; char ':'
 100      ; skipMany space
 101      ; val <- valueParser
 102      ; return (key, val)
 103  }
 104  
 105  -- Matches ';' with any amount of space on either side.
 106  definitionSeparator :: Parser ()
 107  definitionSeparator = do {
 108        skipMany space
 109      ; char ';'
 110      ; skipMany space
 111      ; return () 
 112  }
 113  
 114