Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Astyanax task
- https://repl.it/@astynax/ParserCombinators
- -------------
- import Data.Char (isDigit, isSpace)
- -- No more imports should be here!
- -- ******** Types ***********
- newtype Parser a = Parser
- { runParser
- :: String
- -- ^ parser's input
- -> Maybe -- parsing can fail
- ( a
- -- ^ parsed value
- , String
- -- ^ rest of input
- )
- }
- instance Functor Parser where
- fmap = error "fmap: implement me!"
- instance Applicative Parser where
- pure = error "pure: implement me!"
- {-
- > runParser (pure 42) "asd"
- Just (42, "asd")
- > runParser (pure 42) ""
- Just (42, "")
- -}
- -- Hint: (<*>) :: Parser (a -> b) -> Parser a -> Parser b
- (<*>) = error "(<*>): implement me!"
- -- ********* Elementary parsers ************
- {-
- > runParser anyChar "ab"
- Just ('a', "b")
- > runParser anyChar "a"
- Just ('a', "")
- > runParser anyChar ""
- Nothing
- -}
- anyChar :: Parser Char
- anyChar = Parser $ \s ->
- case s of
- (x:xs) -> Just (x, xs)
- _ -> Nothing
- {-
- > runParser (satisfy (== 'a') anyChar) "abc"
- Just ('a', "bc")
- > runParser (satisfy isSpace anyChar) " a "
- Just (' ', "a ")
- > runParser (satisfy isSpace anyChar) "xyz"
- Nothing
- > runParser (satisfy isSpace anyChar) ""
- Nothing
- -}
- satisfy :: (a -> Bool) -> Parser a -> Parser a
- satisfy pred p = Parser $ \s ->
- case runParser p s of
- Just (x, xs) | pred x -> Just (x, xs)
- _ -> Nothing
- {-
- > runParser (char '1') "123"
- Just ('1', "23")
- -}
- char :: Char -> Parser Char
- char c = satisfy (== c) anyChar
- {-
- > runParser eof "asd"
- Nothing
- > runParser eof ""
- Just ((), "")
- -}
- eof :: Parser ()
- eof = Parser $ \s ->
- case s of
- [] -> Just ((), "")
- _ -> Nothing
- -- ********* Combinators ***********
- {-
- > runParser (char 'a' <|> char 'b') "a"
- Just ('a', "")
- > runParser (char 'a' <|> char 'b') "b"
- Just ('b', "")
- > runParser (char 'a' <|> char 'b') "c"
- Nothing
- -}
- (<|>) :: Parser a -> Parser a -> Parser a
- p1 <|> p2 = error "(<|>): implement me!"
- {-
- > runParser (many $ char '.') ".abc"
- Just (".", "abc")
- > runParser (many $ char '.') ".....abc"
- Just (".....", "abc")
- > runParser (many $ char '.') "abc"
- Just ("", "abc")
- -}
- many :: Parser a -> Parser [a]
- many p = many1 p <|> pure []
- {-
- > runParser (many1 $ char '.') ".abc"
- Just (".", "abc")
- > runParser (many1 $ char '.') ".....abc"
- Just (".....", "abc")
- > runParser (many1 $ char '.') "abc"
- Nothing
- -}
- many1 :: Parser a -> Parser [a]
- many1 p = (:) <$> p <*> many p
- {-
- > runParser (between (char '{') (char '}') (many anyChar)) "{}asd"
- Just ("", "asd")
- > runParser (between (char '{') (char '}') (many anyChar)) "{as}d"
- Just ("as", "d")
- > runParser (between (char '{') (char '}') (many anyChar)) "{asd"
- Nothing
- -}
- between :: Parser a -> Parser b -> Parser c -> Parser c
- between p1 p2 p = p1 *> p <* p2
- {-
- > runParser (sepBy (char ',') (satisfy isDigit anyChar)) "1,2,3,a"
- Just ("123", ",a")
- > runParser (sepBy (char ',') (satisfy isDigit anyChar)) "1"
- Just ("1", "")
- > runParser (sepBy (char ',') (satisfy isDigit anyChar)) ""
- Just ("", "")
- -}
- sepBy :: Parser a -> Parser b -> Parser [b]
- sepBy s p = error "sepBy: implement me!"
- -- ********* Combined parsers **********
- {-
- > runParser (string "foo") "fo"
- Nothing
- > runParser (string "foo") "foobar"
- Just ("foo", "bar")
- -}
- string :: String -> Parser String
- string = error "string: implement me!"
- -- *********** Simple JSON parser *****************
- -- * incomplete(!), i.e. w/o any advanced stuff like special char escaping, spaces, etc
- data JSON
- = JNull
- | JBool Bool
- | JNum Int
- | JString String
- | JArray [JSON]
- | JObject [(String, JSON)]
- deriving (Show)
- quotedString :: Parser String
- quotedString = between (char '"') (char '"') $ many (satisfy (/= '"') anyChar)
- jnull, jbool, jnum, jstring, jarray, jobject, json :: Parser JSON
- json = jnull <|> jbool <|> jnum <|> jstring <|> jarray <|> jobject
- jnull = JNull <$ string "null"
- jbool = JBool <$> ((True <$ string "true") <|> (False <$ string "false"))
- jnum = error "jnum: implement me!"
- jstring = JString <$> quotedString
- jarray = JArray <$> between (char '[') (char ']') (sepBy (char ',') json)
- jobject = JObject <$> between (char '{') (char '}')
- (sepBy (char ',') $ (,) <$> quotedString <* char ':' <*> json)
- -- ************** Some tests
- main :: IO ()
- main = do
- putStrLn "These ones should parse something"
- print $ runParser jnull "null"
- print $ runParser jbool "true"
- print $ runParser jnum "123"
- print $ runParser jstring "\"abc\""
- print $ runParser jarray "[]"
- print $ runParser jarray "[null]"
- print $ runParser jarray "[true,false]"
- print $ runParser jobject "{}"
- print $ runParser jobject "{\"a\":null}"
- print $ runParser (json <* eof) "{\"a\":[1,null,false,\"foo\",{}],\"b\":true}"
- putStrLn "This one should fail:"
- print $ runParser (json <* eof) "{\"a\":[1,null,false,\"foo\",{}],\"b\":true}blabla"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement