モナド版ParserをApplicative Parserにしてみる

Applicativeの勉強のため、プログラミングHaskellのパーサーをApplicativeに変更してみた。 書いていると、ApplicativeというよりはAlternativeにするべきと分かったので、そのように実装した。

import Data.Char
import Control.Applicative

newtype Parser a              =  P (String -> [(a,String)])

instance Functor Parser where
   fmap f p                   =  P (\inp -> case parse p inp of
                                                []        -> []
                                                [(v,out)] -> [(f v, out)])
instance Applicative Parser where
   pure v                     =  P (\inp -> [(v,inp)])
   p <*> q                    =  P (\inp -> case parse p inp of
                                                []        -> []
                                                [(v,out)] -> parse (fmap v q) out)

instance Alternative Parser where
   empty                      =  P (const [])
   p <|> q                    =  P (\inp -> case parse p inp of
                                                []        -> parse q inp
                                                x         -> x)

parse                         :: Parser a -> String -> [(a,String)]
parse (P p) inp               =  p inp


-- モナド版だと sat は item + 条件分岐
-- しかし、Applicativeでは条件分岐できないので
-- itemの部分も合わせてsatを書くしかなさそう


sat                           :: (Char -> Bool) -> Parser Char
sat p                         =  P (\inp -> case inp of
                                                []     -> []
                                                (x:xs) -> if p x then [(x,xs)] else [])


digit                         :: Parser Char
digit                         =  sat isDigit

lower                         :: Parser Char
lower                         =  sat isLower

upper                         :: Parser Char
upper                         =  sat isUpper

letter                        :: Parser Char
letter                        =  sat isAlpha

alphanum                      :: Parser Char
alphanum                      =  sat isAlphaNum

char                          :: Char -> Parser Char
char x                        =  sat (== x)

string                        :: String -> Parser String
string []                     =  pure []
string (x:xs)                 =  (:) <$> char x <*> string xs


-- Alternativeの関数を使用するのでmanyとmany1は不要


ident                         :: Parser String
ident                         = (:) <$> lower <*> many alphanum

nat                           :: Parser Int
nat                           =  read <$> some digit

int                           :: Parser Int
int                           =  negate <$> (char '-' *> nat) <|> nat

space                         :: Parser ()
space                         =  many (sat isSpace) *> pure ()

token                         :: Parser a -> Parser a
token p                       =  space *> p <* space

identifier                    :: Parser String
identifier                    =  token ident

natural                       :: Parser Int
natural                       =  token nat

integer                       :: Parser Int
integer                       =  token int

symbol                        :: String -> Parser String
symbol xs                     =  token (string xs)