hw10/AParser.hs

   1 {- CIS 194 HW 10
   2    due Monday, 1 April
   3 -}
   4
   5 module AParser where
   6
   7 import           Control.Applicative
   8
   9 import           Data.Char
  10
  11 -- A parser for a value of type a is a function which takes a String
  12 -- represnting the input to be parsed, and succeeds or fails; if it
  13 -- succeeds, it returns the parsed value along with the remainder of
  14 -- the input.
  15 newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }
  16
  17 -- For example, 'satisfy' takes a predicate on Char, and constructs a
  18 -- parser which succeeds only if it sees a Char that satisfies the
  19 -- predicate (which it then returns).  If it encounters a Char that
  20 -- does not satisfy the predicate (or an empty input), it fails.
  21 satisfy :: (Char -> Bool) -> Parser Char
  22 satisfy p = Parser f
  23   where
  24     f [] = Nothing    -- fail on the empty input
  25     f (x:xs)          -- check if x satisfies the predicate
  26                         -- if so, return x along with the remainder
  27                         -- of the input (that is, xs)
  28         | p x       = Just (x, xs)
  29         | otherwise = Nothing  -- otherwise, fail
  30
  31 -- Using satisfy, we can define the parser 'char c' which expects to
  32 -- see exactly the character c, and fails otherwise.
  33 char :: Char -> Parser Char
  34 char c = satisfy (== c)
  35
  36 {- For example:
  37
  38 *Parser> runParser (satisfy isUpper) "ABC"
  39 Just ('A',"BC")
  40 *Parser> runParser (satisfy isUpper) "abc"
  41 Nothing
  42 *Parser> runParser (char 'x') "xyz"
  43 Just ('x',"yz")
  44
  45 -}
  46
  47 -- For convenience, we've also provided a parser for positive
  48 -- integers.
  49 posInt :: Parser Integer
  50 posInt = Parser f
  51   where
  52     f xs
  53       | null ns   = Nothing
  54       | otherwise = Just (read ns, rest)
  55       where (ns, rest) = span isDigit xs
  56
  57 ------------------------------------------------------------
  58 -- Your code goes below here
  59 ------------------------------------------------------------
  60
  61 -- Exercise 1. functor instance for Parser
  62 instance Functor Parser where
  63     -- Parser a == String -> (a, String)
  64     -- first :: (a -> b) -> (a, c) -> (b, c)
  65     -- fmap :: (a -> b) -> Parser a -> Parser b
  66     fmap f (Parser pf) = Parser (\s -> case (pf s) of
  67                                          Nothing -> Nothing
  68                                          Just v -> Just $ (uncurry (first f) v))
  69         where first f' a b = (f' a, b)
  70
  71 -- Exercise 2. Applicative instance of Parser
  72 instance Applicative Parser where
  73     -- pure :: a -> Parser a
  74     pure x = Parser (\inp -> Just (x, inp))
  75     -- --  (<*>) :: Parser (a -> b) -> Parser a -> Parser b
  76     -- -- Parser (a -> b) == String -> Maybe (a -> b, String)
  77     -- -- Parser a == String -> Maybe (a, String)
  78     -- one possible implementation.
  79     (Parser pf) <*> (Parser p2) = Parser (\inp -> case (pf inp) of
  80                                                     Nothing -> Nothing
  81                                                     Just (f, remStr) -> case (p2 remStr) of
  82                                                                           Nothing -> Nothing
  83                                                                           Just (vp2, s) -> Just ((f vp2), s))
  84 -- Exercise 3
  85 abParser :: Parser (Char, Char)
  86 -- (,) :: a -> b -> (a,b)
  87 -- char 'a' :: Parser Char
  88 -- fmap f x :: (a -> b) -> f a -> f b
  89 -- fmap (,) (char 'a') :: (Char -> (b -> (Char,b))) -> Parser Char -> Parser (b -> (Char, b))
  90 -- so output if fmap (,) (char 'a') is of type --- Parser (b -> (Char, b))
  91 -- now, p <*> char 'b' :: Parser (b -> (Char, b)) -> Parser Char -> Parser (Char, Char)
  92 abParser = (,) <$> char 'a' <*> char 'b'
  93
  94 abParser_ :: Parser ()
  95 abParser_ = (\_ _ -> ()) <$> char 'a' <*> char 'b'
  96
  97 intPair :: Parser [Integer]
  98 intPair = (\x _ z -> x : z : []) <$> posInt <*> char ' ' <*> posInt