Functional JSON encoder / decoder.

parse_json.hs

-- Custom data types

data Value = ValueString String | ValueInt Int | ValueJson Json deriving (Show)
data KeyValuePair = KeyValuePair String Value deriving (Show)
data Json = JsonObject [KeyValuePair] | JsonArray [Value] deriving (Show)

-- Decoder

decode :: String -> Value
decode raw = v
    where (_, v) = decodeValue (tokenize raw)

decodeObject :: [String] -> [KeyValuePair] -> ([String], Json)
decodeObject ("}":ts_in) kvps = (ts_in, JsonObject kvps)
decodeObject (",":ts_in) kvps = decodeObject ts_in kvps
decodeObject (t_key:":":ts_in) kvps = decodeObject ts_rest (kvps ++ [KeyValuePair t_key val])
    where (ts_rest, val) = decodeValue ts_in

decodeArray :: [String] -> [Value] -> ([String], Json)
decodeArray ("]":ts_in) varr = (ts_in, JsonArray varr)
decodeArray (",":ts_in) varr = decodeArray ts_in varr
decodeArray ts_in varr = decodeArray ts_rest (varr ++ [val])
    where (ts_rest, val) = decodeValue ts_in

decodeValue :: [String] -> ([String], Value)
decodeValue ("{":ts) = (ts_rest, ValueJson json_val)
    where (ts_rest, json_val) = decodeObject ts []
decodeValue ("[":ts) = (ts_rest, ValueJson arr)
    where (ts_rest, arr) = decodeArray ts []
decodeValue (val:ts_rest)
    | isInt val = (ts_rest, ValueInt (read val :: Int))
    | otherwise = (ts_rest, ValueString val)

-- Encoder

encode :: Value -> String
encode (ValueString x) = x
encode (ValueInt x) = show x
encode (ValueJson (JsonObject kvps)) = encodeObject kvps
encode (ValueJson (JsonArray arr)) = encodeArray arr

encodeArray :: [Value] -> String
encodeArray x = "[" ++ concatWith (encodeArray' x []) ',' ++ "]"

encodeArray' :: [Value] -> [String] -> [String]
encodeArray' xs w = foldl (\a b -> a ++ [encode b]) w xs

encodeObject :: [KeyValuePair] -> String
encodeObject x = "{" ++ concatWith (encodeObject' x []) ',' ++ "}"

encodeObject' :: [KeyValuePair] -> [String] -> [String]
encodeObject' [] w = w
encodeObject' (KeyValuePair k v :xs) w = encodeObject' xs (w ++ [k ++ ":" ++ encode v])

-- Utility

tokenize :: String -> [String]
tokenize w = tokenize' w [] False

tokenize' :: String -> [String] -> Bool -> [String]
tokenize' [] ts _ = reverse ts
tokenize' (' ':ws) ts a = tokenize' ws ts a
tokenize' (c:ws) ts a
  | c `elem` "[,]{:}" = tokenize' ws ([c]:ts) False
tokenize' (a:ws) ts False = tokenize' ws ([a] : ts) True
tokenize' (a:ws) (t:ts) True = tokenize' ws ((t ++ [a]) : ts) True

concatWith :: [String] -> Char -> String
concatWith [] _ = ""
concatWith [w] _ = w
concatWith (w1:w2:xs) c = w1 ++ [c] ++ concatWith (w2:xs) c

isDigit c = c `elem` "01234567890" 

isInt :: String -> Bool
isInt = all isDigit