# Lecture 19 — 2015-11-11

## Parsing with Applicative

``````module Lec19 where

import Control.Applicative
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  ``````

### `Reader`s

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

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

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

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))``````