Parsing.hs (2799B)
1 -- Functional parsing library from chapter 13 of Programming in Haskell, 2 -- Graham Hutton, Cambridge University Press, 2016. 3 4 module Parsing (module Parsing, module Control.Applicative) where 5 6 import Control.Applicative 7 import Data.Char 8 9 -- Basic definitions 10 11 newtype Parser a = P (String -> [(a,String)]) 12 13 parse :: Parser a -> String -> [(a,String)] 14 parse (P p) inp = p inp 15 16 item :: Parser Char 17 item = P (\inp -> case inp of 18 [] -> [] 19 (x:xs) -> [(x,xs)]) 20 21 -- Sequencing parsers 22 23 instance Functor Parser where 24 -- fmap :: (a -> b) -> Parser a -> Parser b 25 fmap g p = P (\inp -> case parse p inp of 26 [] -> [] 27 [(v,out)] -> [(g v, out)]) 28 29 instance Applicative Parser where 30 -- pure :: a -> Parser a 31 pure v = P (\inp -> [(v,inp)]) 32 33 -- <*> :: Parser (a -> b) -> Parser a -> Parser b 34 pg <*> px = P (\inp -> case parse pg inp of 35 [] -> [] 36 [(g,out)] -> parse (fmap g px) out) 37 38 instance Monad Parser where 39 -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b 40 p >>= f = P (\inp -> case parse p inp of 41 [] -> [] 42 [(v,out)] -> parse (f v) out) 43 44 -- Making choices 45 46 instance Alternative Parser where 47 -- empty :: Parser a 48 empty = P (\inp -> []) 49 50 -- (<|>) :: Parser a -> Parser a -> Parser a 51 p <|> q = P (\inp -> case parse p inp of 52 [] -> parse q inp 53 [(v,out)] -> [(v,out)]) 54 55 -- Derived primitives 56 57 sat :: (Char -> Bool) -> Parser Char 58 sat p = do x <- item 59 if p x then return x else empty 60 61 digit :: Parser Char 62 digit = sat isDigit 63 64 lower :: Parser Char 65 lower = sat isLower 66 67 upper :: Parser Char 68 upper = sat isUpper 69 70 letter :: Parser Char 71 letter = sat isAlpha 72 73 alphanum :: Parser Char 74 alphanum = sat isAlphaNum 75 76 char :: Char -> Parser Char 77 char x = sat (== x) 78 79 string :: String -> Parser String 80 string [] = return [] 81 string (x:xs) = do char x 82 string xs 83 return (x:xs) 84 85 ident :: Parser String 86 ident = do x <- lower 87 xs <- many alphanum 88 return (x:xs) 89 90 nat :: Parser Int 91 nat = do xs <- some digit 92 return (read xs) 93 94 int :: Parser Int 95 int = do char '-' 96 n <- nat 97 return (-n) 98 <|> nat 99 100 -- Handling spacing 101 102 space :: Parser () 103 space = do many (sat isSpace) 104 return () 105 106 token :: Parser a -> Parser a 107 token p = do space 108 v <- p 109 space 110 return v 111 112 identifier :: Parser String 113 identifier = token ident 114 115 natural :: Parser Int 116 natural = token nat 117 118 integer :: Parser Int 119 integer = token int 120 121 symbol :: String -> Parser String 122 symbol xs = token (string xs)