|
| 1 | +module Text.Parsing.StringParser where |
| 2 | + |
| 3 | +import Data.String (charAt, length, take) |
| 4 | +import Data.Either (Either(..)) |
| 5 | + |
| 6 | +-- |
| 7 | +-- Strings are represented as a string with an index from the |
| 8 | +-- start of the string. |
| 9 | +-- |
| 10 | +-- { str: s, pos: n } is interpreted as the substring of s |
| 11 | +-- starting at index n. |
| 12 | +-- |
| 13 | +-- This allows us to avoid repeatedly finding substrings |
| 14 | +-- every time we match a character. |
| 15 | +-- |
| 16 | +type PosString = { str :: String, pos :: Number } |
| 17 | + |
| 18 | +-- |
| 19 | +-- The type of parsing errors |
| 20 | +-- |
| 21 | +data ParseError = ParseError String |
| 22 | + |
| 23 | +instance showParseError :: Show ParseError where |
| 24 | + show (ParseError msg) = msg |
| 25 | + |
| 26 | +-- |
| 27 | +-- A parser is represented as a function which takes a pair of |
| 28 | +-- continuations for failure and success. |
| 29 | +-- |
| 30 | +data Parser a = Parser (forall r. PosString -> (ParseError -> r) -> (a -> PosString -> r) -> r) |
| 31 | + |
| 32 | +unParser :: forall a r. Parser a -> PosString -> (ParseError -> r) -> (a -> PosString -> r) -> r |
| 33 | +unParser (Parser p) = p |
| 34 | + |
| 35 | +runParser :: forall a. Parser a -> String -> Either ParseError a |
| 36 | +runParser p s = unParser p { str: s, pos: 0 } Left (\a _ -> Right a) |
| 37 | + |
| 38 | +-- |
| 39 | +-- Parser type class instances |
| 40 | +-- |
| 41 | + |
| 42 | +instance functorParser :: Functor Parser where |
| 43 | + (<$>) f p = Parser (\s fc sc -> |
| 44 | + unParser p s fc (\a s' -> sc (f a) s')) |
| 45 | + |
| 46 | +instance applyParser :: Apply Parser where |
| 47 | + (<*>) f x = Parser (\s fc sc -> |
| 48 | + unParser f s fc (\f' s' -> |
| 49 | + unParser x s' fc (\x' s'' -> sc (f' x') s''))) |
| 50 | + |
| 51 | +instance applicativeParser :: Applicative Parser where |
| 52 | + pure a = Parser (\s _ sc -> sc a s) |
| 53 | + |
| 54 | +instance bindParser :: Bind Parser where |
| 55 | + (>>=) p f = Parser (\s fc sc -> |
| 56 | + unParser p s fc (\a s' -> |
| 57 | + unParser (f a) s' fc sc)) |
| 58 | + |
| 59 | +instance monadParser :: Monad Parser |
| 60 | + |
| 61 | +instance alternativeParser :: Alternative Parser where |
| 62 | + empty = Parser (\_ fc _ -> fc (ParseError "No alternative")) |
| 63 | + (<|>) p1 p2 = Parser (\s fc sc -> |
| 64 | + unParser p1 s (\_ -> |
| 65 | + unParser p2 s fc sc) sc) |
| 66 | + |
| 67 | +-- |
| 68 | +-- Error handling combinator |
| 69 | +-- |
| 70 | +(<?>) :: forall a. Parser a -> String -> Parser a |
| 71 | +(<?>) p msg = Parser (\s fc sc -> unParser p s (\_ -> fc (ParseError msg)) sc) |
| 72 | + |
| 73 | +-- |
| 74 | +-- Some elementary parsers |
| 75 | +-- |
| 76 | +eof :: Parser {} |
| 77 | +eof = Parser (\s fc sc -> case s of |
| 78 | + { str = str, pos = i } | i < length str -> fc (ParseError "Expected EOF") |
| 79 | + _ -> sc {} s) |
| 80 | + |
| 81 | +anyChar :: Parser String |
| 82 | +anyChar = Parser (\s fc sc -> case s of |
| 83 | + { str = str, pos = i } | i < length str -> sc (charAt i str) { str: str, pos: i + 1 } |
| 84 | + _ -> fc (ParseError "Unexpected EOF")) |
| 85 | + |
| 86 | +foreign import indexOf' |
| 87 | + "function indexOf$prime(x) {\ |
| 88 | + \ return function(startAt) {\ |
| 89 | + \ return function(s) {\ |
| 90 | + \ return s.indexOf(x, startAt);\ |
| 91 | + \ }; \ |
| 92 | + \ }; \ |
| 93 | + \}" :: String -> Number -> String -> Number |
| 94 | + |
| 95 | +string :: String -> Parser String |
| 96 | +string nt = Parser (\s fc sc -> case s of |
| 97 | + { str = str, pos = i } | indexOf' nt i str == 0 -> sc nt { str: str, pos: i + length nt } |
| 98 | + _ -> fc (ParseError $ "Expected '" ++ nt ++ "'")) |
| 99 | + |
0 commit comments