Tiny JSON Parser

json.hs

import Control.Applicative ((<$>), (<$), (<*>), (<*), (*>))
import Prelude hiding (null)
import Text.Parsec hiding (string)
import Text.Parsec.Language (javaStyle)
import qualified Text.Parsec.Token as P

data Value = S String | N Double | O [(String, Value)] | A [Value] | B Bool | Null deriving Show

lexer = P.makeTokenParser javaStyle
symbol = P.symbol lexer
reserved = P.reserved lexer
whiteSpace = P.whiteSpace lexer
braces = P.braces lexer
brackets = P.brackets lexer
colon = P.colon lexer
comma = P.comma lexer
commaSep = P.commaSep lexer
naturalOrFloat = P.naturalOrFloat lexer
stringLiteral = P.stringLiteral lexer

number = N <$> (sig <*> num) <?> "number"
  where
    sig = option id ((* (-1)) <$ symbol "-")
    num = merge <$> naturalOrFloat
    merge (Left i) = fromInteger i
    merge (Right d) = d 

object = O <$> braces (commaSep pair) <?> "object"
  where
    pair = (,) <$> (unS <$> string <* colon) <*> value
    unS (S key) = key 
    unS _ = error "object:logic error"

string = S <$> stringLiteral <?> "string"
array = A <$> brackets (commaSep value) <?> "array"
bool = try (B True <$ reserved "true") <|> try (B False <$ reserved "false")
null = Null <$ reserved "null"
value = try string <|> try number <|> try object <|> try array <|> try bool <|> try null <?> "value"
json = whiteSpace *> value

main = getContents >>= print . parse json ""

result

u@c:~$ echo '1' | ./json
Right (N 1.0)
u@c:~$ echo '-2.34' | ./json
Right (N (-2.34))
u@c:~$ echo '[1,2,3]' | ./json
Right (A [N 1.0,N 2.0,N 3.0])
u@c:~$ echo ' { "hoge" : { "fuga" : 1.23}, "piyo" : [1,2,3] } ' | ./json
Right (O [("hoge",O [("fuga",N 1.23)]),("piyo",A [N 1.0,N 2.0,N 3.0])])