Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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"
Add Comment
Please, Sign In to add comment