|
| 1 | +-- | Primitive parsers for strings, parsing based on code points. |
| 2 | +-- | |
| 3 | +-- | These functions will be much slower than the `CodeUnits` alternatives, but |
| 4 | +-- | will behave correctly in the presence of Unicode characters made up of |
| 5 | +-- | multiple code units. |
| 6 | +module Text.Parsing.StringParser.CodePoints |
| 7 | + ( eof |
| 8 | + , anyChar |
| 9 | + , anyDigit |
| 10 | + , string |
| 11 | + , satisfy |
| 12 | + , char |
| 13 | + , whiteSpace |
| 14 | + , skipSpaces |
| 15 | + , oneOf |
| 16 | + , noneOf |
| 17 | + , lowerCaseChar |
| 18 | + , upperCaseChar |
| 19 | + , anyLetter |
| 20 | + , alphaNum |
| 21 | + , regex |
| 22 | + ) where |
| 23 | + |
| 24 | +import Prelude |
| 25 | + |
| 26 | +import Control.Alt ((<|>)) |
| 27 | +import Data.Array ((..)) |
| 28 | +import Data.Array.NonEmpty as NEA |
| 29 | +import Data.Char (fromCharCode, toCharCode) |
| 30 | +import Data.Either (Either(..)) |
| 31 | +import Data.Enum (fromEnum) |
| 32 | +import Data.Foldable (class Foldable, foldMap, elem, notElem) |
| 33 | +import Data.Maybe (Maybe(..)) |
| 34 | +import Data.String.CodePoints (codePointAt, drop, indexOf', length, stripPrefix) |
| 35 | +import Data.String.CodeUnits (singleton) |
| 36 | +import Data.String.Pattern (Pattern(..)) |
| 37 | +import Data.String.Regex as Regex |
| 38 | +import Data.String.Regex.Flags (noFlags) |
| 39 | +import Text.Parsing.StringParser (Parser(..), try, fail) |
| 40 | +import Text.Parsing.StringParser.Combinators (many, (<?>)) |
| 41 | + |
| 42 | +-- | Match the end of the file. |
| 43 | +eof :: Parser Unit |
| 44 | +eof = Parser \s -> |
| 45 | + case s of |
| 46 | + { str, pos } | pos < length str -> Left { pos, error: "Expected EOF" } |
| 47 | + _ -> Right { result: unit, suffix: s } |
| 48 | + |
| 49 | +-- | Match any character. |
| 50 | +anyChar :: Parser Char |
| 51 | +anyChar = Parser \{ str, pos } -> |
| 52 | + case codePointAt pos str of |
| 53 | + Just cp -> case toChar cp of |
| 54 | + Just chr -> Right { result: chr, suffix: { str, pos: pos + 1 } } |
| 55 | + Nothing -> Left { pos, error: "CodePoint " <> show cp <> " is not a character" } |
| 56 | + Nothing -> Left { pos, error: "Unexpected EOF" } |
| 57 | + where |
| 58 | + toChar = fromCharCode <<< fromEnum |
| 59 | + |
| 60 | +-- | Match any digit. |
| 61 | +anyDigit :: Parser Char |
| 62 | +anyDigit = try do |
| 63 | + c <- anyChar |
| 64 | + if c >= '0' && c <= '9' |
| 65 | + then pure c |
| 66 | + else fail $ "Character " <> show c <> " is not a digit" |
| 67 | + |
| 68 | +-- | Match the specified string. |
| 69 | +string :: String -> Parser String |
| 70 | +string nt = Parser \s -> |
| 71 | + case s of |
| 72 | + { str, pos } | indexOf' (Pattern nt) pos str == Just pos -> Right { result: nt, suffix: { str, pos: pos + length nt } } |
| 73 | + { pos } -> Left { pos, error: "Expected '" <> nt <> "'." } |
| 74 | + |
| 75 | +-- | Match a character satisfying the given predicate. |
| 76 | +satisfy :: (Char -> Boolean) -> Parser Char |
| 77 | +satisfy f = try do |
| 78 | + c <- anyChar |
| 79 | + if f c |
| 80 | + then pure c |
| 81 | + else fail $ "Character " <> show c <> " did not satisfy predicate" |
| 82 | + |
| 83 | +-- | Match the specified character. |
| 84 | +char :: Char -> Parser Char |
| 85 | +char c = satisfy (_ == c) <?> "Could not match character " <> show c |
| 86 | + |
| 87 | +-- | Match many whitespace characters. |
| 88 | +whiteSpace :: Parser String |
| 89 | +whiteSpace = do |
| 90 | + cs <- many (satisfy \ c -> c == '\n' || c == '\r' || c == ' ' || c == '\t') |
| 91 | + pure (foldMap singleton cs) |
| 92 | + |
| 93 | +-- | Skip many whitespace characters. |
| 94 | +skipSpaces :: Parser Unit |
| 95 | +skipSpaces = void whiteSpace |
| 96 | + |
| 97 | +-- | Match one of the characters in the foldable structure. |
| 98 | +oneOf :: forall f. Foldable f => f Char -> Parser Char |
| 99 | +oneOf = satisfy <<< flip elem |
| 100 | + |
| 101 | +-- | Match any character not in the foldable structure. |
| 102 | +noneOf :: forall f. Foldable f => f Char -> Parser Char |
| 103 | +noneOf = satisfy <<< flip notElem |
| 104 | + |
| 105 | +-- | Match any lower case character. |
| 106 | +lowerCaseChar :: Parser Char |
| 107 | +lowerCaseChar = try do |
| 108 | + c <- anyChar |
| 109 | + if toCharCode c `elem` (97 .. 122) |
| 110 | + then pure c |
| 111 | + else fail $ "Expected a lower case character but found " <> show c |
| 112 | + |
| 113 | +-- | Match any upper case character. |
| 114 | +upperCaseChar :: Parser Char |
| 115 | +upperCaseChar = try do |
| 116 | + c <- anyChar |
| 117 | + if toCharCode c `elem` (65 .. 90) |
| 118 | + then pure c |
| 119 | + else fail $ "Expected an upper case character but found " <> show c |
| 120 | + |
| 121 | +-- | Match any letter. |
| 122 | +anyLetter :: Parser Char |
| 123 | +anyLetter = lowerCaseChar <|> upperCaseChar <?> "Expected a letter" |
| 124 | + |
| 125 | +-- | Match a letter or a number. |
| 126 | +alphaNum :: Parser Char |
| 127 | +alphaNum = anyLetter <|> anyDigit <?> "Expected a letter or a number" |
| 128 | + |
| 129 | +-- | match the regular expression |
| 130 | +regex :: String -> Parser String |
| 131 | +regex pat = |
| 132 | + case Regex.regex pattern noFlags of |
| 133 | + Left _ -> |
| 134 | + fail $ "Text.Parsing.StringParser.String.regex': illegal regex " <> pat |
| 135 | + Right r -> |
| 136 | + matchRegex r |
| 137 | + where |
| 138 | + -- ensure the pattern only matches the current position in the parse |
| 139 | + pattern = |
| 140 | + case stripPrefix (Pattern "^") pat of |
| 141 | + Nothing -> |
| 142 | + "^" <> pat |
| 143 | + _ -> |
| 144 | + pat |
| 145 | + matchRegex :: Regex.Regex -> Parser String |
| 146 | + matchRegex r = |
| 147 | + Parser \{ str, pos } -> |
| 148 | + let |
| 149 | + remainder = drop pos str |
| 150 | + in |
| 151 | + case NEA.head <$> Regex.match r remainder of |
| 152 | + Just (Just matched) -> |
| 153 | + Right { result: matched, suffix: { str, pos: pos + length matched } } |
| 154 | + _ -> |
| 155 | + Left { pos, error: "no match" } |
0 commit comments