Advertisement
NLinker

Task to implement JSON parser

Nov 20th, 2019
772
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Astyanax task
  2. https://repl.it/@astynax/ParserCombinators
  3. -------------
  4.  
  5. import Data.Char (isDigit, isSpace)
  6. -- No more imports should be here!
  7.  
  8. -- ******** Types ***********
  9.  
  10. newtype Parser a = Parser
  11.   { runParser
  12.     :: String
  13.     -- ^ parser's input
  14.     -> Maybe -- parsing can fail
  15.        ( a
  16.        -- ^ parsed value
  17.        , String
  18.        -- ^ rest of input
  19.        )
  20.   }
  21.  
  22. instance Functor Parser where
  23.   fmap = error "fmap: implement me!"
  24.  
  25. instance Applicative Parser where
  26.   pure  = error "pure: implement me!"
  27.   {-
  28.   > runParser (pure 42) "asd"
  29.   Just (42, "asd")
  30.   > runParser (pure 42) ""
  31.   Just (42, "")
  32.   -}
  33.  
  34.   -- Hint: (<*>) :: Parser (a -> b) -> Parser a -> Parser b
  35.   (<*>) = error "(<*>): implement me!"
  36.  
  37. -- ********* Elementary parsers ************
  38.  
  39. {-
  40. > runParser anyChar "ab"
  41. Just ('a', "b")
  42. > runParser anyChar "a"
  43. Just ('a', "")
  44. > runParser anyChar ""
  45. Nothing
  46. -}
  47. anyChar :: Parser Char
  48. anyChar = Parser $ \s ->
  49.   case s of
  50.     (x:xs) -> Just (x, xs)
  51.     _      -> Nothing
  52.  
  53. {-
  54. > runParser (satisfy (== 'a') anyChar) "abc"
  55. Just ('a', "bc")
  56. > runParser (satisfy isSpace anyChar) " a "
  57. Just (' ', "a ")
  58. > runParser (satisfy isSpace anyChar) "xyz"
  59. Nothing
  60. > runParser (satisfy isSpace anyChar) ""
  61. Nothing
  62. -}
  63. satisfy :: (a -> Bool) -> Parser a -> Parser a
  64. satisfy pred p = Parser $ \s ->
  65.   case runParser p s of
  66.     Just (x, xs) | pred x -> Just (x, xs)
  67.     _                     -> Nothing
  68.  
  69. {-
  70. > runParser (char '1') "123"
  71. Just ('1', "23")
  72. -}
  73. char :: Char -> Parser Char
  74. char c = satisfy (== c) anyChar
  75.  
  76. {-
  77. > runParser eof "asd"
  78. Nothing
  79. > runParser eof ""
  80. Just ((), "")
  81. -}
  82. eof :: Parser ()
  83. eof = Parser $ \s ->
  84.   case s of
  85.     [] -> Just ((), "")
  86.     _  -> Nothing
  87.  
  88. -- ********* Combinators ***********
  89. {-
  90. > runParser (char 'a' <|> char 'b') "a"
  91. Just ('a', "")
  92. > runParser (char 'a' <|> char 'b') "b"
  93. Just ('b', "")
  94. > runParser (char 'a' <|> char 'b') "c"
  95. Nothing
  96. -}
  97. (<|>) :: Parser a -> Parser a -> Parser a
  98. p1 <|> p2 = error "(<|>): implement me!"
  99.  
  100. {-
  101. > runParser (many $ char '.') ".abc"
  102. Just (".", "abc")
  103. > runParser (many $ char '.') ".....abc"
  104. Just (".....", "abc")
  105. > runParser (many $ char '.') "abc"
  106. Just ("", "abc")
  107. -}
  108. many :: Parser a -> Parser [a]
  109. many p = many1 p <|> pure []
  110.  
  111. {-
  112. > runParser (many1 $ char '.') ".abc"
  113. Just (".", "abc")
  114. > runParser (many1 $ char '.') ".....abc"
  115. Just (".....", "abc")
  116. > runParser (many1 $ char '.') "abc"
  117. Nothing
  118. -}
  119. many1 :: Parser a -> Parser [a]
  120. many1 p = (:) <$> p <*> many p
  121.  
  122. {-
  123. > runParser (between (char '{') (char '}') (many anyChar)) "{}asd"
  124. Just ("", "asd")
  125. > runParser (between (char '{') (char '}') (many anyChar)) "{as}d"
  126. Just ("as", "d")
  127. > runParser (between (char '{') (char '}') (many anyChar)) "{asd"
  128. Nothing
  129. -}
  130. between :: Parser a -> Parser b -> Parser c -> Parser c
  131. between p1 p2 p = p1 *> p <* p2
  132.  
  133. {-
  134. > runParser (sepBy (char ',') (satisfy isDigit anyChar)) "1,2,3,a"
  135. Just ("123", ",a")
  136. > runParser (sepBy (char ',') (satisfy isDigit anyChar)) "1"
  137. Just ("1", "")
  138. > runParser (sepBy (char ',') (satisfy isDigit anyChar)) ""
  139. Just ("", "")
  140. -}
  141. sepBy :: Parser a -> Parser b -> Parser [b]
  142. sepBy s p = error "sepBy: implement me!"
  143.  
  144. -- ********* Combined parsers **********
  145.  
  146. {-
  147. > runParser (string "foo") "fo"
  148. Nothing
  149. > runParser (string "foo") "foobar"
  150. Just ("foo", "bar")
  151. -}
  152. string :: String -> Parser String
  153. string = error "string: implement me!"
  154.  
  155. -- *********** Simple JSON parser *****************
  156. -- * incomplete(!), i.e. w/o any advanced stuff like special char escaping, spaces, etc
  157.  
  158. data JSON
  159.   = JNull
  160.   | JBool Bool
  161.   | JNum Int
  162.   | JString String
  163.   | JArray [JSON]
  164.   | JObject [(String, JSON)]
  165.   deriving (Show)
  166.  
  167. quotedString :: Parser String
  168. quotedString = between (char '"') (char '"') $ many (satisfy (/= '"') anyChar)
  169.  
  170. jnull, jbool, jnum, jstring, jarray, jobject, json :: Parser JSON
  171. json    = jnull <|> jbool <|> jnum <|> jstring <|> jarray <|> jobject
  172. jnull   = JNull <$ string "null"
  173. jbool   = JBool <$> ((True <$ string "true") <|> (False <$ string "false"))
  174. jnum    = error "jnum: implement me!"
  175. jstring = JString <$> quotedString
  176. jarray  = JArray <$> between (char '[') (char ']') (sepBy (char ',') json)
  177. jobject = JObject <$> between (char '{') (char '}')
  178.    (sepBy (char ',') $ (,) <$> quotedString <* char ':' <*> json)
  179.  
  180. -- ************** Some tests
  181.  
  182. main :: IO ()
  183. main = do
  184.   putStrLn "These ones should parse something"
  185.   print $ runParser jnull "null"
  186.   print $ runParser jbool "true"
  187.   print $ runParser jnum "123"
  188.   print $ runParser jstring "\"abc\""
  189.   print $ runParser jarray "[]"
  190.   print $ runParser jarray "[null]"
  191.   print $ runParser jarray "[true,false]"
  192.   print $ runParser jobject "{}"
  193.   print $ runParser jobject "{\"a\":null}"
  194.   print $ runParser (json <* eof) "{\"a\":[1,null,false,\"foo\",{}],\"b\":true}"
  195.   putStrLn "This one should fail:"
  196.   print $ runParser (json <* eof) "{\"a\":[1,null,false,\"foo\",{}],\"b\":true}blabla"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement