CIS 194 Week 10

cis_194_hw10.hs

module AParser where

import Control.Applicative
import Data.Char

newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = Parser f
  where
    f [] = Nothing    -- fail on the empty input
    f (x:xs)          -- check if x satisfies the predicate
                        -- if so, return x along with the remainder
                        -- of the input (that is, xs)
        | p x       = Just (x, xs)
        | otherwise = Nothing  -- otherwise, fail

char :: Char -> Parser Char
char c = satisfy (== c)

posInt :: Parser Integer
posInt = Parser f
  where
    f xs
      | null ns   = Nothing
      | otherwise = Just (read ns, rest)
      where (ns, rest) = span isDigit xs

-- Ex 1

first :: (a -> b) -> (a,c) -> (b,c)
first f (x, y) = (f x, y)

instance Functor Parser where
  fmap f (Parser p) = Parser (fmap (first f) . p)

-- Ex 2

instance Applicative Parser where
  pure a = Parser $ \s -> Just (a, s)
  p1 <*> p2 = Parser $ \s -> 
     case runParser p1 s of
       Nothing -> Nothing
       Just (a, s') -> runParser (a <$> p2) s'

-- Ex 3

abParser :: Parser (Char, Char)
abParser = liftA2 (,) (char 'a') (char 'b')
  
abParser_ :: Parser ()
abParser_ = const () <$> abParser

intPair :: Parser [Integer]
intPair = liftA3 f posInt (char ' ') posInt
  where f a _ b = [a, b]

-- Ex 4

instance Alternative Parser where
  empty = Parser (const Nothing)
  p1 <|> p2 = Parser $ liftA2 (<|>) (runParser p1) (runParser p2)

-- Ex 5

intOrUppercase :: Parser ()
intOrUppercase = const () <$> posInt <|>
                 const () <$> satisfy isUpper