Lecture 19 — 2015-11-11

Parsing with Applicative

This lecture is written in literate Haskell; you can download the raw source.

module Lec19 where

import Control.Applicative
import Control.Monad
import Data.Char

import qualified Data.Map as Map
import Data.Map (Map, (!))

import Lec18 hiding (name, map)

First, we remembered the definitions of Functor and Applicative from last time.

name :: Maybe String -> Maybe String -> Maybe String
name given family = (++) <$> given <*> family

drdave = name (Just "Dave") (Just "Kauchak")

prince = name (Just "Prince") Nothing
data CouldBe a = Nope | Yep a

instance Functor CouldBe where
  fmap f Nope = Nope
  fmap f (Yep a) = Yep $ f a
  
instance Applicative CouldBe where
  pure x = Yep x
  
  Nope <*> _ = Nope
  _ <*> Nope = Nope
  (Yep f) <*> (Yep x) = Yep $ f x

Then we went over the Applicative definitions for lists.

instance Applicative [] where
  pure x = [x]

  []     <*>  _ = []
  _      <*> [] = []
  (f:fs) <*> xs = map f xs ++ fs <*> xs

note REPEAT call… why?

newtype ZipList a = ZipList { getZipList :: [a] }
  deriving (Eq, Show, Functor)

instance Applicative ZipList where
  pure = ZipList . repeat
  ZipList fs <*> ZipList xs = ZipList (zipWith ($) fs xs)
sequenceA :: (Applicative f) => [f a] -> f [a]  
sequenceA [] = pure []  
sequenceA (x:xs) = (:) <$> x <*> sequenceA xs
instance Applicative ((->) r) where
  pure x = const x
           
  f <*> g = \x -> f x (g x)
eg1 = (+) <$> (+3) <*> (*100)
eg2 = map (\f -> f 7) [(>4),(<10),odd]
eg3 = and $ sequenceA [(>4),(<10),odd] 7

Readers

A Reader is a type that reads from some environmental source of input.

newtype Reader r a = Reader { runReader :: r -> a }

instance Functor (Reader r) where
  fmap f (Reader g) = Reader $ f . g

instance Applicative (Reader r) where
  pure = Reader . const
  (Reader f) <*> (Reader g) = Reader $ \x -> f x (g x)

get :: Reader r r
get = Reader $ \x -> x

data Exp x = Var x | Val Int | Add (Exp x) (Exp x)

type Env x = Map x Int

evalExp :: Ord x => Exp x -> Env x -> Int
evalExp (Var x) env = env ! x
evalExp (Val i) env = i
evalExp (Add e1 e2) env = (evalExp e1 env) + (evalExp e2 env)

evalExp' :: Ord x => Exp x -> Reader (Env x) Int
evalExp' (Var x) = (!x) <$> get
evalExp' (Val i) = pure i
evalExp' (Add e1 e2) = (+) <$> evalExp' e1 <*> evalExp' e2

Parsers using Applicative 

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

instance Functor Parser where
  fmap f p = Parser $ \s -> 
    case parse p s of
      Nothing -> Nothing 
      Just (v,s') -> Just (f v,s')

instance Applicative Parser where
  pure a = Parser $ \s -> Just (a,s)
  f <*> a = Parser $ \s -> 
    case parse f s of
      Nothing -> Nothing
      Just (g,s') -> parse (fmap g a) s'

instance Alternative Parser where
  empty = Parser $ const empty
  l <|> r = Parser $ \s -> parse l s <|> parse r s


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

str :: String -> Parser String
str s = spaces *> (sequenceA $ map (satisfy . (==)) s)

ensure :: (a -> Bool) -> Parser a -> Parser a
ensure pred p = Parser $ \s -> 
  case parse p s of
    Nothing -> Nothing
    Just (a,s') -> if pred a then Just (a,s') else Nothing

lookahead :: Parser (Maybe Char)
lookahead = Parser f
  where f [] = Just (Nothing,[])
        f (c:s) = Just (Just c,c:s)

eof :: Parser ()
eof = Parser $ \s -> if null s then Just ((),[]) else Nothing

zeroOrMore, oneOrMore :: Parser a -> Parser [a]
oneOrMore p = (:) <$> p <*> zeroOrMore p -- a/k/a some
zeroOrMore p = oneOrMore p <|> pure [] -- a/k/a many

opt :: Alternative f => f a -> f (Maybe a)
opt f = (Just <$> f) <|> (pure Nothing)

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = Parser f
  where f [] = Nothing
        f (x:xs) = if p x then Just (x,xs) else Nothing

data Arith = Num Int | Plus Arith Arith | Times Arith Arith deriving Show

spaces :: Parser ()
spaces = pure () <* zeroOrMore (satisfy isSpace)

term :: Parser Arith
term = ((Plus <$> (factor <* char '+')) <*> term) <|> factor

factor :: Parser Arith
factor = Times <$> atom <* char '*' <*> factor <|> atom

atom :: Parser Arith
atom = num <|> (char '(' *> term <* char ')')

num :: Parser Arith
num = spaces *> (Num . read <$> oneOrMore (satisfy isDigit))