packages feed

input-parsers (empty) → 0.1

raw patch · 10 files changed

+885/−0 lines, 10 filesdep +attoparsecdep +basedep +binarysetup-changed

Dependencies added: attoparsec, base, binary, bytestring, monoid-subclasses, parsec, parsers, text, transformers

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for input-parsers++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2020, Mario Blažević++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 Mario Blažević 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.
+ README.md view
@@ -0,0 +1,25 @@+input-parsers+=============++### An extension of the [parsers](http://hackage.haskell.org/package/parsers) library ###++The [parsers](http://hackage.haskell.org/package/parsers) library provides a number of subclasses of the+[`Alternative`](https://hackage.haskell.org/package/base/docs/Control-Applicative.html#t:Alternative) type class,+as well as lots of combinators useful for writing actual parsers.++What those classes like+[Parsing](http://hackage.haskell.org/package/parsers/docs/Text-Parser-Combinators.html#t:Parsing) and+[CharParsing](https://hackage.haskell.org/package/parsers/docs/Text-Parser-Char.html#t:CharParsing) lack is the+ability to express certain efficient parser primitives like Attoparsec's+[takeWhile](https://hackage.haskell.org/package/attoparsec/docs/Data-Attoparsec-Text.html#v:takeWhile). To rectify for+this failing and enable more efficient parsers to be expressed, the present package `input-parsers` adds type classes+[InputParsing](http://hackage.haskell.org/package/input-parsers/docs/Text-Parser-Input.html#t:InputParsing) and+[InputCharParsing](http://hackage.haskell.org/package/input-parsers/docs/Text-Parser-Input.html#t:InputCharParsing). The+common characteristic of almost all their methods is that their parse result has the same type as the parser input,+and is a prefix of the input.++The present package also exports the class+[DeterministicParsing](http://hackage.haskell.org/package/input-parsers/docs/Text-Parser-Deterministic.html#t:DeterministicParsing),+which provides a number of parser methods that are guaranteed to succeed with a single (typically longest possible)+result. This is most useful for writing the lexical layer of a parser, but it can help avoid ambiguities and+inefficiencies in general.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ input-parsers.cabal view
@@ -0,0 +1,49 @@+cabal-version:       >=1.10+name:                input-parsers+version:             0.1+synopsis:            Extension of the parsers library with more capability and efficiency+description:+                     Extended version of the parsers library, with the additional classes providing more+                     capable and efficient methods.+bug-reports:         https://github.com/blamario/input-parsers/issues+license:             BSD3+license-file:        LICENSE+author:              Mario Blažević+maintainer:          blamario@protonmail.com+copyright:           (c) 2020 Mario Blažević+category:            Parsing+build-type:          Simple+extra-source-files:  CHANGELOG.md, README.md++flag binary+  default: True+  description:+    You can disable the use of the `binary` package using `-f-binary`.++flag parsec+  default: True+  description:+    You can disable the use of the `parsec` package using `-f-parsec`.++flag attoparsec+  default: True+  description:+    You can disable the use of the `attoparsec` package using `-f-attoparsec`.++library+  exposed-modules:     Text.Parser.Deterministic,+                       Text.Parser.Input,+                       Text.Parser.Input.Position,+                       Text.Parser.Wrapper+  other-modules:       Text.Parser.Internal+  build-depends:       base >=4.9 && <4.14, bytestring >=0.10 && <0.11, text >=1.2 && <1.3,+                       monoid-subclasses >= 1.0 && < 1.1, parsers >= 0.12 && < 0.13,+                       transformers >=0.2 && <0.6+  if flag(binary)+    build-depends: binary     >= 0.7.2    && < 1+  if flag(parsec)+    build-depends: parsec     >= 3.1      && < 3.2+  if flag(attoparsec)+    build-depends: attoparsec >= 0.12.1.4 && < 0.14, bytestring >= 0.9 && < 0.11, text >= 0.1 && < 1.3+  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/Text/Parser/Deterministic.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Deterministic parsers can be restricted to a single parsing result.++module Text.Parser.Deterministic where++import Control.Applicative (Applicative ((<*>), pure), Alternative ((<|>), many, some), liftA2, optional)+import Control.Arrow (first)+import Control.Monad (MonadPlus, void)+import Control.Monad.Trans.Identity (IdentityT(..))+import Control.Monad.Trans.Reader (ReaderT(..), mapReaderT)+import qualified Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(WriterT))+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT(WriterT))+import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT(StateT))+import qualified Control.Monad.Trans.State.Strict as Strict (StateT(StateT))+import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST(RWST))+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(RWST))+import Data.Functor ((<$>))+import qualified Data.List as List+import Data.Monoid (Monoid, mappend, mempty)+import Data.String (IsString (fromString))+import Text.ParserCombinators.ReadP (ReadP)+import qualified Text.ParserCombinators.ReadP as ReadP++import Text.Parser.Char (CharParsing)+import Text.Parser.Combinators (Parsing, count, eof, notFollowedBy, try, unexpected)+import Text.Parser.LookAhead (LookAheadParsing, lookAhead)+import qualified Text.Parser.Char as Char++import Text.Parser.Internal (mapLazyWriterT, mapStrictWriterT,+                             mapLazyStateT, mapStrictStateT,+                             mapLazyRWST, mapStrictRWST)+import Text.Parser.Wrapper (Lazy(..), Strict(..))++#ifdef MIN_VERSION_attoparsec+import Data.ByteString (ByteString)+import Data.Text (Text)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as ByteString.Char8+import qualified Data.Text as Text++import qualified Data.Attoparsec.ByteString as Attoparsec+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec.Char8+import qualified Data.Attoparsec.Text as Attoparsec.Text+#endif++#ifdef MIN_VERSION_binary+import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Lazy as Lazy++import qualified Data.Binary.Get as Binary+#endif++-- | Combinator methods for constructing deterministic parsers, /i.e./, parsers that can succeed with only a single+-- result.+class Parsing m => DeterministicParsing m where+   -- | Left-biased choice: if the left alternative succeeds, the right one is never tried.+   infixl 3 <<|>+   (<<|>) :: m a -> m a -> m a+   -- | Like 'optional', but never succeeds with @Nothing@ if the argument parser can succeed.+   takeOptional :: m a -> m (Maybe a)+   -- | Like 'some', but always consuming the longest matching sequence of input.+   takeMany :: m a -> m [a]+   -- | Like 'some', but always consuming the longest matching sequence of input.+   takeSome :: m a -> m [a]+   -- | Like 'Text.Parser.Input.concatMany', but always consuming the longest matching sequence of input.+   concatAll :: Monoid a => m a -> m a+   -- | Like 'Text.Parser.Combinators.skipMany', but always consuming the longest matching sequence of input.+   skipAll :: m a -> m ()++   p <<|> q = try p <|> notFollowedBy (void p) *> q+   takeOptional p = Just <$> p <<|> pure Nothing+   takeMany p = many p <* notFollowedBy (void p)+   takeSome p = some p <* notFollowedBy (void p)+   concatAll p = go+      where go = liftA2 mappend p go <<|> pure mempty+   skipAll p = p *> skipAll p <<|> pure ()++instance DeterministicParsing ReadP where+  (<<|>) = (ReadP.<++)++instance (Monad m, DeterministicParsing m) => DeterministicParsing (IdentityT m) where+  IdentityT p <<|> IdentityT q = IdentityT (p <<|> q)+  takeOptional (IdentityT p) = IdentityT (takeOptional p)+  takeMany (IdentityT p) = IdentityT (takeMany p)+  takeSome (IdentityT p) = IdentityT (takeSome p)+  concatAll (IdentityT p) = IdentityT (concatAll p)+  skipAll (IdentityT p) = IdentityT (skipAll p)++instance (MonadPlus m, DeterministicParsing m) => DeterministicParsing (ReaderT e m) where+  ReaderT p <<|> ReaderT q = ReaderT (\a-> p a <<|> q a)+  takeOptional = mapReaderT takeOptional+  takeMany = mapReaderT takeMany+  takeSome = mapReaderT takeSome+  concatAll = mapReaderT concatAll+  skipAll = mapReaderT skipAll++instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Lazy.WriterT w m) where+  Lazy.WriterT p <<|> Lazy.WriterT q = Lazy.WriterT (p <<|> q)+  takeOptional = mapLazyWriterT takeOptional+  takeMany = mapLazyWriterT takeMany+  takeSome = mapLazyWriterT takeSome+  concatAll = mapLazyWriterT concatAll+  skipAll = mapLazyWriterT skipAll++instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Strict.WriterT w m) where+  Strict.WriterT p <<|> Strict.WriterT q = Strict.WriterT (p <<|> q)+  takeOptional = mapStrictWriterT takeOptional+  takeMany = mapStrictWriterT takeMany+  takeSome = mapStrictWriterT takeSome+  concatAll = mapStrictWriterT concatAll+  skipAll = mapStrictWriterT skipAll++instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Lazy.StateT w m) where+  Lazy.StateT p <<|> Lazy.StateT q = Lazy.StateT (\s-> p s <<|> q s)+  takeOptional = mapLazyStateT takeOptional+  takeMany = mapLazyStateT takeMany+  takeSome = mapLazyStateT takeSome+  concatAll = mapLazyStateT concatAll+  skipAll = mapLazyStateT skipAll++instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Strict.StateT w m) where+  Strict.StateT p <<|> Strict.StateT q = Strict.StateT (\s-> p s <<|> q s)+  takeOptional = mapStrictStateT takeOptional+  takeMany = mapStrictStateT takeMany+  takeSome = mapStrictStateT takeSome+  concatAll = mapStrictStateT concatAll+  skipAll = mapStrictStateT skipAll++instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Lazy.RWST r w s m) where+  Lazy.RWST p <<|> Lazy.RWST q = Lazy.RWST (\r s-> p r s <<|> q r s)+  takeOptional = mapLazyRWST takeOptional+  takeMany = mapLazyRWST takeMany+  takeSome = mapLazyRWST takeSome+  concatAll = mapLazyRWST concatAll+  skipAll = mapLazyRWST skipAll++instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Strict.RWST r w s m) where+  Strict.RWST p <<|> Strict.RWST q = Strict.RWST (\r s-> p r s <<|> q r s)+  takeOptional = mapStrictRWST takeOptional+  takeMany = mapStrictRWST takeMany+  takeSome = mapStrictRWST takeSome+  concatAll = mapStrictRWST concatAll+  skipAll = mapStrictRWST skipAll++#ifdef MIN_VERSION_attoparsec+instance DeterministicParsing Attoparsec.Parser where+  (<<|>) = (<|>)+  takeOptional = optional+  takeMany = many+  takeSome = some+  skipAll = Attoparsec.skipMany++instance DeterministicParsing Attoparsec.Text.Parser where+  (<<|>) = (<|>)+  takeOptional = optional+  takeMany = many+  takeSome = some+  skipAll = Attoparsec.Text.skipMany+#endif++#ifdef MIN_VERSION_binary+instance DeterministicParsing (Lazy Binary.Get) where+  (<<|>) = (<|>)+  takeOptional = optional+  takeMany = many+  takeSome = some++instance DeterministicParsing (Strict Binary.Get) where+  (<<|>) = (<|>)+  takeOptional = optional+  takeMany = many+  takeSome = some+#endif
+ src/Text/Parser/Input.hs view
@@ -0,0 +1,476 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}++#if defined (__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 802+{-# LANGUAGE TypeSynonymInstances #-}+#endif++-- | Parsers that can consume and return a prefix of their input.++module Text.Parser.Input (InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..),+                          Lazy(..), Strict(..), Position) where++import Control.Applicative (Applicative ((<*>), pure), Alternative ((<|>), empty), (<**>))+import Control.Monad (MonadPlus, void)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Identity (IdentityT(..))+import Control.Monad.Trans.Reader (ReaderT(..), mapReaderT)+import qualified Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(WriterT))+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT(WriterT))+import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT(StateT))+import qualified Control.Monad.Trans.State.Strict as Strict (StateT(StateT))+import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST(RWST))+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(RWST))+import Data.Functor ((<$>))+import qualified Data.List as List+import Data.Monoid (Monoid, mappend, mempty)+import Data.String (IsString (fromString))+import Text.ParserCombinators.ReadP (ReadP)+import qualified Text.ParserCombinators.ReadP as ReadP++import Text.Parser.Char (CharParsing)+import Text.Parser.Combinators (Parsing, count, eof, notFollowedBy, try, unexpected)+import Text.Parser.LookAhead (LookAheadParsing, lookAhead)+import qualified Text.Parser.Char as Char++import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Null as Null+import qualified Data.Monoid.Textual as Textual+import qualified Data.Semigroup.Cancellative as Cancellative+import Data.Monoid.Factorial (FactorialMonoid)+import Data.Monoid.Textual (TextualMonoid)+import Data.Semigroup.Cancellative (LeftReductive)++#ifdef MIN_VERSION_attoparsec+import Data.ByteString (ByteString)+import Data.Text (Text)+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Char8 as ByteString.Char8+import qualified Data.ByteString.Lazy as Lazy+import qualified Data.Text as Text++import qualified Data.Attoparsec.ByteString as Attoparsec+import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec.Char8+import qualified Data.Attoparsec.Text as Attoparsec.Text+#endif++#ifdef MIN_VERSION_parsec+import Text.Parsec (ParsecT)+import qualified Text.Parsec as Parsec+#endif++#ifdef MIN_VERSION_binary+import qualified Data.Binary.Get as Binary+#endif++import Text.Parser.Input.Position (Position, fromEnd, fromStart)+import Text.Parser.Internal (mapLazyWriterT, mapStrictWriterT,+                             mapLazyStateT, mapStrictStateT,+                             mapLazyRWST, mapStrictRWST)+import Text.Parser.Wrapper (Lazy(..), Strict(..))++import Prelude hiding (take, takeWhile)++-- | Methods for parsing monoidal inputs+class LookAheadParsing m => InputParsing m where+   -- | The type of the input stream that the parser @m@ expects to parse.+   type ParserInput m+   -- | Always sucessful parser that returns the entire remaining input without consuming it.+   getInput :: m (ParserInput m)+   -- | Retrieve the 'Position' reached by the parser in the input source.+   getSourcePos :: m Position++   -- | A parser that accepts any single atomic prefix of the input stream.+   --+   -- > anyToken == satisfy (const True)+   -- > anyToken == take 1+   anyToken :: m (ParserInput m)+   -- | A parser that accepts exactly the given number of input atoms.+   --+   -- > take n == count n anyToken+   take :: Int -> m (ParserInput m)+   -- | A parser that accepts an input atom only if it satisfies the given predicate.+   satisfy :: (ParserInput m -> Bool) -> m (ParserInput m)+   -- | A parser that succeeds exactly when satisfy doesn't, equivalent to+   -- 'Text.Parser.Combinators.notFollowedBy' @.@ 'satisfy'+   notSatisfy :: (ParserInput m -> Bool) -> m ()++   -- | A stateful scanner. The predicate modifies a state argument, and each transformed state is passed to successive+   -- invocations of the predicate on each token of the input until one returns 'Nothing' or the input ends.+   --+   -- This parser does not fail.  It will return an empty string if the predicate returns 'Nothing' on the first+   -- character.+   --+   -- /Note/: Because this parser does not fail, do not use it with combinators such as 'Control.Applicative.many',+   -- because such parsers loop until a failure occurs.  Careless use will thus result in an infinite loop.+   scan :: state -> (state -> ParserInput m -> Maybe state) -> m (ParserInput m)+   -- | A parser that consumes and returns the given prefix of the input.+   string :: ParserInput m -> m (ParserInput m)++   -- | A parser accepting the longest sequence of input atoms that match the given predicate; an optimized version of+   -- 'concat' @.@ 'Control.Applicative.many' @.@ 'satisfy'.+   --+   -- /Note/: Because this parser does not fail, do not use it with combinators such as 'Control.Applicative.many',+   -- because such parsers loop until a failure occurs.  Careless use will thus result in an infinite loop.+   takeWhile :: (ParserInput m -> Bool) -> m (ParserInput m)+   -- | A parser accepting the longest non-empty sequence of input atoms that match the given predicate; an optimized+   -- version of 'concat' @.@ 'Control.Applicative.some' @.@ 'satisfy'.+   takeWhile1 :: (ParserInput m -> Bool) -> m (ParserInput m)++   default getSourcePos :: (FactorialMonoid (ParserInput m), Functor m) => m Position+   getSourcePos = fromEnd . Factorial.length <$> getInput+   anyToken = take 1+   default satisfy :: Monad m => (ParserInput m -> Bool) -> m (ParserInput m)+   satisfy predicate = anyToken >>= \x-> if predicate x then pure x else empty+   notSatisfy predicate = try (void $ satisfy $ not . predicate) <|> eof+   default string :: (Monad m, LeftReductive (ParserInput m), FactorialMonoid (ParserInput m), Show (ParserInput m))+                  => ParserInput m -> m (ParserInput m)+   string s = do i <- getInput+                 if s `Cancellative.isPrefixOf` i+                    then take (Factorial.length s)+                    else unexpected ("string " <> show s)+   default scan :: (Monad m, FactorialMonoid (ParserInput m)) =>+                   state -> (state -> ParserInput m -> Maybe state) -> m (ParserInput m)+   scan state f = do i <- getInput+                     let (prefix, _suffix, _state) = Factorial.spanMaybe' state f i+                     take (Factorial.length prefix)+   default takeWhile :: (Monad m, FactorialMonoid (ParserInput m)) => (ParserInput m -> Bool) -> m (ParserInput m)+   takeWhile predicate = do i <- getInput+                            take (Factorial.length $ Factorial.takeWhile predicate i)+   default takeWhile1 :: (Monad m, FactorialMonoid (ParserInput m)) => (ParserInput m -> Bool) -> m (ParserInput m)+   takeWhile1 predicate = do x <- takeWhile predicate+                             if Null.null x then unexpected "takeWhile1" else pure x+++-- | Methods for parsing textual monoid inputs+class (CharParsing m, InputParsing m) => InputCharParsing m where+   -- | Specialization of 'satisfy' on textual inputs, accepting an input character only if it satisfies the given+   -- predicate, and returning the input atom that represents the character. Equivalent to @fmap singleton+   -- . Char.satisfy@+   satisfyCharInput :: (Char -> Bool) -> m (ParserInput m)+   -- | A parser that succeeds exactly when satisfy doesn't, equivalent to @notFollowedBy . Char.satisfy@+   notSatisfyChar :: (Char -> Bool) -> m ()++   -- | Stateful scanner like `scan`, but specialized for 'TextualMonoid' inputs.+   scanChars :: state -> (state -> Char -> Maybe state) -> m (ParserInput m)++   -- | Specialization of 'takeWhile' on 'TextualMonoid' inputs, accepting the longest sequence of input characters that+   -- match the given predicate; an optimized version of @fmap fromString  . many . Char.satisfy@.+   --+   -- /Note/: Because this parser does not fail, do not use it with combinators such as 'Control.Applicative.many',+   -- because such parsers loop until a failure occurs.  Careless use will thus result in an infinite loop.+   takeCharsWhile :: (Char -> Bool) -> m (ParserInput m)+   -- | Specialization of 'takeWhile1' on 'TextualMonoid' inputs, accepting the longest sequence of input characters+   -- that match the given predicate; an optimized version of @fmap fromString  . some . Char.satisfy@.+   takeCharsWhile1 :: (Char -> Bool) -> m (ParserInput m)++   notSatisfyChar = notFollowedBy . Char.satisfy+   default scanChars :: (Monad m, TextualMonoid (ParserInput m)) =>+                        state -> (state -> Char -> Maybe state) -> m (ParserInput m)+   scanChars state f = do i <- getInput+                          let (prefix, _suffix, _state) = Textual.spanMaybe' state (const $ const Nothing) f i+                          take (Factorial.length prefix)+   default takeCharsWhile :: (Monad m, TextualMonoid (ParserInput m)) => (Char -> Bool) -> m (ParserInput m)+   takeCharsWhile predicate = do i <- getInput+                                 take (Factorial.length $ Textual.takeWhile_ False predicate i)+   default takeCharsWhile1 :: (Monad m, TextualMonoid (ParserInput m)) => (Char -> Bool) -> m (ParserInput m)+   takeCharsWhile1 predicate = do x <- takeCharsWhile predicate+                                  if Null.null x then unexpected "takeCharsWhile1" else pure x++-- | Parsers that keep track of the consumed input.+class InputParsing m => ConsumedInputParsing m where+   -- | Return both the result of a parse and the portion of the input that the argument parser consumed.+   match :: m a -> m (ParserInput m, a)++instance InputParsing ReadP where+   type ParserInput ReadP = String+   getInput = ReadP.look+   take n = count n ReadP.get+   anyToken = pure <$> ReadP.get+   satisfy predicate = pure <$> ReadP.satisfy (predicate . pure)+   string = ReadP.string++instance InputCharParsing ReadP where+   satisfyCharInput predicate = pure <$> ReadP.satisfy predicate++instance ConsumedInputParsing ReadP where+   match = ReadP.gather++instance (Monad m, InputParsing m) => InputParsing (IdentityT m) where+   type ParserInput (IdentityT m) = ParserInput m+   getInput = IdentityT getInput+   getSourcePos = IdentityT getSourcePos+   anyToken = IdentityT anyToken+   take = IdentityT . take+   satisfy = IdentityT . satisfy+   notSatisfy = IdentityT . notSatisfy+   scan state f = IdentityT (scan state f)+   string = IdentityT . string+   takeWhile = IdentityT . takeWhile+   takeWhile1 = IdentityT . takeWhile1++instance (MonadPlus m, InputCharParsing m) => InputCharParsing (IdentityT m) where+   satisfyCharInput = IdentityT . satisfyCharInput+   notSatisfyChar = IdentityT . notSatisfyChar+   scanChars state f = IdentityT (scanChars state f)+   takeCharsWhile = IdentityT . takeCharsWhile+   takeCharsWhile1 = IdentityT . takeCharsWhile1++instance (Monad m, ConsumedInputParsing m) => ConsumedInputParsing (IdentityT m) where+  match (IdentityT p) = IdentityT (match p)++instance (MonadPlus m, InputParsing m) => InputParsing (ReaderT e m) where+   type ParserInput (ReaderT e m) = ParserInput m+   getInput = lift getInput+   getSourcePos = lift getSourcePos+   anyToken = lift anyToken+   take = lift . take+   satisfy = lift . satisfy+   notSatisfy = lift . notSatisfy+   scan state f = lift (scan state f)+   string = lift . string+   takeWhile = lift . takeWhile+   takeWhile1 = lift . takeWhile1++instance (MonadPlus m, InputCharParsing m) => InputCharParsing (ReaderT e m) where+   satisfyCharInput = lift . satisfyCharInput+   notSatisfyChar = lift . notSatisfyChar+   scanChars state f = lift (scanChars state f)+   takeCharsWhile = lift . takeCharsWhile+   takeCharsWhile1 = lift . takeCharsWhile1++instance (MonadPlus m, ConsumedInputParsing m) => ConsumedInputParsing (ReaderT e m) where+  match = mapReaderT match++instance (MonadPlus m, InputParsing m, Monoid w) => InputParsing (Lazy.WriterT w m) where+   type ParserInput (Lazy.WriterT w m) = ParserInput m+   getInput = lift getInput+   getSourcePos = lift getSourcePos+   anyToken = lift anyToken+   take = lift . take+   satisfy = lift . satisfy+   notSatisfy = lift . notSatisfy+   scan state f = lift (scan state f)+   string = lift . string+   takeWhile = lift . takeWhile+   takeWhile1 = lift . takeWhile1++instance (MonadPlus m, InputCharParsing m, Monoid w) => InputCharParsing (Lazy.WriterT w m) where+   satisfyCharInput = lift . satisfyCharInput+   notSatisfyChar = lift . notSatisfyChar+   scanChars state f = lift (scanChars state f)+   takeCharsWhile = lift . takeCharsWhile+   takeCharsWhile1 = lift . takeCharsWhile1++instance (MonadPlus m, ConsumedInputParsing m, Monoid w) => ConsumedInputParsing (Lazy.WriterT w m) where+  match = mapLazyWriterT match++instance (MonadPlus m, InputParsing m, Monoid w) => InputParsing (Strict.WriterT w m) where+   type ParserInput (Strict.WriterT w m) = ParserInput m+   getInput = lift getInput+   getSourcePos = lift getSourcePos+   anyToken = lift anyToken+   take = lift . take+   satisfy = lift . satisfy+   notSatisfy = lift . notSatisfy+   scan state f = lift (scan state f)+   string = lift . string+   takeWhile = lift . takeWhile+   takeWhile1 = lift . takeWhile1++instance (MonadPlus m, InputCharParsing m, Monoid w) => InputCharParsing (Strict.WriterT w m) where+   satisfyCharInput = lift . satisfyCharInput+   notSatisfyChar = lift . notSatisfyChar+   scanChars state f = lift (scanChars state f)+   takeCharsWhile = lift . takeCharsWhile+   takeCharsWhile1 = lift . takeCharsWhile1++instance (MonadPlus m, ConsumedInputParsing m, Monoid w) => ConsumedInputParsing (Strict.WriterT w m) where+  match = mapStrictWriterT match++instance (MonadPlus m, InputParsing m) => InputParsing (Lazy.StateT s m) where+   type ParserInput (Lazy.StateT s m) = ParserInput m+   getInput = lift getInput+   getSourcePos = lift getSourcePos+   anyToken = lift anyToken+   take = lift . take+   satisfy = lift . satisfy+   notSatisfy = lift . notSatisfy+   scan state f = lift (scan state f)+   string = lift . string+   takeWhile = lift . takeWhile+   takeWhile1 = lift . takeWhile1++instance (MonadPlus m, InputCharParsing m) => InputCharParsing (Lazy.StateT s m) where+   satisfyCharInput = lift . satisfyCharInput+   notSatisfyChar = lift . notSatisfyChar+   scanChars state f = lift (scanChars state f)+   takeCharsWhile = lift . takeCharsWhile+   takeCharsWhile1 = lift . takeCharsWhile1++instance (MonadPlus m, ConsumedInputParsing m) => ConsumedInputParsing (Lazy.StateT s m) where+  match = mapLazyStateT match++instance (MonadPlus m, InputParsing m) => InputParsing (Strict.StateT s m) where+   type ParserInput (Strict.StateT s m) = ParserInput m+   getInput = lift getInput+   getSourcePos = lift getSourcePos+   anyToken = lift anyToken+   take = lift . take+   satisfy = lift . satisfy+   notSatisfy = lift . notSatisfy+   scan state f = lift (scan state f)+   string = lift . string+   takeWhile = lift . takeWhile+   takeWhile1 = lift . takeWhile1++instance (MonadPlus m, InputCharParsing m) => InputCharParsing (Strict.StateT s m) where+   satisfyCharInput = lift . satisfyCharInput+   notSatisfyChar = lift . notSatisfyChar+   scanChars state f = lift (scanChars state f)+   takeCharsWhile = lift . takeCharsWhile+   takeCharsWhile1 = lift . takeCharsWhile1++instance (MonadPlus m, ConsumedInputParsing m) => ConsumedInputParsing (Strict.StateT s m) where+  match = mapStrictStateT match++instance (MonadPlus m, InputParsing m, Monoid w) => InputParsing (Lazy.RWST r w s m) where+   type ParserInput (Lazy.RWST r w s m) = ParserInput m+   getInput = lift getInput+   getSourcePos = lift getSourcePos+   anyToken = lift anyToken+   take = lift . take+   satisfy = lift . satisfy+   notSatisfy = lift . notSatisfy+   scan state f = lift (scan state f)+   string = lift . string+   takeWhile = lift . takeWhile+   takeWhile1 = lift . takeWhile1++instance (MonadPlus m, InputCharParsing m, Monoid w) => InputCharParsing (Lazy.RWST r w s m) where+   satisfyCharInput = lift . satisfyCharInput+   notSatisfyChar = lift . notSatisfyChar+   scanChars state f = lift (scanChars state f)+   takeCharsWhile = lift . takeCharsWhile+   takeCharsWhile1 = lift . takeCharsWhile1++instance (MonadPlus m, ConsumedInputParsing m, Monoid w) => ConsumedInputParsing (Lazy.RWST r w s m) where+  match = mapLazyRWST match++instance (MonadPlus m, InputParsing m, Monoid w) => InputParsing (Strict.RWST r w s m) where+   type ParserInput (Strict.RWST r w s m) = ParserInput m+   getInput = lift getInput+   getSourcePos = lift getSourcePos+   anyToken = lift anyToken+   take = lift . take+   satisfy = lift . satisfy+   notSatisfy = lift . notSatisfy+   scan state f = lift (scan state f)+   string = lift . string+   takeWhile = lift . takeWhile+   takeWhile1 = lift . takeWhile1++instance (MonadPlus m, InputCharParsing m, Monoid w) => InputCharParsing (Strict.RWST r w s m) where+   satisfyCharInput = lift . satisfyCharInput+   notSatisfyChar = lift . notSatisfyChar+   scanChars state f = lift (scanChars state f)+   takeCharsWhile = lift . takeCharsWhile+   takeCharsWhile1 = lift . takeCharsWhile1++instance (MonadPlus m, ConsumedInputParsing m, Monoid w) => ConsumedInputParsing (Strict.RWST r w s m) where+  match = mapStrictRWST match++#ifdef MIN_VERSION_attoparsec+instance InputParsing Attoparsec.Parser where+   type ParserInput Attoparsec.Parser = ByteString+   getInput = lookAhead Attoparsec.takeByteString+   anyToken = Attoparsec.take 1+   take = Attoparsec.take+   satisfy predicate = Attoparsec.satisfyWith ByteString.singleton predicate+   string = Attoparsec.string+   takeWhile predicate = Attoparsec.takeWhile (predicate . ByteString.singleton)+   takeWhile1 predicate = Attoparsec.takeWhile1 (predicate . ByteString.singleton)+   scan state f = Attoparsec.scan state f'+      where f' s byte = f s (ByteString.singleton byte)++instance InputCharParsing Attoparsec.Parser where+   satisfyCharInput predicate = ByteString.Char8.singleton <$> Attoparsec.Char8.satisfy predicate+   scanChars = Attoparsec.Char8.scan+   takeCharsWhile = Attoparsec.Char8.takeWhile+   takeCharsWhile1 = Attoparsec.Char8.takeWhile1++instance ConsumedInputParsing Attoparsec.Parser where+   match = Attoparsec.match++instance InputParsing Attoparsec.Text.Parser where+   type ParserInput Attoparsec.Text.Parser = Text+   getInput = lookAhead Attoparsec.Text.takeText+   anyToken = Attoparsec.Text.take 1+   take = Attoparsec.Text.take+   satisfy predicate = Attoparsec.Text.satisfyWith Text.singleton predicate+   string = Attoparsec.Text.string+   takeWhile predicate = Attoparsec.Text.takeWhile (predicate . Text.singleton)+   takeWhile1 predicate = Attoparsec.Text.takeWhile1 (predicate . Text.singleton)+   scan state f = Attoparsec.Text.scan state f'+      where f' s c = f s (Text.singleton c)++instance InputCharParsing Attoparsec.Text.Parser where+   satisfyCharInput predicate = Text.singleton <$> Attoparsec.Text.satisfy predicate+   scanChars = Attoparsec.Text.scan+   takeCharsWhile = Attoparsec.Text.takeWhile+   takeCharsWhile1 = Attoparsec.Text.takeWhile1++instance ConsumedInputParsing Attoparsec.Text.Parser where+   match = Attoparsec.Text.match+#endif++#ifdef MIN_VERSION_parsec+instance (FactorialMonoid s, LeftReductive s, Show s, Parsec.Stream s m t, Show t) => InputParsing (ParsecT s u m) where+   type ParserInput (ParsecT s u m) = s+   getInput = Parsec.getInput+   anyToken = do rest <- Parsec.getInput+                 case Factorial.splitPrimePrefix rest+                   of Just (x, rest') -> x <$ Parsec.setInput rest'+                      Nothing -> Parsec.parserFail "anyToken"+   take n = do rest <- Parsec.getInput+               case Factorial.splitAt n rest+                 of (prefix, suffix) | Factorial.length prefix == n -> prefix <$ Parsec.setInput suffix+                    _ -> Parsec.parserFail ("take " ++ show n)++instance (TextualMonoid s, Show s, Parsec.Stream s m Char) => InputCharParsing (ParsecT s u m) where+   satisfyCharInput = fmap Textual.singleton . Parsec.satisfy+#endif++#ifdef MIN_VERSION_binary+instance InputParsing (Lazy Binary.Get) where+   type ParserInput (Lazy Binary.Get) = Lazy.ByteString+   getInput = Lazy (Binary.lookAhead Binary.getRemainingLazyByteString)+   getSourcePos = Lazy (fromStart . fromIntegral <$> Binary.bytesRead)+   anyToken = Lazy (Binary.getLazyByteString 1)+   take n = Lazy (Binary.getLazyByteString $ fromIntegral n)++instance InputParsing (Strict Binary.Get) where+   type ParserInput (Strict Binary.Get) = ByteString+   getInput = Strict (Lazy.toStrict <$> Binary.lookAhead Binary.getRemainingLazyByteString)+   getSourcePos = Strict (fromStart . fromIntegral <$> Binary.bytesRead)+   anyToken = Strict (Binary.getByteString 1)+   take n = Strict (Binary.getByteString n)++instance ConsumedInputParsing (Lazy Binary.Get) where+  match (Lazy p) = Lazy $ do input <- Binary.lookAhead Binary.getRemainingLazyByteString+                             pos <- Binary.bytesRead+                             result <- p+                             pos' <- Binary.bytesRead+                             pure (Lazy.take (pos' - pos) input, result)++instance ConsumedInputParsing (Strict Binary.Get) where+  match (Strict p) = Strict $ do input <- Binary.lookAhead Binary.getRemainingLazyByteString+                                 pos <- Binary.bytesRead+                                 result <- p+                                 pos' <- Binary.bytesRead+                                 pure (Lazy.toStrict (Lazy.take (pos' - pos) input), result)+#endif
+ src/Text/Parser/Input/Position.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A parser's position in the input.++module Text.Parser.Input.Position (Position, fromStart, fromEnd,+                                   offset, context, lineAndColumn) where++import Data.Char (isSpace)+import Data.String (IsString(fromString))+import qualified Data.Monoid.Factorial as Factorial+import qualified Data.Monoid.Textual as Textual+import Data.Monoid.Factorial (FactorialMonoid)+import Data.Monoid.Textual (TextualMonoid)++-- | Opaque data type that represents an input position.+data Position = PositionFromStart !Int+                -- ^ the length of the input from the start to the position+              | PositionFromEnd Int+                -- ^ the length of the input from the position to end+              deriving (Eq, Read, Show)++-- | Construct a 'Position' given the offset from the beginning of the full input.+fromStart :: Int -> Position+fromStart = PositionFromStart++-- | Construct a 'Position' given the length remaining from the position to the end of the input.+fromEnd :: Int -> Position+fromEnd = PositionFromEnd++-- | Map the position into its offset from the beginning of the full input.+--+-- > offset input . fromStart === id+offset :: FactorialMonoid s => s -> Position -> Int+offset wholeInput (PositionFromStart offset) = offset+offset wholeInput (PositionFromEnd remainderLength) = Factorial.length wholeInput - remainderLength+{-# INLINE offset #-}++-- | Given the parser input, a 'Position' within it, and desired number of context lines, returns a description of+-- the offset position in English.+context :: (Eq s, TextualMonoid s) => s -> Position -> Int -> s+context input pos contextLineCount = +   foldMap (<> "\n") prevLines <> lastLinePadding+   <> "at line " <> fromString (show $ length allPrevLines) <> ", column " <> fromString (show $ column+1) <> "\n"+   where (allPrevLines, column) = lineAndColumn input pos+         lastLinePadding+            | (lastLine:_) <- allPrevLines, paddingPrefix <- Textual.takeWhile_ False isSpace lastLine =+                 Factorial.take column (paddingPrefix <> fromString (replicate column ' ')) <> "^\n"+            | otherwise = ""+         prevLines = reverse (take contextLineCount allPrevLines)++-- | Given the full input and an offset within it, returns all the input lines up to and including the offset+-- in reverse order, as well as the zero-based column number of the offset+lineAndColumn :: (Eq s, IsString s, FactorialMonoid s) => s -> Position -> ([s], Int)+lineAndColumn input pos = context [] (offset input pos) (Factorial.split (== "\n") input)+  where context revLines restCount []+          | restCount > 0 = (["Error: the offset is beyond the input length"], -1)+          | otherwise = (revLines, restCount)+        context revLines restCount (next:rest)+          | restCount' < 0 = (next:revLines, restCount)+          | otherwise = context (next:revLines) restCount' rest+          where nextLength = Factorial.length next+                restCount' = restCount - nextLength - 1
+ src/Text/Parser/Internal.hs view
@@ -0,0 +1,36 @@+module Text.Parser.Internal where++import Control.Applicative (Applicative, liftA2)+import qualified Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(WriterT))+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT(WriterT))+import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT(StateT))+import qualified Control.Monad.Trans.State.Strict as Strict (StateT(StateT))+import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST(RWST))+import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(RWST))++mapLazyWriterT :: Applicative m => (m a -> m b) -> Lazy.WriterT w m a -> Lazy.WriterT w m b+mapLazyWriterT f (Lazy.WriterT p) = Lazy.WriterT (apply p)+   where apply m = liftA2 (,) (f $ fst <$> m) (snd <$> m)++mapStrictWriterT :: Applicative m => (m a -> m b) -> Strict.WriterT w m a -> Strict.WriterT w m b+mapStrictWriterT f (Strict.WriterT p) = Strict.WriterT (apply p)+   where apply m = liftA2 (,) (f $ fst <$> m) (snd <$> m)++mapLazyStateT :: Applicative m => (m a -> m b) -> Lazy.StateT w m a -> Lazy.StateT w m b+mapLazyStateT f (Lazy.StateT p) = Lazy.StateT (apply . p)+   where apply m = liftA2 (,) (f $ fst <$> m) (snd <$> m)++mapStrictStateT :: Applicative m => (m a -> m b) -> Strict.StateT s m a -> Strict.StateT s m b+mapStrictStateT f (Strict.StateT p) = Strict.StateT (apply . p)+   where apply m = liftA2 (,) (f $ fst <$> m) (snd <$> m)++mapLazyRWST :: Applicative m => (m a -> m b) -> Lazy.RWST r w s m a -> Lazy.RWST r w s m b+mapLazyRWST f (Lazy.RWST p) = Lazy.RWST (\r-> apply . p r)+   where apply m = liftA2 replaceFstOf3 (f $ fstOf3 <$> m) m++mapStrictRWST :: Applicative m => (m a -> m b) -> Strict.RWST r w s m a -> Strict.RWST r w s m b+mapStrictRWST f (Strict.RWST p) = Strict.RWST (\r-> apply . p r)+   where apply m = liftA2 replaceFstOf3 (f $ fstOf3 <$> m) m++fstOf3 (a, b, c) = a+replaceFstOf3 a (_, b, c) = (a, b, c)
+ src/Text/Parser/Wrapper.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | Newtype wrappers for parsers++module Text.Parser.Wrapper where++import Control.Applicative (Applicative, Alternative)+import Control.Monad (MonadPlus)+import Text.Parser.Combinators (Parsing)+import Text.Parser.LookAhead (LookAheadParsing)+import Text.Parser.Char (CharParsing)+import Text.Parser.Token (TokenParsing)++-- | Wrapper that signifies lazy 'Data.ByteString.Lazy.ByteString' inputs+newtype Lazy   f a = Lazy{getLazy :: f a} deriving (Eq, Ord, Read, Show,+                                                    Functor, Applicative, Alternative,+                                                    Monad, MonadPlus,+                                                    Parsing, LookAheadParsing, CharParsing, TokenParsing)+-- | Wrapper that signifies strict 'Data.ByteString.ByteString' inputs+newtype Strict f a = Strict{getStrict :: f a} deriving (Eq, Ord, Read, Show,+                                                        Functor, Applicative, Alternative,+                                                        Monad, MonadPlus,+                                                        Parsing, LookAheadParsing, CharParsing, TokenParsing)