Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- import Data.Char (isDigit, isLower, isUpper, isAlpha, isAlphaNum, isSpace)
- import Test.HUnit
- import Test.HUnit.Tools (assertRaises)
- import Control.Exception (ErrorCall(ErrorCall), evaluate)
- newtype Parser a = Parser {getParser :: String -> [(a, String)]}
- parse :: Parser a -> String -> [(a, String)]
- parse p inp = (getParser p) inp
- instance Monad Parser where
- return v = Parser $ \ inp -> [(v, inp)]
- fail s = Parser $ \ inp -> []
- p >>= f = Parser $ \ inp -> case parse p inp of
- [] -> []
- [(v, out)] -> parse (f v) out
- item :: Parser Char
- item = Parser $ \ inp -> case inp of
- [] -> []
- (x:xs) -> [(x,xs)]
- (+++) :: Parser a -> Parser a -> Parser a
- p +++ q = Parser $ \ inp -> case parse p inp of
- [] -> parse q inp
- [(v, out)] -> [(v, out)]
- tests1 :: Test
- tests1 = "+++" ~: TestList ["test1" ~: (parse (item +++ return 'd') "abc") ~?= [('a', "bc")],
- "test2" ~: (parse (fail "" +++ return 'd') "abc") ~?= [('d', "abc")],
- "test3" ~: (parse (fail "" +++ fail "") "abc") ~?= ([] :: [(Char, String)])]
- sat :: (Char -> Bool) -> Parser Char
- sat p = do x <- item
- if p x then return x else fail ""
- digit :: Parser Char
- digit = sat isDigit
- lower :: Parser Char
- lower = sat isLower
- upper :: Parser Char
- upper = sat isUpper
- letter :: Parser Char
- letter = sat isAlpha
- alphanum :: Parser Char
- alphanum = sat isAlphaNum
- char :: Char -> Parser Char
- char x = sat (==x)
- tests2 :: Test
- tests2 = "testForSat" ~:
- TestList ["test1" ~: (parse digit "123") ~?= [('1', "23")],
- "test2" ~: (parse digit "abc") ~?= [],
- "test3" ~: (parse (char 'a') "abc") ~?= [('a', "bc")],
- "test4" ~: (parse (char 'a') "123") ~?= []]
- string :: String -> Parser String
- string [] = return []
- string (x:xs) = do char x
- string xs
- return (x:xs)
- tests3 :: Test
- tests3 = "testForString" ~:
- TestList ["test1" ~: (parse (string "abc") "abcdef") ~?= [("abc", "def")],
- "test2" ~: (parse (string "abc") "ab123") ~?= []]
- many :: Parser a -> Parser [a]
- many p = many1 p +++ return []
- many1 :: Parser a -> Parser [a]
- many1 p = do v <- p
- vs <- many p
- return (v:vs)
- tests4 :: Test
- tests4 = "testForManyAndMany1" ~:
- TestList ["test1" ~: (parse (many digit) "123abc") ~?= [("123", "abc")],
- "test2" ~: (parse (many digit) "abcdef") ~?= [("", "abcdef")],
- "test3" ~: (parse (many1 digit) "abcdef") ~?= []]
- ident :: Parser String
- ident = do x <- lower
- xs <- many alphanum
- return (x:xs)
- nat :: Parser Int
- nat = do xs <- many1 digit
- return (read xs)
- space :: Parser ()
- space = do many (sat isSpace)
- return ()
- tests5 :: Test
- tests5 = "for ident nat space" ~:
- TestList ["test1" ~: (parse ident "abc def") ~?= [("abc", " def")],
- "test2" ~: (parse nat "123 abc") ~?= [(123, " abc")],
- "test3" ~: (parse space " abc" ~?= [((), "abc")])]
- token :: Parser a -> Parser a
- token p = do space
- v <- p
- space
- return v
- identifier :: Parser String
- identifier = token ident
- natural :: Parser Int
- natural = token nat
- symbol :: String -> Parser String
- symbol xs = token (string xs)
- p :: Parser [Int]
- p = do symbol "["
- n <- natural
- ns <- many (do symbol ","
- natural)
- symbol "]"
- return (n:ns)
- tests6 :: Test
- tests6 = "test:p" ~:
- TestList ["test1" ~: (parse p " [1, 2, 3] ") ~?= [([1,2,3], "")],
- "test2" ~: (parse p " [1, 2, ]") ~?= []]
- expr :: Parser Int
- expr = do t <- term
- do symbol "+"
- e <- expr
- return $ t + e
- +++ return t
- term :: Parser Int
- term = do f <- factor
- do symbol "*"
- t <- term
- return (f * t)
- +++ return f
- factor :: Parser Int
- factor = do symbol "("
- e <- expr
- symbol ")"
- return e
- +++ natural
- eval' :: String -> [(Int, String)]
- eval' xs = parse expr xs
- eval :: String -> Int
- eval xs = case parse expr xs of
- [(n, [])] -> n
- [(_, out)] -> error $ "unused input " ++ out
- [] -> error "invalid input"
- tests7 :: Test
- tests7 = "test for eval" ~:
- TestList ["test1" ~: (eval "2*3+4") ~?= 10,
- "test2" ~: (eval "2*(3+4)") ~?= 14,
- "test3" ~: (eval "2 * (3 + 4)" ~?= 14),
- "test4" ~: (assertRaises "assert" (ErrorCall "unused input wie") $ evaluate (eval "1*2wie"))]
- main :: IO Counts
- main = do
- runTestTT . TestList $ [tests1, tests2, tests3, tests4, tests5, tests6, tests7]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement