JSON Parser with Haskell's Parsec

json.hs

import Text.ParserCombinators.Parsec
import Data.List

type Args = [String]
type Body = [String]
type Label = String

data JSONProp = JSONProp Label JSON deriving Show
data JSON = JSONObject [JSONProp] 
          | JSONNumber Double 
          | JSONBool Bool 
          | JSONStr String 
          | JSONArray [JSON]
          | JSONNull 
          deriving Show


eol =   try (string "\n\r")
    <|> try (string "\r\n")
    <|> string "\n"
    <|> string "\r"
    <?> "EOL"

whitespace = skipMany space

parseObj = do
    whitespace >> char '{' >> whitespace
    props <- sepBy parseProps (whitespace >> char ',' >> whitespace)
    whitespace >> char '}' >> whitespace
    return $ JSONObject props
    
parseStr = between (char '\"') (char '\"') (many $ noneOf "\"" <|> try (string "\"\"" >> return '"'))

parseProps = do
    label <- parseLabel
    value <- (parseObj 
          <|> parseArray
          <|> parseBoolean
          <|> parseNull
          <|> parseJSONStr
          <|> parseNumber)
    return $ JSONProp label value

parseLabel = do
    whitespace
    label <- parseStr
    whitespace >> char ':' >> whitespace
    return label
    
parseNumber = do
    whitespace
    digits <- many (digit <|> oneOf ".-")
    whitespace
    return . JSONNumber $ read digits
    
parseJSONStr = do
    whitespace
    str <- parseStr
    whitespace
    return $ JSONStr str
    
parseBoolean = do
    whitespace
    bool <- (string "true") <|> (string "false")
    whitespace
    return $ if bool == "true" then JSONBool True else JSONBool False
        
parseNull = do
    whitespace >> string "null" >> whitespace
    return JSONNull

parseArray = do 
    whitespace >> char '[' >> whitespace
    array <- sepBy (parseObj 
                <|> parseArray
                <|> parseBoolean 
                <|> parseNull 
                <|> parseJSONStr
                <|> parseNumber) (whitespace >> char ',' >> whitespace)
    whitespace >> char ']' >> whitespace
    return $ JSONArray array
    
toJSON :: String -> String -> Either ParseError JSON
toJSON src text = parse (parseObj <|> parseArray) src text

getJSONFromFile :: String -> IO (Either ParseError JSON)
getJSONFromFile file = do
    text <- readFile file
    return $ toJSON file text
    
searchProperties :: String -> JSON -> JSON
searchProperties propName (JSONArray objs) = JSONArray $ map (searchProperties propName) objs
searchProperties propName (JSONObject props) = JSONObject $ searchN [] props
    where
        searchN acc [] = acc
        searchN acc (n@(JSONProp label (JSONObject inner)):others) =
            searchN [] inner ++ if label == propName then searchN (n:acc) others else searchN acc others
        searchN acc (n@(JSONProp label _):others) =
            if label == propName then searchN (n:acc) others else searchN acc others
                
updateProps :: String -> (JSON -> JSON) -> JSON -> JSON
updateProps propName f (JSONArray objs) = JSONArray $ map (updateProps propName f) objs
updateProps propName f (JSONObject props) = JSONObject $ updateN [] props
    where
        updateN acc [] = reverse acc
        updateN acc (n@(JSONProp label obj):others)
            | label == propName = updateN (JSONProp label (f obj) : acc) others
            | otherwise = case obj of
                JSONObject inner -> updateN ((JSONProp label . JSONObject $ updateN [] inner) : acc)  others
                otherwise -> updateN (n : acc) others
                
(!!) :: JSON -> String -> JSON
(JSONObject props) !! property = case filter (\(JSONProp label _ ) -> label == property) props of
    [] -> JSONNull
    (JSONProp label obj) : tail -> obj

toString :: JSON -> String
toString obj = toS 0 obj
    where
        ind i = replicate (i * 4) ' '
        propToS i (JSONProp label obj) = ind i ++ "\"" ++ label ++ "\": " ++ toS i obj
        toS i (JSONObject props) = "{\n" ++ (intercalate ",\n" $ map (propToS $ i + 1) props) ++ "\n" ++ ind i ++ "}"
        toS i (JSONArray objs) = "[" ++ (intercalate ", " $ map (toS $ i + 1) objs) ++ "\n" ++ ind i ++ "]"
        toS i (JSONBool bool) = if bool then "true" else "false"
        toS i (JSONStr str) = '"' : str ++ "\""
        toS i (JSONNumber n) = show n
        toS i JSONNull = "null"