diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for replace-megaparsec + +## 1.1.0.0 -- 2019-08-24 + +* First version. Megaparsec. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, James Brock + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of James Brock nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,216 @@ +# replace-megaparsec + +__replace-megaparsec__ is for finding text patterns, and also editing and +replacing the found patterns. +This activity is traditionally done with regular expressions, +but __replace-megaparsec__ uses +[__Megaparsec__](http://hackage.haskell.org/package/megaparsec) +parsers instead for the pattern matching. + +__replace-megaparsec__ can be used in the same sort of “pattern capture” +or “find all” situations in which one would use Python +[`re.findall`](https://docs.python.org/3/library/re.html#re.findall) +or +Perl [`m//`](https://perldoc.perl.org/functions/m.html), +or +Unix [`grep`](https://www.gnu.org/software/grep/). + +__replace-megaparsec__ can be used in the same sort of “stream editing” +or “search-and-replace” situations in which one would use Python +[`re.sub`](https://docs.python.org/3/library/re.html#re.sub), +or +Perl [`s///`](https://perldoc.perl.org/functions/s.html), +or Unix +[`sed`](https://www.gnu.org/software/sed/manual/html_node/The-_0022s_0022-Command.html), +or +[`awk`](https://www.gnu.org/software/gawk/manual/gawk.html). + +## Why would we want to do pattern matching and substitution with parsers instead of regular expressions? + +* Parsers have a nicer syntax than + [regular expressions](https://en.wikipedia.org/wiki/Regular_expression), + which are notoriously + [difficult to read](https://en.wikipedia.org/wiki/Write-only_language). + +* Regular expressions can do “group capture” on sections of the matched + pattern, but they can only return stringy lists of the capture groups. Parsers + can construct typed data structures based on the capture groups, guaranteeing + no disagreement between the pattern rules and the rules that we're using + to build data structures based on the pattern matches. + + For example, consider + scanning a string for numbers. A lot of different things can look like a number, + and can have leading plus or minus signs, or be in scientific notation, or + have commas, or whatever. If we try to parse all of the numbers out of a string + using regular expressions, then we have to make sure that the regular expression + and the string-to-number conversion function agree about exactly what is + and what isn't a numeric string. We can get into an awkward situation in which + the regular expression says it has found a numeric string but the + string-to-number conversion function fails. A typed parser will perform both + the pattern match and the conversion, so it will never be in that situation. + +* Regular expressions are only able to pattern-match + [regular](https://en.wikipedia.org/wiki/Chomsky_hierarchy#The_hierarchy) + grammers. + Parsers are able pattern-match with context-free grammers, and + even context-sensitive or Turing-complete grammers, if needed. See below for + an example of lifting a `Parser` into a `State` monad for context-sensitive + pattern-matching. + +## Examples + +Try the examples in `ghci` by +running `cabal v2-repl` in the `replace-megaparsec/` +root directory. + +The examples depend on these imports. + +```haskell +import Replace.Megaparsec +import Text.Megaparsec +import Text.Megaparsec.Char +import Text.Megaparsec.Char.Lexer +``` + +### Parsing with `sepCap` family of parser combinators + +The following examples show how to match a pattern to a string of text +and deconstruct the string of text by separating it into sections +which match the pattern, and sections which don't match. + +#### Pattern-match, capture only the parsed result + +Separate the input string into sections which can be parsed as a hexadecimal +number with a prefix `"0x"`, and sections which can't. + +```haskell +let hexparser = string "0x" >> hexadecimal :: Parsec Void String Integer +parseTest (sepCap hexparser) "0xA 000 0xFFFF" +``` +```haskell +[Right 10,Left " 000 ",Right 65535] +``` + +#### Pattern match, capture only the matched text + +Just get the strings sections which match the hexadecimal parser, throw away +the parsed number. + +```haskell +let hexparser = string "0x" >> hexadecimal :: Parsec Void String Integer +parseTest (findAll hexparser) "0xA 000 0xFFFF" +``` +```haskell +[Right "0xA",Left " 000 ",Right "0xFFFF"] +``` + +#### Pattern match, capture the matched text and the parsed result + +Capture the parsed hexadecimal number, as well as the string section which +parses as a hexadecimal number. + +```haskell +let hexparser = string "0x" >> hexadecimal :: Parsec Void String Integer +parseTest (findAllCap hexparser) "0xA 000 0xFFFF" +``` +```haskell +[Right ("0xA",10),Left " 000 ",Right ("0xFFFF",65535)] +``` + +#### Pattern match, capture only the locations of the matched patterns + +Find all of the sections of the stream which match +the `Text.Megaparsec.Char.space1` parser (a string of whitespace). +Print a list of the offsets of the beginning of every pattern match. + +```haskell +import Data.Either +let spaceoffset = getOffset <* space1 :: Parsec Void String Int +parseTest (return . rights =<< sepCap spaceoffset) " a b " +``` +```haskell +[0,2,5] +``` + +### Edit text strings by running parsers with `streamEdit` + +The following examples show how to search for a pattern in a string of text +and then edit the string of text to substitute in some replacement text +for the matched patterns. + +#### Pattern match and replace with a constant + +Replace all carriage-return-newline instances with newline. + +```haskell +streamEdit crlf (const "\n") "1\r\n\r\n2" +``` +```haskell +"1\n\n2" +``` + +#### Pattern match and edit the matches + +Replace alphabetic characters with the next character in the alphabet. + +```haskell +streamEdit (some letterChar) (fmap succ) "HAL 9000" +``` +```haskell +"IBM 9000" +``` + +#### Pattern match and edit the matches + +Find all of the string sections *`s`* which can be parsed as a +hexadecimal number *`r`*, +and if *`r≤16`*, then replace *`s`* with a decimal number. + +```haskell +let hexparser = string "0x" >> hexadecimal :: Parsec Void String Integer +streamEdit (match hexparser) (\(s,r) -> if r <= 16 then show r else s) "0xA 000 0xFFFF" +``` +```haskell +"10 000 0xFFFF" +``` + +#### Context-sensitive pattern match and edit the matches + +Capitalize the third letter in a string. The `capthird` parser searches for +individual letters, and it needs to remember how many times it has run so +that it can match successfully only on the third time that it finds a letter. +To enable the parser to remember how many times it has run, we'll +compose the parser with a `State` monad from +the `mtl` package. (Run in `ghci` with `cabal v2-repl -b mtl`). + +```haskell +import qualified Control.Monad.State.Strict as MTL +import Control.Monad.State.Strict (get, put, evalState) +import Data.Char (toUpper) + +let capthird :: ParsecT Void String (MTL.State Int) String + capthird = do + x <- letterChar + i <- get + put (i+1) + if i==3 then return [x] else empty + +flip evalState 1 $ streamEditT capthird (return . fmap toUpper) "a a a a a" +``` +```haskell +"a a A a a" +``` + +## Alternatives + + + + + + + + + + + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/replace-megaparsec.cabal b/replace-megaparsec.cabal new file mode 100644 --- /dev/null +++ b/replace-megaparsec.cabal @@ -0,0 +1,63 @@ +name: replace-megaparsec +version: 1.0.0.0 +cabal-version: 1.18 +synopsis: Stream editing with parsers +homepage: https://github.com/jamesdbrock/replace-megaparsec +bug-reports: https://github.com/jamesdbrock/replace-megaparsec/issues +license: BSD3 +license-file: LICENSE +author: James Brock +maintainer: jamesbrock@gmail.com +build-type: Simple +category: Parsing +description: + + Stream editing and find-and-replace with Megaparsec monadic parser + combinators. + +extra-doc-files: README.md + , CHANGELOG.md + +source-repository head + type: git + location: https://github.com/jamesdbrock/replace-megaparsec.git + +library + hs-source-dirs: src + -- rely on megaparsec for version bounds + build-depends: base + , megaparsec + default-language: Haskell2010 + exposed-modules: Replace.Megaparsec + +test-suite test-string + type: detailed-0.9 + test-module: TestString + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: base >=4.12 && < 5.0 + , replace-megaparsec + , megaparsec + , Cabal + +test-suite test-text + type: detailed-0.9 + test-module: TestText + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: base >=4.12 && < 5.0 + , replace-megaparsec + , megaparsec + , Cabal + , text + +test-suite test-bytestring + type: detailed-0.9 + test-module: TestByteString + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: base >=4.12 && < 5.0 + , replace-megaparsec + , megaparsec + , Cabal + , bytestring diff --git a/src/Replace/Megaparsec.hs b/src/Replace/Megaparsec.hs new file mode 100644 --- /dev/null +++ b/src/Replace/Megaparsec.hs @@ -0,0 +1,239 @@ +-- | +-- Module : Replace.Megaparsec +-- +-- __Replace.Megaparsec__ is for finding text patterns, and also editing and +-- replacing the found patterns. +-- This activity is traditionally done with regular expressions, +-- but __Replace.Megaparsec__ uses "Text.Megaparsec" parsers instead for +-- the pattern matching. +-- +-- __Replace.Megaparsec__ can be used in the same sort of “pattern capture” +-- or “find all” situations in which one would use Python +-- , +-- or Perl +-- , +-- or Unix +-- . +-- +-- __Replace.Megaparsec__ can be used in the same sort of “stream editing” +-- or “search-and-replace” situations in which one would use Python +-- , +-- or Perl +-- , +-- or Unix +-- , +-- or +-- . +-- +-- See the __replace-megaparsec__ package README for usage examples. + +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Replace.Megaparsec + ( + -- * Parser combinator + sepCap + , findAll + , findAllCap + + -- * Running parser + , streamEditT + , streamEdit + ) +where + + +import Data.Void +import Data.Maybe +import Data.Bifunctor +import Data.Functor.Identity +import Data.Proxy +import Data.Foldable +import Control.Exception (throw) +import Data.Typeable +import Control.Monad + +import Text.Megaparsec + +-- | +-- == Separate and capture +-- +-- Parser combinator to find all of the non-overlapping ocurrences +-- of the pattern @sep@ in a text stream. Separate the stream into sections: +-- +-- * sections which can parsed by the pattern @sep@ will be captured as +-- matching sections in 'Right' +-- * non-matching sections of the stream will be captured in 'Left'. +-- +-- This parser will always consume its entire input and can never fail. +-- If there are no pattern matches, then the entire input stream will be +-- returned as a non-matching 'Left' section. +-- +-- The pattern matching parser @sep@ will not be allowed to succeed without +-- consuming any input. If we allow the parser to match a zero-width pattern, +-- then it can match the same zero-width pattern again at the same position +-- on the next iteration, which would result in an infinite number of +-- overlapping pattern matches. So, for example, the +-- pattern @many digitChar@, which can match zero occurences of a digit, +-- will be treated by @sepCap@ as @some digitChar@, and required to match +-- at least one digit. +-- +-- This @sepCap@ parser combinator is the basis for all of the other +-- features of this module. It is similar to the @sep*@ family of functions +-- found in +-- +-- and +-- +-- but, importantly, it returns the parsed result of the @sep@ parser instead +-- of throwing it away. +-- +sepCap + :: forall e s m a. (MonadParsec e s m) + => m a -- ^ The pattern matching parser @sep@ + -> m [Either (Tokens s) a] +sepCap sep = (fmap.fmap) (first $ tokensToChunk (Proxy::Proxy s)) + $ fmap sequenceLeft + $ many $ fmap Right (try $ consumeSome sep) <|> fmap Left anySingle + where + sequenceLeft :: [Either l r] -> [Either [l] r] + sequenceLeft = foldr consLeft [] + where + consLeft :: Either l r -> [Either [l] r] -> [Either [l] r] + consLeft (Left l) ((Left ls):xs) = (Left (l:ls)):xs + consLeft (Left l) xs = (Left [l]):xs + consLeft (Right r) xs = (Right r):xs + -- If sep succeeds and consumes 0 input tokens, we must force it to fail, + -- otherwise infinite loop + consumeSome p = do + offset1 <- getOffset + x <- p + offset2 <- getOffset + when (offset1 == offset2) empty + return x + +-- | +-- == Find all occurences, parse and capture pattern matches +-- +-- Parser combinator for finding all occurences of a pattern in a stream. +-- +-- Will call 'sepCap' with the 'Text.Megaparsec.match' combinator so that +-- the text which matched the pattern parser @sep@ will be returned in +-- the 'Right' sections, along with the result of the parse of @sep@. +-- +-- @ +-- findAllCap sep = 'sepCap' ('Text.Megaparsec.match' sep) +-- @ +findAllCap + :: MonadParsec e s m + => m a -- ^ The pattern matching parser @sep@ + -> m [Either (Tokens s) (Tokens s, a)] +findAllCap sep = sepCap (match sep) + +-- | +-- == Find all occurences +-- +-- Parser combinator for finding all occurences of a pattern in a stream. +-- +-- Will call 'sepCap' with the 'Text.Megaparsec.match' combinator and +-- return the text which matched the pattern parser @sep@ in +-- the 'Right' sections. +-- +-- @ +-- findAll sep = (fmap.fmap) ('Data.Bifunctor.second' fst) $ 'sepCap' ('Text.Megaparsec.match' sep) +-- @ +findAll + :: MonadParsec e s m + => m a -- ^ The pattern matching parser @sep@ + -> m [Either (Tokens s) (Tokens s)] +findAll sep = (fmap.fmap) (second fst) $ sepCap (match sep) + + +-- | +-- == Stream editor +-- +-- Also can be considered “find-and-replace”. Finds all +-- of the sections of the stream which match the pattern @sep@, and replaces +-- them with the result of the @editor@ function. +-- +-- This function is not a “parser combinator,” it is +-- a “way to run a parser”, like 'Text.Megaparsec.parse' +-- or 'Text.Megaparsec.runParserT'. +-- +-- === Access the matched section of text in the editor +-- +-- If you want access to the matched string in the @editor@ function, +-- then combine the pattern parser @sep@ with 'Text.Megaparsec.match', like +-- +-- @ +-- let editor (matchString,parseResult) = return matchString +-- in streamEditT ('Text.Megaparsec.match' sep) editor inputstring +-- @ +-- +-- === Type constraints +-- +-- The type of the stream of text that is input must +-- be @Stream s@ such that @Tokens s ~ s@, because we want +-- to output the same type of stream that was input. That requirement is +-- satisfied for all the 'Text.Megaparsec.Stream' instances included +-- with "Text.Megaparsec": +-- "Data.Text", +-- "Data.Text.Lazy", +-- "Data.Bytestring", +-- "Data.Bytestring.Lazy", +-- and "Data.String". +-- +-- We need the @Monoid s@ instance so that we can @mappend@ the output +-- stream. +-- +-- We need @Typeable s@ and @Show s@ for 'Control.Exception.throw'. In theory +-- this function should never throw an exception, because it only throws +-- when the 'sepCap' parser fails, and the 'sepCap' parser +-- can never fail. If this function ever throws, please report that as a bug. +-- +-- === Underlying monad context +-- +-- Both the parser @sep@ and the @editor@ function are run in the underlying +-- monad context. +-- +-- If you want to do 'IO' operations in the @editor@ function or the +-- parser @sep@, then run this in 'IO'. +-- +-- If you want the @editor@ function or the parser @sep@ to remember some state, +-- then run this in a stateful monad. +streamEditT + :: forall s m a. (Stream s, Monad m, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s) + => ParsecT Void s m a + -- ^ The parser @sep@ for the pattern of interest. + -> (a -> m s) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> s + -- ^ The input stream of text to be edited. + -> m s +streamEditT sep editor input = do + runParserT (sepCap sep) "" input >>= \case + (Left err) -> throw err -- sepCap can never fail, but if it does, throw + (Right r) -> fmap fold $ traverse (either return editor) r + + + +-- | +-- == Pure stream editor +-- +-- Pure version of 'streamEditT'. +streamEdit + :: forall s a. (Stream s, Monoid s, Tokens s ~ s, Show s, Show (Token s), Typeable s) + => Parsec Void s a + -- ^ The parser @sep@ for the pattern of interest. + -> (a -> s) + -- ^ The @editor@ function. Takes a parsed result of @sep@ + -- and returns a new stream section for the replacement. + -> s + -- ^ The input stream of text to be edited. + -> s +streamEdit sep editor = runIdentity . streamEditT sep (Identity . editor) + diff --git a/tests/TestByteString.hs b/tests/TestByteString.hs new file mode 100644 --- /dev/null +++ b/tests/TestByteString.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module TestByteString ( tests ) where + +import Distribution.TestSuite +import Replace.Megaparsec +import Text.Megaparsec +import Text.Megaparsec.Byte +import Text.Megaparsec.Byte.Lexer +import Data.Void +import qualified Data.ByteString as BS +import Data.ByteString (ByteString) +import Data.ByteString.Internal (c2w) +import GHC.Word + +type Parser = Parsec Void ByteString + +tests :: IO [Test] +tests = return + [ Test $ runParserTest "findAll upperChar" + (findAllCap (upperChar :: Parser Word8)) + ("aBcD" :: ByteString) + [Left "a", Right ("B", c2w 'B'), Left "c", Right ("D", c2w 'D')] + -- check that sepCap can progress even when parser consumes nothing + -- and succeeds. + , Test $ runParserTest "zero-consumption parser" + (sepCap (many (upperChar :: Parser Word8))) + ("aBcD" :: ByteString) + [Left "a", Right [c2w 'B'], Left "c", Right [c2w 'D']] + , Test $ runParserTest "scinum" + (sepCap scinum) + ("1E3") + ([Right (1,3)]) + , Test $ runParserTest "getOffset" + (sepCap offsetA) + ("xxAxx") + ([Left "xx", Right 2, Left "xx"]) + , Test $ runParserTest "monad fail" + (sepCap (fail "" :: Parser ())) + ("xxx") + ([Left "xxx"]) + , Test $ runParserTest "read fail" + (sepCap (return (read "a" :: Int) :: Parser Int)) + ("a") + ([Left "a"]) + ] + +runParserTest name p input expected = TestInstance + { run = do + case runParser p "" input of + Left e -> return (Finished $ Fail $ show e) + Right output -> + if (output == expected) + then return (Finished Pass) + else return (Finished $ Fail + $ show output ++ " ≠ " ++ show expected) + , name = name + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + +scinum :: Parser (Double, Integer) +scinum = do + -- This won't parse mantissas that contain a decimal point, + -- but if we use the Text.Megaparsec.Byte.Lexer.float, then it consumes + -- the "E" and the exponent. Whatever, doesn't really matter for this test. + m <- fromIntegral <$> decimal + string "E" + e <- decimal + return (m, e) + + +offsetA :: Parser Int +offsetA = getOffset <* string "A" + diff --git a/tests/TestString.hs b/tests/TestString.hs new file mode 100644 --- /dev/null +++ b/tests/TestString.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE FlexibleContexts #-} + +module TestString ( tests ) where + +import Distribution.TestSuite +import Replace.Megaparsec +import Text.Megaparsec +import Text.Megaparsec.Char +import Text.Megaparsec.Char.Lexer +import Data.Void + +type Parser = Parsec Void String + +tests :: IO [Test] +tests = return + [ Test $ runParserTest "findAll upperChar" + (findAllCap (upperChar :: Parser Char)) + ("aBcD" :: String) + [Left "a", Right ("B", 'B'), Left "c", Right ("D", 'D')] + -- check that sepCap can progress even when parser consumes nothing + -- and succeeds. + , Test $ runParserTest "zero-consumption parser" + (sepCap (many (upperChar :: Parser Char))) + ("aBcD" :: String) + [Left "a", Right "B", Left "c", Right "D"] + , Test $ runParserTest "scinum" + (sepCap scinum) + ("1E3") + ([Right (1,3)]) + , Test $ runParserTest "getOffset" + (sepCap offsetA) + ("xxAxx") + ([Left "xx", Right 2, Left "xx"]) + , Test $ runParserTest "monad fail" + (sepCap (fail "" :: Parser ())) + ("xxx") + ([Left "xxx"]) + , Test $ runParserTest "read fail" + (sepCap (return (read "a" :: Int) :: Parser Int)) + ("a") + ([Left "a"]) + ] + +runParserTest name p input expected = TestInstance + { run = do + case runParser p "" input of + Left e -> return (Finished $ Fail $ show e) + Right output -> + if (output == expected) + then return (Finished Pass) + else return (Finished $ Fail + $ show output ++ " ≠ " ++ show expected) + , name = name + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + +scinum :: Parser (Double, Integer) +scinum = do + m <- some digitChar + string "E" + e <- some digitChar + return (read m, read e) + + +offsetA :: Parser Int +offsetA = getOffset <* string "A" + diff --git a/tests/TestText.hs b/tests/TestText.hs new file mode 100644 --- /dev/null +++ b/tests/TestText.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} + +module TestText ( tests ) where + +import Distribution.TestSuite +import Replace.Megaparsec +import Text.Megaparsec +import Text.Megaparsec.Char +import Text.Megaparsec.Char.Lexer +import Data.Void +import qualified Data.Text as T +import Data.Text (Text) + +type Parser = Parsec Void Text + +tests :: IO [Test] +tests = return + [ Test $ runParserTest "findAll upperChar" + (findAllCap (upperChar :: Parser Char)) + ("aBcD" :: Text) + [Left "a", Right ("B", 'B'), Left "c", Right ("D", 'D')] + -- check that sepCap can progress even when parser consumes nothing + -- and succeeds. + , Test $ runParserTest "zero-consumption parser" + (sepCap (many (upperChar :: Parser Char))) + ("aBcD" :: Text) + [Left "a", Right "B", Left "c", Right "D"] + , Test $ runParserTest "scinum" + (sepCap scinum) + ("1E3") + ([Right (1,3)]) + , Test $ runParserTest "getOffset" + (sepCap offsetA) + ("xxAxx") + ([Left "xx", Right 2, Left "xx"]) + , Test $ runParserTest "monad fail" + (sepCap (fail "" :: Parser ())) + ("xxx") + ([Left "xxx"]) + , Test $ runParserTest "read fail" + (sepCap (return (read "a" :: Int) :: Parser Int)) + ("a") + ([Left "a"]) + ] + +runParserTest name p input expected = TestInstance + { run = do + case runParser p "" input of + Left e -> return (Finished $ Fail $ show e) + Right output -> + if (output == expected) + then return (Finished Pass) + else return (Finished $ Fail + $ show output ++ " ≠ " ++ show expected) + , name = name + , tags = [] + , options = [] + , setOption = \_ _ -> Left "no options supported" + } + +scinum :: Parser (Double, Integer) +scinum = do + m <- some digitChar + string "E" + e <- some digitChar + return (read m, read e) + + +offsetA :: Parser Int +offsetA = getOffset <* string "A" +