117 lines
2.5 KiB
Haskell
117 lines
2.5 KiB
Haskell
import Text.ParserCombinators.Parsec
|
|
import System.Environment
|
|
import Data.List (intercalate)
|
|
|
|
data JValue = JString String
|
|
| JNumber Double
|
|
| JBool Bool
|
|
| JNull
|
|
| JObject [(String, JValue)]
|
|
| JArray [JValue]
|
|
deriving (Eq, Ord, Show)
|
|
|
|
|
|
jsonFile :: GenParser Char st JValue
|
|
jsonFile = do
|
|
result <- jsonArr <|> jsonObj
|
|
spaces
|
|
eof
|
|
return result
|
|
|
|
jsonElem :: GenParser Char st JValue
|
|
jsonElem = do
|
|
spaces
|
|
result <- jsonElem'
|
|
spaces
|
|
return result
|
|
|
|
jsonElem' = jsonArr
|
|
<|> jsonString
|
|
<|> jsonBool
|
|
<|> jsonNull
|
|
<|> jsonInt
|
|
<|> jsonObj
|
|
<?> "json element"
|
|
|
|
jsonString :: GenParser Char st JValue
|
|
jsonString = jsonStringDQ <|> jsonStringSQ
|
|
|
|
jsonStringDQ = do
|
|
char '"'
|
|
s <- many $ noneOf "\"" -- crude. does not allow double quotes within strings
|
|
char '"'
|
|
return $ JString s
|
|
|
|
jsonStringSQ = do
|
|
char '\''
|
|
s <- many $ noneOf "'" -- crude, same as above
|
|
char '\''
|
|
return $ JString s
|
|
|
|
jsonBool = do
|
|
bStr <- string "true" <|> string "false"
|
|
return $ case bStr of
|
|
"true" -> JBool True
|
|
"false" -> JBool False
|
|
|
|
jsonNull = do
|
|
string "null"
|
|
return JNull
|
|
|
|
jsonArr = do
|
|
char '['
|
|
arr <- jsonElem `sepBy` (char ',')
|
|
char ']'
|
|
return $ JArray arr
|
|
|
|
jsonInt = do
|
|
i <- many1 digit
|
|
return $ JNumber (read i :: Double)
|
|
|
|
jsonObj = do
|
|
char '{'
|
|
members <- jsonMember `sepBy` (char ',')
|
|
char '}'
|
|
return $ JObject members
|
|
|
|
jsonMember = do
|
|
spaces
|
|
key <- many $ noneOf ":"
|
|
char ':'
|
|
value <- jsonElem
|
|
return (key, value)
|
|
|
|
parseJSON :: String -> Either ParseError JValue
|
|
parseJSON input = parse jsonFile "(unknown)" input
|
|
|
|
prettyPrint :: JValue -> String
|
|
prettyPrint json = prettyPrint' json 0
|
|
|
|
prettyPrint' :: JValue -> Int -> String
|
|
prettyPrint' json indent = replicate indent ' ' ++ case json of
|
|
JString s -> show s
|
|
JNumber n -> show n
|
|
JBool b -> show b
|
|
JNull -> "null"
|
|
JArray arr -> "[\n"
|
|
++ intercalate ",\n" (map (\x -> prettyPrint' x (indent + 2)) arr)
|
|
++ "\n]"
|
|
JObject members -> "{\n"
|
|
++ intercalate ",\n" (map (
|
|
\(k, v) -> replicate (indent + 2) ' '
|
|
++ k
|
|
++ ": "
|
|
++ prettyPrint' v 0) members)
|
|
++ "\n"
|
|
++ replicate indent ' '
|
|
++ "}"
|
|
|
|
main = do
|
|
args <- getArgs
|
|
p <- parseFromFile jsonFile (head args)
|
|
case p of
|
|
Left err -> print err
|
|
Right json -> putStrLn (prettyPrint json)
|
|
|
|
|