input-parsers-0.3.0.2/0000755000000000000000000000000007346545000012657 5ustar0000000000000000input-parsers-0.3.0.2/CHANGELOG.md0000644000000000000000000000221407346545000014467 0ustar0000000000000000# Revision history for input-parsers ## 0.3.0.2 -- 2023-11-25 * Incremented the upper bound of the `bytestring` and `text` dependencies. ## 0.3.0.1 -- 2023-06-17 * Incremented the upper bound of the `transformers` dependency. ## 0.3 -- 2022-10-02 * Dropped support for GHC < 8.4 * Incremented the upper bound of the `monoid-subclasses` dependency. * Added `-Wall` and fixed all warnings. ## 0.2.3.2 -- 2022-03-25 * Incremented the upper bound of the `text` dependency. ## 0.2.3.1 -- 2021-11-25 * Incremented the upper bound of the optional `attoparsec` dependency. ## 0.2.3 -- 2021-03-26 * Improved documentation * Fixed compilation with GHC 8.2.2 ## 0.2.2 -- 2021-03-26 * Move Data.ByteString and Data.ByteString.Lazy imports outside ifdef (by Gary Coady) * Exported all Position methods ## 0.2.1 -- 2021-03-09 * Changed the default instance of `ParserPosition`, made `Position` a subclass of `Ord`. ## 0.2 -- 2021-03-07 * Added `ParserPosition` and made `Position` a class. Deprecated. ## 0.1.0.1 -- 2020-07-19 * Incremented the upper bound of `base` dependency. ## 0.1.0.0 -- 2020-07-18 * First version. Released on an unsuspecting world. input-parsers-0.3.0.2/LICENSE0000644000000000000000000000277207346545000013674 0ustar0000000000000000Copyright (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. input-parsers-0.3.0.2/README.md0000644000000000000000000000370007346545000014136 0ustar0000000000000000input-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. Finally, the package provides the class [`Position`](http://hackage.haskell.org/package/input-parsers/docs/Text-Parser-Input-Position.html#t:Position) to abstract over the position the parser reached in the input stream. input-parsers-0.3.0.2/Setup.hs0000644000000000000000000000005607346545000014314 0ustar0000000000000000import Distribution.Simple main = defaultMain input-parsers-0.3.0.2/input-parsers.cabal0000644000000000000000000000370207346545000016461 0ustar0000000000000000cabal-version: >=1.10 name: input-parsers version: 0.3.0.2 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 tested-with: ghc==9.0.1, GHC==8.10.4, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 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 && <5, bytestring >=0.10 && <0.13, text >=1.2 && <2.2, monoid-subclasses >= 1.0 && < 1.3, parsers >= 0.12 && < 0.13, transformers >=0.2 && <0.7 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.15, bytestring >= 0.9 && < 0.13, text >= 0.1 && < 2.2 hs-source-dirs: src default-language: Haskell2010 GHC-options: -Wall input-parsers-0.3.0.2/src/Text/Parser/0000755000000000000000000000000007346545000015626 5ustar0000000000000000input-parsers-0.3.0.2/src/Text/Parser/Deterministic.hs0000644000000000000000000001451007346545000020766 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} -- | Deterministic parsers can be restricted to succeed with a single parsing result. module Text.Parser.Deterministic where import Control.Applicative (Alternative ((<|>), many, some), liftA2, optional) 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 Text.ParserCombinators.ReadP (ReadP) import qualified Text.ParserCombinators.ReadP as ReadP import Text.Parser.Combinators (Parsing, notFollowedBy, try) import Text.Parser.Internal (mapLazyWriterT, mapStrictWriterT, mapLazyStateT, mapStrictStateT, mapLazyRWST, mapStrictRWST) import Text.Parser.Wrapper (Lazy(..), Strict(..)) #ifdef MIN_VERSION_attoparsec import qualified Data.Attoparsec.ByteString as Attoparsec import qualified Data.Attoparsec.Text as Attoparsec.Text #endif #ifdef MIN_VERSION_binary 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 'many', 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 input-parsers-0.3.0.2/src/Text/Parser/Input.hs0000644000000000000000000005360207346545000017267 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} #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(..)) where import Control.Applicative (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) import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT) import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT) import qualified Control.Monad.Trans.State.Strict as Strict (StateT) import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST) import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as Lazy import Data.Ord (Down) import Text.ParserCombinators.ReadP (ReadP) import qualified Text.ParserCombinators.ReadP as ReadP import Text.Parser.Char (CharParsing) import Text.Parser.Combinators (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.Text (Text) 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_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 (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 type ParserPosition 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 (ParserPosition m) -- | 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) type ParserPosition m = Down Int default getSourcePos :: (FactorialMonoid (ParserInput m), Functor m, ParserPosition m ~ Down Int) => m (ParserPosition m) 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 type ParserPosition (IdentityT m) = ParserPosition 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 type ParserPosition (ReaderT e m) = ParserPosition 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 type ParserPosition (Lazy.WriterT w m) = ParserPosition 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 type ParserPosition (Strict.WriterT w m) = ParserPosition 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 type ParserPosition (Lazy.StateT s m) = ParserPosition 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 type ParserPosition (Strict.StateT s m) = ParserPosition 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 type ParserPosition (Lazy.RWST r w s m) = ParserPosition 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 type ParserPosition (Strict.RWST r w s m) = ParserPosition 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 type ParserPosition (Lazy Binary.Get) = Int 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 type ParserPosition (Strict Binary.Get) = Int 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 input-parsers-0.3.0.2/src/Text/Parser/Input/0000755000000000000000000000000007346545000016725 5ustar0000000000000000input-parsers-0.3.0.2/src/Text/Parser/Input/Position.hs0000644000000000000000000000620707346545000021072 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | A parser's position in the input. module Text.Parser.Input.Position (Position(..), fromStart, fromEnd, context, lineAndColumn) where import Data.Char (isSpace) import Data.String (IsString(fromString)) import Data.Ord (Down(Down)) import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Textual as Textual import Data.Monoid.Factorial (FactorialMonoid) import Data.Monoid.Textual (TextualMonoid) -- | A class for representing position values. The methods satisfy these laws: -- -- > move (distance pos1 pos2) pos1 == pos2 -- > (pos1 < pos2) == (distance pos1 pos2 > 0) class Ord p => Position p where -- | Distance from the first position to the second distance :: p -> p -> Int -- | Move the position by the given distance. move :: Int -> p -> p -- | Map the position into its offset from the beginning of the full input. offset :: FactorialMonoid s => s -> p -> Int instance Position Int where distance = flip (-) move = (+) offset = const id instance Position a => Position (Down a) where distance (Down p1) (Down p2) = distance p2 p1 move dist (Down p) = Down (move (negate dist) p) offset wholeInput (Down p) = Factorial.length wholeInput - offset wholeInput p {-# INLINE distance #-} {-# INLINE move #-} {-# INLINE offset #-} -- | Construct a 'Position' given the offset from the beginning of the full input. fromStart :: Int -> Int fromStart = id -- | Construct a 'Position' given the length remaining from the position to the end of the input. fromEnd :: Int -> Down Int fromEnd = Down -- | 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, Position p) => s -> p -> 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, Position p) => s -> p -> ([s], Int) lineAndColumn input pos = go [] (offset input pos) (Factorial.split (== "\n") input) where go revLines restCount [] | restCount > 0 = (["Error: the offset is beyond the input length"], -1) | otherwise = (revLines, restCount) go revLines restCount (next:rest) | restCount' < 0 = (next:revLines, restCount) | otherwise = go (next:revLines) restCount' rest where nextLength = Factorial.length next restCount' = restCount - nextLength - 1 input-parsers-0.3.0.2/src/Text/Parser/Internal.hs0000644000000000000000000000362207346545000017741 0ustar0000000000000000module Text.Parser.Internal where import Control.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 fstOf3 (a, _, _) = a replaceFstOf3 :: a -> (x, b, c) -> (a, b, c) replaceFstOf3 a (_, b, c) = (a, b, c) input-parsers-0.3.0.2/src/Text/Parser/Wrapper.hs0000644000000000000000000000224507346545000017605 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Newtype wrappers for parsers module Text.Parser.Wrapper where import Control.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)