aoc

advent of code
git clone git://source.orangerot.dev:/aoc.git
Log | Files | Refs

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)