Skip to content

Instantly share code, notes, and snippets.

@hardvain
Forked from fero23/json.hs
Created January 11, 2018 07:48
Show Gist options
  • Save hardvain/39d486dace1df5663431ffc9773a9314 to your computer and use it in GitHub Desktop.
Save hardvain/39d486dace1df5663431ffc9773a9314 to your computer and use it in GitHub Desktop.
JSON Parser with Haskell's Parsec
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"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment