import System.Environment import Control.Applicative((<|>)) import Data.Char ( isAscii , isDigit ) import Data.Map import Text.ParserCombinators.ReadP data JsonValue = JsonNumber Double | JsonString String | JsonBool Bool | JsonNull | JsonArray [JsonValue] | JsonObject (Map String JsonValue) deriving Show jsonNumber :: ReadP JsonValue jsonNumber = jsonDouble <|> jsonInteger jsonDouble :: ReadP JsonValue jsonDouble = do num <- many1 (satisfy isDigit) dot <- char '.' num1 <- many1 (satisfy isDigit) return $ JsonNumber (read (num ++ [dot] ++ num1)) jsonInteger :: ReadP JsonValue jsonInteger = do num <- many1 (satisfy isDigit) return $ JsonNumber (read num) jsonNull :: ReadP JsonValue jsonNull = do string "null" return JsonNull jsonString :: ReadP JsonValue jsonString = do char '"' key <- many $ satisfy (\c -> c /= '"') char '"' return $ JsonString key jsonTrue :: ReadP JsonValue jsonTrue = do string "true" return $ JsonBool True jsonFalse :: ReadP JsonValue jsonFalse = do string "false" return $ JsonBool False jsonBool :: ReadP JsonValue jsonBool = jsonTrue <|> jsonFalse jsonArray :: ReadP JsonValue jsonArray = do char '[' skipSpaces values <- sepBy jsonValue (skipSpaces *> char ',' <* skipSpaces) skipSpaces char ']' return $ JsonArray values jsonValue :: ReadP JsonValue jsonValue = skipSpaces *> jsonNumber <|> jsonString <|> jsonNull <|> jsonObject <|> jsonBool <|> jsonArray <* skipSpaces jsonPair :: ReadP (String, JsonValue) jsonPair = do skipSpaces (JsonString key) <- jsonString skipSpaces char ':' skipSpaces value <- jsonValue return (key, value) jsonObject :: ReadP JsonValue jsonObject = do char '{' skipSpaces pairs <- sepBy jsonPair (skipSpaces *> char ',' <* skipSpaces) skipSpaces char '}' return $ JsonObject $ fromList pairs parse :: String -> Maybe JsonValue parse xs = if Prelude.null result then Nothing else resultOrFail result where result = readP_to_S (jsonObject <* skipSpaces) xs resultOrFail :: [(JsonValue,String)] -> Maybe JsonValue resultOrFail result = if Prelude.null $ snd $ last result then Just $ fst $ last result else Nothing main :: IO () main = do (file:_) <- getArgs contents <- readFile file putStr contents case parse contents of (Just json) -> print json Nothing -> putStrLn "invalid json"