Guest User

Untitled

a guest
Jan 20th, 2018
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.14 KB | None | 0 0
  1. import Text.ParserCombinators.Parsec
  2. import Data.List
  3.  
  4. type Args = [String]
  5. type Body = [String]
  6. type Label = String
  7.  
  8. data JSONProp = JSONProp Label JSON deriving Show
  9. data JSON = JSONObject [JSONProp]
  10. | JSONNumber Double
  11. | JSONBool Bool
  12. | JSONStr String
  13. | JSONArray [JSON]
  14. | JSONNull
  15. deriving Show
  16.  
  17.  
  18. eol = try (string "\n\r")
  19. <|> try (string "\r\n")
  20. <|> string "\n"
  21. <|> string "\r"
  22. <?> "EOL"
  23.  
  24. whitespace = skipMany space
  25.  
  26. parseObj = do
  27. whitespace >> char '{' >> whitespace
  28. props <- sepBy parseProps (whitespace >> char ',' >> whitespace)
  29. whitespace >> char '}' >> whitespace
  30. return $ JSONObject props
  31.  
  32. parseStr = between (char '\"') (char '\"') (many $ noneOf "\"" <|> try (string "\"\"" >> return '"'))
  33.  
  34. parseProps = do
  35. label <- parseLabel
  36. value <- (parseObj
  37. <|> parseArray
  38. <|> parseBoolean
  39. <|> parseNull
  40. <|> parseJSONStr
  41. <|> parseNumber)
  42. return $ JSONProp label value
  43.  
  44. parseLabel = do
  45. whitespace
  46. label <- parseStr
  47. whitespace >> char ':' >> whitespace
  48. return label
  49.  
  50. parseNumber = do
  51. whitespace
  52. digits <- many (digit <|> oneOf ".-")
  53. whitespace
  54. return . JSONNumber $ read digits
  55.  
  56. parseJSONStr = do
  57. whitespace
  58. str <- parseStr
  59. whitespace
  60. return $ JSONStr str
  61.  
  62. parseBoolean = do
  63. whitespace
  64. bool <- (string "true") <|> (string "false")
  65. whitespace
  66. return $ if bool == "true" then JSONBool True else JSONBool False
  67.  
  68. parseNull = do
  69. whitespace >> string "null" >> whitespace
  70. return JSONNull
  71.  
  72. parseArray = do
  73. whitespace >> char '[' >> whitespace
  74. array <- sepBy (parseObj
  75. <|> parseArray
  76. <|> parseBoolean
  77. <|> parseNull
  78. <|> parseJSONStr
  79. <|> parseNumber) (whitespace >> char ',' >> whitespace)
  80. whitespace >> char ']' >> whitespace
  81. return $ JSONArray array
  82.  
  83. toJSON :: String -> String -> Either ParseError JSON
  84. toJSON src text = parse (parseObj <|> parseArray) src text
  85.  
  86. getJSONFromFile :: String -> IO (Either ParseError JSON)
  87. getJSONFromFile file = do
  88. text <- readFile file
  89. return $ toJSON file text
  90.  
  91. searchProperties :: String -> JSON -> JSON
  92. searchProperties propName (JSONArray objs) = JSONArray $ map (searchProperties propName) objs
  93. searchProperties propName (JSONObject props) = JSONObject $ searchN [] props
  94. where
  95. searchN acc [] = acc
  96. searchN acc (n@(JSONProp label (JSONObject inner)):others) =
  97. searchN [] inner ++ if label == propName then searchN (n:acc) others else searchN acc others
  98. searchN acc (n@(JSONProp label _):others) =
  99. if label == propName then searchN (n:acc) others else searchN acc others
  100.  
  101. updateProps :: String -> (JSON -> JSON) -> JSON -> JSON
  102. updateProps propName f (JSONArray objs) = JSONArray $ map (updateProps propName f) objs
  103. updateProps propName f (JSONObject props) = JSONObject $ updateN [] props
  104. where
  105. updateN acc [] = reverse acc
  106. updateN acc (n@(JSONProp label obj):others)
  107. | label == propName = updateN (JSONProp label (f obj) : acc) others
  108. | otherwise = case obj of
  109. JSONObject inner -> updateN ((JSONProp label . JSONObject $ updateN [] inner) : acc) others
  110. otherwise -> updateN (n : acc) others
  111.  
  112. (!!) :: JSON -> String -> JSON
  113. (JSONObject props) !! property = case filter (\(JSONProp label _ ) -> label == property) props of
  114. [] -> JSONNull
  115. (JSONProp label obj) : tail -> obj
  116.  
  117. toString :: JSON -> String
  118. toString obj = toS 0 obj
  119. where
  120. ind i = replicate (i * 4) ' '
  121. propToS i (JSONProp label obj) = ind i ++ "\"" ++ label ++ "\": " ++ toS i obj
  122. toS i (JSONObject props) = "{\n" ++ (intercalate ",\n" $ map (propToS $ i + 1) props) ++ "\n" ++ ind i ++ "}"
  123. toS i (JSONArray objs) = "[" ++ (intercalate ", " $ map (toS $ i + 1) objs) ++ "\n" ++ ind i ++ "]"
  124. toS i (JSONBool bool) = if bool then "true" else "false"
  125. toS i (JSONStr str) = '"' : str ++ "\""
  126. toS i (JSONNumber n) = show n
  127. toS i JSONNull = "null"
Add Comment
Please, Sign In to add comment