]> git.rkrishnan.org Git - yorgey.git/blob - hw11/AParser.hs
hw12: exercise 4
[yorgey.git] / hw11 / AParser.hs
1 module AParser (Parser, runParser, satisfy, char, posInt) where
2
3 import           Control.Applicative
4 import           Data.Char
5
6 newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }
7
8 satisfy :: (Char -> Bool) -> Parser Char
9 satisfy p = Parser f
10   where
11     f [] = Nothing
12     f (x:xs)
13         | p x       = Just (x, xs)
14         | otherwise = Nothing
15
16 char :: Char -> Parser Char
17 char c = satisfy (== c)
18
19 posInt :: Parser Integer
20 posInt = Parser f
21   where
22     f xs
23       | null ns   = Nothing
24       | otherwise = Just (read ns, rest)
25       where (ns, rest) = span isDigit xs
26
27 inParser f = Parser . f . runParser
28
29 first :: (a -> b) -> (a,c) -> (b,c)
30 first f (x,y) = (f x, y)
31
32 instance Functor Parser where
33   fmap = inParser . fmap . fmap . first
34
35 instance Applicative Parser where
36   pure a = Parser (\s -> Just (a, s))
37   (Parser fp) <*> xp = Parser $ \s ->
38     case fp s of
39       Nothing     -> Nothing
40       Just (f,s') -> runParser (f <$> xp) s'
41
42 instance Alternative Parser where
43   empty = Parser (const Nothing)
44   Parser p1 <|> Parser p2 = Parser $ liftA2 (<|>) p1 p2