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