From 46469bb8f462f7a91178404adc9ddf5ab9fc6f0c Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 9 Jan 2024 08:45:58 +0100 Subject: [PATCH] Add Parsing.hs which is from a book and helped me write the parser. --- src/Parsing.hs | 122 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 122 insertions(+) create mode 100644 src/Parsing.hs diff --git a/src/Parsing.hs b/src/Parsing.hs new file mode 100644 index 0000000..1974be1 --- /dev/null +++ b/src/Parsing.hs @@ -0,0 +1,122 @@ +-- Functional parsing library from chapter 13 of Programming in Haskell, +-- Graham Hutton, Cambridge University Press, 2016. + +module Parsing (module Parsing, module Control.Applicative) where + +import Control.Applicative +import Data.Char + +-- Basic definitions + +newtype Parser a = P (String -> [(a,String)]) + +parse :: Parser a -> String -> [(a,String)] +parse (P p) inp = p inp + +item :: Parser Char +item = P (\inp -> case inp of + [] -> [] + (x:xs) -> [(x,xs)]) + +-- Sequencing parsers + +instance Functor Parser where + -- fmap :: (a -> b) -> Parser a -> Parser b + fmap g p = P (\inp -> case parse p inp of + [] -> [] + [(v,out)] -> [(g v, out)]) + +instance Applicative Parser where + -- pure :: a -> Parser a + pure v = P (\inp -> [(v,inp)]) + + -- <*> :: Parser (a -> b) -> Parser a -> Parser b + pg <*> px = P (\inp -> case parse pg inp of + [] -> [] + [(g,out)] -> parse (fmap g px) out) + +instance Monad Parser where + -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b + p >>= f = P (\inp -> case parse p inp of + [] -> [] + [(v,out)] -> parse (f v) out) + +-- Making choices + +instance Alternative Parser where + -- empty :: Parser a + empty = P (\inp -> []) + + -- (<|>) :: Parser a -> Parser a -> Parser a + p <|> q = P (\inp -> case parse p inp of + [] -> parse q inp + [(v,out)] -> [(v,out)]) + +-- Derived primitives + +sat :: (Char -> Bool) -> Parser Char +sat p = do x <- item + if p x then return x else empty + +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 [] = return [] +string (x:xs) = do char x + string xs + return (x:xs) + +ident :: Parser String +ident = do x <- lower + xs <- many alphanum + return (x:xs) + +nat :: Parser Int +nat = do xs <- some digit + return (read xs) + +int :: Parser Int +int = do char '-' + n <- nat + return (-n) + <|> nat + +-- Handling spacing + +space :: Parser () +space = do many (sat isSpace) + return () + +token :: Parser a -> Parser a +token p = do space + v <- p + space + return v + +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)