daily pastebin goal
7%
SHARE
TWEET

Untitled

a guest Jan 20th, 2018 55 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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"
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top