parser-combinators-1.0.3/0000755000000000000000000000000013465344071013522 5ustar0000000000000000parser-combinators-1.0.3/CHANGELOG.md0000644000000000000000000000314213465344071015333 0ustar0000000000000000## Parser combinators 1.0.3 * Dropped support for GHC 7.10. * Added a test suite as a separate package called `parser-combinators-tests`. ## Parser combinators 1.0.2 * Defined `liftA2` for `Permutation` manually. The new definition should be more efficient. * Made inner `Maybe` field in `Permutation` strict. ## Parser combinators 1.0.1 * Cosmetic changes in the source code. ## Parser combinators 1.0.0 * Added the `Control.Monad.Combinators.Expr` module. * Dropped the compatibility operators `(<$$>)`, `(<$?>)`, `(<||>)`, and `(<|?>)` from `Control.Applicative.Permutations`. * Dropped support for GHCs older than 7.10. ## Parser combinators 0.4.0 * Improved the documentation. * Re-exported `Control.Applicative.empty` from `Control.Applicative.Combinators`. * Added the `Control.Monad.Combinators` and `Control.Monad.Combinators.NonEmpty` modules which contain more efficient versions of the combinators from `Control.Applicative.Combinators` and `Control.Applicative.Combinators.NonEmpty` respectively. ## Parser combinators 0.3.0 * Added the `skipCount` combinator. * Improved algorithmic efficiency of the `count'` combinator. ## Parser combinators 0.2.1 * Removed the byte order marking at the beginning of the `Control.Applicative.Permutations` module. ## Parser combinators 0.2.0 * Added `Control.Applicative.Combinators.NonEmpty` module that exports non-empty list versions of combinators that cannot return empty lists. * Added `Control.Applicative.Permutations` module that provides generalized permutation parser combinators. ## Parser combinators 0.1.0 * Initial release. parser-combinators-1.0.3/README.md0000644000000000000000000000232713465344071015005 0ustar0000000000000000# Parser combinators [![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) [![Hackage](https://img.shields.io/hackage/v/parser-combinators.svg?style=flat)](https://hackage.haskell.org/package/parser-combinators) [![Stackage Nightly](http://stackage.org/package/parser-combinators/badge/nightly)](http://stackage.org/nightly/package/parser-combinators) [![Stackage LTS](http://stackage.org/package/parser-combinators/badge/lts)](http://stackage.org/lts/package/parser-combinators) [![Build Status](https://travis-ci.org/mrkkrp/parser-combinators.svg?branch=master)](https://travis-ci.org/mrkkrp/parser-combinators) The package provides common parser combinators defined in terms of `Applicative` and `Alternative` without any dependencies but `base`. There are also more efficient versions of the combinators defined in terms of `Monad` and `MonadPlus`. ## Contribution Issues, bugs, and questions may be reported in [the GitHub issue tracker for this project](https://github.com/mrkkrp/parser-combinators/issues). Pull requests are also welcome and will be reviewed quickly. ## License Copyright © 2017–2019 Mark Karpov Distributed under BSD 3 clause license. parser-combinators-1.0.3/parser-combinators.cabal0000644000000000000000000000350013465344071020316 0ustar0000000000000000name: parser-combinators version: 1.0.3 cabal-version: 1.18 tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 license: BSD3 license-file: LICENSE.md author: Mark Karpov Alex Washburn maintainer: Mark Karpov homepage: https://github.com/mrkkrp/parser-combinators bug-reports: https://github.com/mrkkrp/parser-combinators/issues category: Parsing synopsis: Lightweight package providing commonly useful parser combinators build-type: Simple description: Lightweight package providing commonly useful parser combinators. extra-doc-files: CHANGELOG.md , README.md source-repository head type: git location: https://github.com/mrkkrp/parser-combinators.git flag dev description: Turn on development settings. manual: True default: False library build-depends: base >= 4.9 && < 5.0 exposed-modules: Control.Applicative.Combinators , Control.Applicative.Combinators.NonEmpty , Control.Applicative.Permutations , Control.Monad.Combinators , Control.Monad.Combinators.Expr , Control.Monad.Combinators.NonEmpty if flag(dev) ghc-options: -Wall -Werror else ghc-options: -O2 -Wall if flag(dev) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances default-language: Haskell2010 parser-combinators-1.0.3/LICENSE.md0000644000000000000000000000265313465344071015134 0ustar0000000000000000Copyright © 2017–2019 Mark Karpov 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 Mark Karpov nor the names of 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 “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 HOLDERS 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. parser-combinators-1.0.3/Setup.hs0000644000000000000000000000012713465344071015156 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain parser-combinators-1.0.3/Control/0000755000000000000000000000000013465344071015142 5ustar0000000000000000parser-combinators-1.0.3/Control/Monad/0000755000000000000000000000000013465344071016200 5ustar0000000000000000parser-combinators-1.0.3/Control/Monad/Combinators.hs0000644000000000000000000002067713465344071021030 0ustar0000000000000000-- | -- Module : Control.Monad.Combinators -- Copyright : © 2017–2019 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- The module provides more efficient versions of the combinators from -- "Control.Applicative.Combinators" defined in terms of 'Monad' and -- 'MonadPlus' instead of 'Control.Applicative.Applicative' and -- 'Control.Applicative.Alternative'. When there is no difference in -- performance we just re-export the combinators from -- "Control.Applicative.Combinators". -- -- @since 0.4.0 {-# LANGUAGE BangPatterns #-} module Control.Monad.Combinators ( -- * Re-exports from "Control.Applicative" (C.<|>) -- $assocbo , C.optional -- $optional , C.empty -- $empty -- * Original combinators , C.between , C.choice , count , count' , C.eitherP , endBy , endBy1 , many , manyTill , some , someTill , C.option , sepBy , sepBy1 , sepEndBy , sepEndBy1 , skipMany , skipSome , skipCount , skipManyTill , skipSomeTill ) where import Control.Monad import qualified Control.Applicative.Combinators as C ---------------------------------------------------------------------------- -- Re-exports from "Control.Applicative" -- $assocbo -- -- This combinator implements choice. The parser @p 'C.<|>' q@ first applies -- @p@. If it succeeds, the value of @p@ is returned. If @p@ fails, parser -- @q@ is tried. -- $optional -- -- @'C.optional' p@ tries to apply the parser @p@. It will parse @p@ or -- 'Nothing'. It only fails if @p@ fails after consuming input. On success -- result of @p@ is returned inside of 'Just', on failure 'Nothing' is -- returned. -- -- See also: 'C.option'. -- $empty -- -- This parser fails unconditionally without providing any information about -- the cause of the failure. ---------------------------------------------------------------------------- -- Original combinators -- | @'count' n p@ parses @n@ occurrences of @p@. If @n@ is smaller or equal -- to zero, the parser equals to @'return' []@. Returns a list of @n@ -- values. -- -- See also: 'skipCount', 'count''. count :: Monad m => Int -> m a -> m [a] count n' p = go id n' where go f !n = if n <= 0 then return (f []) else do x <- p go (f . (x:)) (n - 1) {-# INLINE count #-} -- | @'count'' m n p@ parses from @m@ to @n@ occurrences of @p@. If @n@ is -- not positive or @m > n@, the parser equals to @'return' []@. Returns a -- list of parsed values. -- -- Please note that @m@ /may/ be negative, in this case effect is the same -- as if it were equal to zero. -- -- See also: 'skipCount', 'count'. count' :: MonadPlus m => Int -> Int -> m a -> m [a] count' m' n' p = if n' > 0 && n' >= m' then gom id m' else return [] where gom f !m = if m > 0 then do x <- p gom (f . (x:)) (m - 1) else god f (if m' <= 0 then n' else n' - m') god f !d = if d > 0 then do r <- optional p case r of Nothing -> return (f []) Just x -> god (f . (x:)) (d - 1) else return (f []) {-# INLINE count' #-} -- | @'endBy' p sep@ parses /zero/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a list of values returned by @p@. -- -- > cStatements = cStatement `endBy` semicolon endBy :: MonadPlus m => m a -> m sep -> m [a] endBy p sep = many (p >>= \x -> re x sep) {-# INLINE endBy #-} -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a list of values returned by @p@. endBy1 :: MonadPlus m => m a -> m sep -> m [a] endBy1 p sep = some (p >>= \x -> re x sep) {-# INLINE endBy1 #-} -- | @'many' p@ applies the parser @p@ /zero/ or more times and returns a -- list of the values returned by @p@. -- -- > identifier = (:) <$> letter <*> many (alphaNumChar <|> char '_') many :: MonadPlus m => m a -> m [a] many p = go id where go f = do r <- optional p case r of Nothing -> return (f []) Just x -> go (f . (x:)) {-# INLINE many #-} -- | @'manyTill' p end@ applies parser @p@ /zero/ or more times until parser -- @end@ succeeds. Returns the list of values returned by @p@. -- -- See also: 'skipMany', 'skipManyTill'. manyTill :: MonadPlus m => m a -> m end -> m [a] manyTill p end = go id where go f = do done <- option False (re True end) if done then return (f []) else do x <- p go (f . (x:)) {-# INLINE manyTill #-} -- | @'some' p@ applies the parser @p@ /one/ or more times and returns a -- list of the values returned by @p@. -- -- > word = some letter some :: MonadPlus m => m a -> m [a] some p = liftM2 (:) p (many p) {-# INLINE some #-} -- | @'someTill' p end@ works similarly to @'manyTill' p end@, but @p@ -- should succeed at least once. -- -- See also: 'skipSome', 'skipSomeTill'. someTill :: MonadPlus m => m a -> m end -> m [a] someTill p end = liftM2 (:) p (manyTill p end) {-# INLINE someTill #-} -- | @'sepBy' p sep@ parses /zero/ or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. -- -- > commaSep p = p `sepBy` comma sepBy :: MonadPlus m => m a -> m sep -> m [a] sepBy p sep = do r <- optional p case r of Nothing -> return [] Just x -> (x:) <$> many (sep >> p) {-# INLINE sepBy #-} -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. sepBy1 :: MonadPlus m => m a -> m sep -> m [a] sepBy1 p sep = do x <- p (x:) <$> many (sep >> p) {-# INLINE sepBy1 #-} -- | @'sepEndBy' p sep@ parses /zero/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@. sepEndBy :: MonadPlus m => m a -> m sep -> m [a] sepEndBy p sep = go id where go f = do r <- optional p case r of Nothing -> return (f []) Just x -> do more <- option False (re True sep) if more then go (f . (x:)) else return (f [x]) {-# INLINE sepEndBy #-} -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@. sepEndBy1 :: MonadPlus m => m a -> m sep -> m [a] sepEndBy1 p sep = do x <- p more <- option False (re True sep) if more then (x:) <$> sepEndBy p sep else return [x] {-# INLINE sepEndBy1 #-} -- | @'skipMany' p@ applies the parser @p@ /zero/ or more times, skipping -- its result. -- -- See also: 'manyTill', 'skipManyTill'. skipMany :: MonadPlus m => m a -> m () skipMany p = go where go = do more <- option False (re True p) when more go {-# INLINE skipMany #-} -- | @'skipSome' p@ applies the parser @p@ /one/ or more times, skipping its -- result. -- -- See also: 'someTill', 'skipSomeTill'. skipSome :: MonadPlus m => m a -> m () skipSome p = p >> skipMany p {-# INLINE skipSome #-} -- | @'skipCount' n p@ parses @n@ occurrences of @p@, skipping its result. -- If @n@ is smaller or equal to zero, the parser equals to @'return' []@. -- Returns a list of @n@ values. -- -- See also: 'count', 'count''. skipCount :: Monad m => Int -> m a -> m () skipCount n' p = go n' where go !n = unless (n <= 0) $ p >> go (n - 1) {-# INLINE skipCount #-} -- | @'skipManyTill' p end@ applies the parser @p@ /zero/ or more times -- skipping results until parser @end@ succeeds. Result parsed by @end@ is -- then returned. -- -- See also: 'manyTill', 'skipMany'. skipManyTill :: MonadPlus m => m a -> m end -> m end skipManyTill p end = go where go = do r <- optional end case r of Nothing -> p >> go Just x -> return x {-# INLINE skipManyTill #-} -- | @'skipSomeTill' p end@ applies the parser @p@ /one/ or more times -- skipping results until parser @end@ succeeds. Result parsed by @end@ is -- then returned. -- -- See also: 'someTill', 'skipSome'. skipSomeTill :: MonadPlus m => m a -> m end -> m end skipSomeTill p end = p >> skipManyTill p end {-# INLINE skipSomeTill #-} ---------------------------------------------------------------------------- -- Compat helpers (for older GHCs) re :: Monad m => a -> m b -> m a re x = fmap (const x) {-# INLINE re #-} option :: MonadPlus m => a -> m a -> m a option x p = p `mplus` return x {-# INLINE option #-} optional :: MonadPlus m => m a -> m (Maybe a) optional p = fmap Just p `mplus` return Nothing {-# INLINE optional #-} parser-combinators-1.0.3/Control/Monad/Combinators/0000755000000000000000000000000013465344071020460 5ustar0000000000000000parser-combinators-1.0.3/Control/Monad/Combinators/NonEmpty.hs0000644000000000000000000000374513465344071022576 0ustar0000000000000000-- | -- Module : Control.Monad.Combinators.NonEmpty -- Copyright : © 2017–2019 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- The module provides 'NonEmpty' list variants of some of the functions -- from "Control.Monad.Combinators". -- -- @since 0.4.0 module Control.Monad.Combinators.NonEmpty ( some , endBy1 , someTill , sepBy1 , sepEndBy1 ) where import Control.Monad import Data.List.NonEmpty (NonEmpty (..)) import qualified Control.Monad.Combinators as C import qualified Data.List.NonEmpty as NE -- | @'some' p@ applies the parser @p@ /one/ or more times and returns a -- list of the values returned by @p@. -- -- > word = some letter some :: MonadPlus m => m a -> m (NonEmpty a) some p = NE.fromList <$> C.some p {-# INLINE some #-} -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a non-empty list of values returned by @p@. endBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) endBy1 p sep = NE.fromList <$> C.endBy1 p sep {-# INLINE endBy1 #-} -- | @'someTill' p end@ works similarly to @'C.manyTill' p end@, but @p@ -- should succeed at least once. -- -- See also: 'C.skipSome', 'C.skipSomeTill'. someTill :: MonadPlus m => m a -> m end -> m (NonEmpty a) someTill p end = NE.fromList <$> C.someTill p end {-# INLINE someTill #-} -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a non-empty list of values returned by @p@. sepBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) sepBy1 p sep = NE.fromList <$> C.sepBy1 p sep {-# INLINE sepBy1 #-} -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a non-empty list of values returned by -- @p@. sepEndBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) sepEndBy1 p sep = NE.fromList <$> C.sepEndBy1 p sep {-# INLINE sepEndBy1 #-} parser-combinators-1.0.3/Control/Monad/Combinators/Expr.hs0000644000000000000000000001315413465344071021736 0ustar0000000000000000-- | -- Module : Control.Monad.Combinators.Expr -- Copyright : © 2017–2019 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : non-portable -- -- A helper module to parse expressions. It can build a parser given a table -- of operators. -- -- @since 1.0.0 module Control.Monad.Combinators.Expr ( Operator (..) , makeExprParser ) where import Control.Monad import Control.Monad.Combinators -- | This data type specifies operators that work on values of type @a@. An -- operator is either binary infix or unary prefix or postfix. A binary -- operator has also an associated associativity. data Operator m a = InfixN (m (a -> a -> a)) -- ^ Non-associative infix | InfixL (m (a -> a -> a)) -- ^ Left-associative infix | InfixR (m (a -> a -> a)) -- ^ Right-associative infix | Prefix (m (a -> a)) -- ^ Prefix | Postfix (m (a -> a)) -- ^ Postfix -- | @'makeExprParser' term table@ builds an expression parser for terms -- @term@ with operators from @table@, taking the associativity and -- precedence specified in the @table@ into account. -- -- @table@ is a list of @[Operator m a]@ lists. The list is ordered in -- descending precedence. All operators in one list have the same precedence -- (but may have different associativity). -- -- Prefix and postfix operators of the same precedence associate to the left -- (i.e. if @++@ is postfix increment, than @-2++@ equals @-1@, not @-3@). -- -- Unary operators of the same precedence can only occur once (i.e. @--2@ is -- not allowed if @-@ is prefix negate). If you need to parse several prefix -- or postfix operators in a row, (like C pointers—@**i@) you can use this -- approach: -- -- > manyUnaryOp = foldr1 (.) <$> some singleUnaryOp -- -- This is not done by default because in some cases allowing repeating -- prefix or postfix operators is not desirable. -- -- If you want to have an operator that is a prefix of another operator in -- the table, use the following (or similar) wrapper (Megaparsec example): -- -- > op n = (lexeme . try) (string n <* notFollowedBy punctuationChar) -- -- 'makeExprParser' takes care of all the complexity involved in building an -- expression parser. Here is an example of an expression parser that -- handles prefix signs, postfix increment and basic arithmetic: -- -- > expr = makeExprParser term table "expression" -- > -- > term = parens expr <|> integer "term" -- > -- > table = [ [ prefix "-" negate -- > , prefix "+" id ] -- > , [ postfix "++" (+1) ] -- > , [ binary "*" (*) -- > , binary "/" div ] -- > , [ binary "+" (+) -- > , binary "-" (-) ] ] -- > -- > binary name f = InfixL (f <$ symbol name) -- > prefix name f = Prefix (f <$ symbol name) -- > postfix name f = Postfix (f <$ symbol name) makeExprParser :: MonadPlus m => m a -- ^ Term parser -> [[Operator m a]] -- ^ Operator table, see 'Operator' -> m a -- ^ Resulting expression parser makeExprParser = foldl addPrecLevel {-# INLINEABLE makeExprParser #-} -- | @addPrecLevel p ops@ adds the ability to parse operators in table @ops@ -- to parser @p@. addPrecLevel :: MonadPlus m => m a -> [Operator m a] -> m a addPrecLevel term ops = term' >>= \x -> choice [ras' x, las' x, nas' x, return x] where (ras, las, nas, prefix, postfix) = foldr splitOp ([],[],[],[],[]) ops term' = pTerm (choice prefix) term (choice postfix) ras' = pInfixR (choice ras) term' las' = pInfixL (choice las) term' nas' = pInfixN (choice nas) term' {-# INLINEABLE addPrecLevel #-} -- | @pTerm prefix term postfix@ parses a @term@ surrounded by optional -- prefix and postfix unary operators. Parsers @prefix@ and @postfix@ are -- allowed to fail, in this case 'id' is used. pTerm :: MonadPlus m => m (a -> a) -> m a -> m (a -> a) -> m a pTerm prefix term postfix = do pre <- option id prefix x <- term post <- option id postfix return . post . pre $ x {-# INLINE pTerm #-} -- | @pInfixN op p x@ parses non-associative infix operator @op@, then term -- with parser @p@, then returns result of the operator application on @x@ -- and the term. pInfixN :: MonadPlus m => m (a -> a -> a) -> m a -> a -> m a pInfixN op p x = do f <- op y <- p return $ f x y {-# INLINE pInfixN #-} -- | @pInfixL op p x@ parses left-associative infix operator @op@, then term -- with parser @p@, then returns result of the operator application on @x@ -- and the term. pInfixL :: MonadPlus m => m (a -> a -> a) -> m a -> a -> m a pInfixL op p x = do f <- op y <- p let r = f x y pInfixL op p r <|> return r {-# INLINE pInfixL #-} -- | @pInfixR op p x@ parses right-associative infix operator @op@, then -- term with parser @p@, then returns result of the operator application on -- @x@ and the term. pInfixR :: MonadPlus m => m (a -> a -> a) -> m a -> a -> m a pInfixR op p x = do f <- op y <- p >>= \r -> pInfixR op p r <|> return r return $ f x y {-# INLINE pInfixR #-} type Batch m a = ( [m (a -> a -> a)] , [m (a -> a -> a)] , [m (a -> a -> a)] , [m (a -> a)] , [m (a -> a)] ) -- | A helper to separate various operators (binary, unary, and according to -- associativity) and return them in a tuple. splitOp :: Operator m a -> Batch m a -> Batch m a splitOp (InfixR op) (r, l, n, pre, post) = (op:r, l, n, pre, post) splitOp (InfixL op) (r, l, n, pre, post) = (r, op:l, n, pre, post) splitOp (InfixN op) (r, l, n, pre, post) = (r, l, op:n, pre, post) splitOp (Prefix op) (r, l, n, pre, post) = (r, l, n, op:pre, post) splitOp (Postfix op) (r, l, n, pre, post) = (r, l, n, pre, op:post) parser-combinators-1.0.3/Control/Applicative/0000755000000000000000000000000013465344071017403 5ustar0000000000000000parser-combinators-1.0.3/Control/Applicative/Combinators.hs0000644000000000000000000002302713465344071022223 0ustar0000000000000000-- | -- Module : Control.Applicative.Combinators -- Copyright : © 2017–2019 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- The module provides parser combinators defined for instances of -- 'Applicative' and 'Alternative'. It also re-exports functions that are -- commonly used in parsing from "Control.Applicative" with additional -- parsing-related comments added. -- -- Due to the nature of the 'Applicative' and 'Alternative' abstractions, -- they are prone to memory leaks and not as efficient as their monadic -- counterparts. Although all the combinators we provide in this module are -- perfectly expressible in terms of 'Applicative' and 'Alternative', please -- prefer "Control.Monad.Combinators" instead when possible. -- -- If you wish that the combinators that cannot return empty lists return -- values of the 'Data.List.NonEmpty.NonEmpty' data type, use the -- "Control.Applicative.Combinators.NonEmpty" module. -- -- === A note on backtracking -- -- Certain parsing libraries, such as Megaparsec, do not backtrack every -- branch of parsing automatically for the sake of performance and better -- error messages. They typically backtrack only “atomic” parsers, e.g. -- those that match a token or several tokens in a row. To backtrack an -- arbitrary complex parser\/branch, a special combinator should be used, -- typically called @try@. Combinators in this module are defined in terms -- 'Applicative' and 'Alternative' operations. Being quite abstract, they -- cannot know anything about inner workings of any concrete parsing -- library, and so they cannot use @try@. -- -- The essential feature of the 'Alternative' type class is the @('<|>')@ -- operator that allows to express choice. In libraries that do not -- backtrack everything automatically, the choice operator and everything -- that is build on top of it require the parser on the left hand side to -- backtrack in order for the alternative branch of parsing to be tried. -- Thus it is the responsibility of the programmer to wrap more complex, -- composite parsers in @try@ to achieve correct behavior. {-# LANGUAGE BangPatterns #-} module Control.Applicative.Combinators ( -- * Re-exports from "Control.Applicative" (<|>) -- $assocbo , many -- $many , some -- $some , optional -- $optional , empty -- $empty -- * Original combinators , between , choice , count , count' , eitherP , endBy , endBy1 , manyTill , someTill , option , sepBy , sepBy1 , sepEndBy , sepEndBy1 , skipMany , skipSome , skipCount , skipManyTill , skipSomeTill ) where import Control.Applicative import Control.Monad (replicateM, replicateM_) import Data.Foldable ---------------------------------------------------------------------------- -- Re-exports from "Control.Applicative" -- $assocbo -- -- This combinator implements choice. The parser @p '<|>' q@ first applies -- @p@. If it succeeds, the value of @p@ is returned. If @p@ fails, parser -- @q@ is tried. -- $many -- -- @'many' p@ applies the parser @p@ /zero/ or more times and returns a list -- of the values returned by @p@. -- -- > identifier = (:) <$> letter <*> many (alphaNumChar <|> char '_') -- $some -- -- @'some' p@ applies the parser @p@ /one/ or more times and returns a list -- of the values returned by @p@. -- -- > word = some letter -- $optional -- -- @'optional' p@ tries to apply the parser @p@. It will parse @p@ or -- 'Nothing'. It only fails if @p@ fails after consuming input. On success -- result of @p@ is returned inside of 'Just', on failure 'Nothing' is -- returned. -- -- See also: 'option'. -- $empty -- -- This parser fails unconditionally without providing any information about -- the cause of the failure. -- -- @since 0.4.0 ---------------------------------------------------------------------------- -- Original combinators -- | @'between' open close p@ parses @open@, followed by @p@ and @close@. -- Returns the value returned by @p@. -- -- > braces = between (symbol "{") (symbol "}") between :: Applicative m => m open -> m close -> m a -> m a between open close p = open *> p <* close {-# INLINE between #-} -- | @'choice' ps@ tries to apply the parsers in the list @ps@ in order, -- until one of them succeeds. Returns the value of the succeeding parser. -- -- > choice = asum choice :: (Foldable f, Alternative m) => f (m a) -> m a choice = asum {-# INLINE choice #-} -- | @'count' n p@ parses @n@ occurrences of @p@. If @n@ is smaller or equal -- to zero, the parser equals to @'pure' []@. Returns a list of @n@ parsed -- values. -- -- > count = replicateM -- -- See also: 'skipCount', 'count''. count :: Applicative m => Int -> m a -> m [a] count = replicateM {-# INLINE count #-} -- | @'count'' m n p@ parses from @m@ to @n@ occurrences of @p@. If @n@ is -- not positive or @m > n@, the parser equals to @'pure' []@. Returns a list -- of parsed values. -- -- Please note that @m@ /may/ be negative, in this case effect is the same -- as if it were equal to zero. -- -- See also: 'skipCount', 'count'. count' :: Alternative m => Int -> Int -> m a -> m [a] count' m' n' p = go m' n' where go !m !n | n <= 0 || m > n = pure [] | m > 0 = liftA2 (:) p (go (m - 1) (n - 1)) | otherwise = liftA2 (:) p (go 0 (n - 1)) <|> pure [] {-# INLINE count' #-} -- | Combine two alternatives. -- -- > eitherP a b = (Left <$> a) <|> (Right <$> b) eitherP :: Alternative m => m a -> m b -> m (Either a b) eitherP a b = (Left <$> a) <|> (Right <$> b) {-# INLINE eitherP #-} -- | @'endBy' p sep@ parses /zero/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a list of values returned by @p@. -- -- > cStatements = cStatement `endBy` semicolon endBy :: Alternative m => m a -> m sep -> m [a] endBy p sep = many (p <* sep) {-# INLINE endBy #-} -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a list of values returned by @p@. endBy1 :: Alternative m => m a -> m sep -> m [a] endBy1 p sep = some (p <* sep) {-# INLINE endBy1 #-} -- | @'manyTill' p end@ applies parser @p@ /zero/ or more times until parser -- @end@ succeeds. Returns the list of values returned by @p@. -- -- See also: 'skipMany', 'skipManyTill'. manyTill :: Alternative m => m a -> m end -> m [a] manyTill p end = go where go = ([] <$ end) <|> liftA2 (:) p go {-# INLINE manyTill #-} -- | @'someTill' p end@ works similarly to @'manyTill' p end@, but @p@ -- should succeed at least once. -- -- See also: 'skipSome', 'skipSomeTill'. someTill :: Alternative m => m a -> m end -> m [a] someTill p end = liftA2 (:) p (manyTill p end) {-# INLINE someTill #-} -- | @'option' x p@ tries to apply the parser @p@. If @p@ fails without -- consuming input, it returns the value @x@, otherwise the value returned -- by @p@. -- -- > option x p = p <|> pure x -- -- See also: 'optional'. option :: Alternative m => a -> m a -> m a option x p = p <|> pure x {-# INLINE option #-} -- | @'sepBy' p sep@ parses /zero/ or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. -- -- > commaSep p = p `sepBy` comma sepBy :: Alternative m => m a -> m sep -> m [a] sepBy p sep = sepBy1 p sep <|> pure [] {-# INLINE sepBy #-} -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. sepBy1 :: Alternative m => m a -> m sep -> m [a] sepBy1 p sep = liftA2 (:) p (many (sep *> p)) {-# INLINE sepBy1 #-} -- | @'sepEndBy' p sep@ parses /zero/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@. sepEndBy :: Alternative m => m a -> m sep -> m [a] sepEndBy p sep = sepEndBy1 p sep <|> pure [] {-# INLINE sepEndBy #-} -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@. sepEndBy1 :: Alternative m => m a -> m sep -> m [a] sepEndBy1 p sep = liftA2 (:) p ((sep *> sepEndBy p sep) <|> pure []) {-# INLINEABLE sepEndBy1 #-} -- | @'skipMany' p@ applies the parser @p@ /zero/ or more times, skipping -- its result. -- -- See also: 'manyTill', 'skipManyTill'. skipMany :: Alternative m => m a -> m () skipMany p = go where go = (p *> go) <|> pure () {-# INLINE skipMany #-} -- | @'skipSome' p@ applies the parser @p@ /one/ or more times, skipping its -- result. -- -- See also: 'someTill', 'skipSomeTill'. skipSome :: Alternative m => m a -> m () skipSome p = p *> skipMany p {-# INLINE skipSome #-} -- | @'skipCount' n p@ parses @n@ occurrences of @p@, skipping its result. -- If @n@ is not positive, the parser equals to @'pure' []@. Returns a list -- of @n@ values. -- -- > skipCount = replicateM_ -- -- See also: 'count', 'count''. -- -- @since 0.3.0 skipCount :: Applicative m => Int -> m a -> m () skipCount = replicateM_ {-# INLINE skipCount #-} -- | @'skipManyTill' p end@ applies the parser @p@ /zero/ or more times -- skipping results until parser @end@ succeeds. Result parsed by @end@ is -- then returned. -- -- See also: 'manyTill', 'skipMany'. skipManyTill :: Alternative m => m a -> m end -> m end skipManyTill p end = go where go = end <|> (p *> go) {-# INLINE skipManyTill #-} -- | @'skipSomeTill' p end@ applies the parser @p@ /one/ or more times -- skipping results until parser @end@ succeeds. Result parsed by @end@ is -- then returned. -- -- See also: 'someTill', 'skipSome'. skipSomeTill :: Alternative m => m a -> m end -> m end skipSomeTill p end = p *> skipManyTill p end {-# INLINE skipSomeTill #-} parser-combinators-1.0.3/Control/Applicative/Permutations.hs0000644000000000000000000001301313465344071022427 0ustar0000000000000000-- | -- Module : Control.Applicative.Permutations -- Copyright : © 2017–2019 Alex Washburn -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- This module is a generalization of the package @parsec-permutation@ -- authored by Samuel Hoffstaetter: -- -- https://hackage.haskell.org/package/parsec-permutation -- -- This module also takes inspiration from the algorithm is described in: -- /Parsing Permutation Phrases/, by Arthur Baars, Andres Löh and Doaitse -- Swierstra. Published as a functional pearl at the Haskell Workshop 2001: -- -- https://www.cs.ox.ac.uk/jeremy.gibbons/wg21/meeting56/loeh-paper.pdf -- -- From these two works we derive a flexible and general method for parsing -- permutations over an 'Applicative' structure. Quite useful in conjunction -- with \"Free\" constructions of 'Applicative's, 'Monad's, etc. -- -- Other permutation parsing libraries tend towards using special \"almost -- applicative\" combinators for construction which denies the library user -- the ability to lift and unlift permutation parsing into any 'Applicative' -- computational context. We redefine these combinators as convenience -- operators here alongside the equivalent 'Applicative' instance. -- -- For example, suppose we want to parse a permutation of: an optional -- string of @a@'s, the character @b@ and an optional @c@. Using a standard -- parsing library combinator @char@, this can be described using the -- 'Applicative' instance by: -- -- > test = runPermutation $ -- > (,,) <$> toPermutationWithDefault "" (some (char 'a')) -- > <*> toPermutation (char 'b') -- > <*> toPermutationWithDefault '_' (char 'c') -- -- @since 0.2.0 {-# LANGUAGE CPP #-} module Control.Applicative.Permutations ( -- ** Permutation type Permutation -- ** Permutation evaluators , runPermutation , intercalateEffect -- ** Permutation constructors , toPermutation , toPermutationWithDefault ) where import Control.Applicative -- | An 'Applicative' wrapper-type for constructing permutation parsers. data Permutation m a = P !(Maybe a) (m (Permutation m a)) instance Functor m => Functor (Permutation m) where fmap f (P v p) = P (f <$> v) (fmap f <$> p) instance Alternative m => Applicative (Permutation m) where pure value = P (Just value) empty lhs@(P f v) <*> rhs@(P g w) = P (f <*> g) (lhsAlt <|> rhsAlt) where lhsAlt = (<*> rhs) <$> v rhsAlt = (lhs <*>) <$> w #if MIN_VERSION_base(4,10,0) liftA2 f lhs@(P x v) rhs@(P y w) = P (liftA2 f x y) (lhsAlt <|> rhsAlt) where lhsAlt = (\p -> liftA2 f p rhs) <$> v rhsAlt = liftA2 f lhs <$> w #endif -- | \"Unlifts\" a permutation parser into a parser to be evaluated. runPermutation :: ( Alternative m , Monad m) => Permutation m a -- ^ Permutation specification -> m a -- ^ Resulting base monad capable of handling the permutation runPermutation (P value parser) = optional parser >>= f where f Nothing = maybe empty pure value f (Just p) = runPermutation p -- | \"Unlifts\" a permutation parser into a parser to be evaluated with an -- intercalated effect. Useful for separators between permutation elements. -- -- For example, suppose that similar to above we want to parse a permutation -- of: an optional string of @a@'s, the character @b@ and an optional @c@. -- /However/, we also want each element of the permutation to be separated -- by a colon. Using a standard parsing library combinator @char@, this can -- be described using the 'Applicative' instance by: -- -- > test = intercalateEffect (char ':') $ -- > (,,) <$> toPermutationWithDefault "" (some (char 'a')) -- > <*> toPermutation (char 'b') -- > <*> toPermutationWithDefault '_' (char 'c') -- -- This will accept strings such as: \"a:b:c\", \"b:c:a\", \"b:aa\", \"b\", -- etc. -- -- Note that the effect is intercalated /between/ permutation components and -- that: -- -- * There is never an effect parsed preceeding the first component of -- the permutation. -- * There is never an effect parsed following the last component of the -- permutation. -- * No effects are intercalated between missing components with a -- default value. intercalateEffect :: ( Alternative m , Monad m) => m b -- ^ Effect to be intercalated between permutation components -> Permutation m a -- ^ Permutation specification -> m a -- ^ Resulting base monad capable of handling the permutation intercalateEffect = run noEffect where noEffect = pure () run :: (Alternative m, Monad m) => m c -> m b -> Permutation m a -> m a run headSep tailSep (P value parser) = optional headSep >>= f where f Nothing = maybe empty pure value f (Just _) = optional parser >>= g g Nothing = maybe empty pure value g (Just p) = run tailSep tailSep p -- | \"Lifts\" a parser to a permutation parser. toPermutation :: Alternative m => m a -- ^ Permutation component -> Permutation m a toPermutation p = P Nothing $ pure <$> p -- | \"Lifts\" a parser with a default value to a permutation parser. -- -- If no permutation containing the supplied parser can be parsed from the input, -- then the supplied default value is returned in lieu of a parse result. toPermutationWithDefault :: Alternative m => a -- ^ Default Value -> m a -- ^ Permutation component -> Permutation m a toPermutationWithDefault v p = P (Just v) $ pure <$> p parser-combinators-1.0.3/Control/Applicative/Combinators/0000755000000000000000000000000013465344071021663 5ustar0000000000000000parser-combinators-1.0.3/Control/Applicative/Combinators/NonEmpty.hs0000644000000000000000000000403013465344071023765 0ustar0000000000000000-- | -- Module : Control.Applicative.Combinators -- Copyright : © 2017–2019 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- The module provides 'NonEmpty' list variants of some of the functions -- from "Control.Applicative.Combinators". -- -- @since 0.2.0 module Control.Applicative.Combinators.NonEmpty ( some , endBy1 , someTill , sepBy1 , sepEndBy1 ) where import Control.Applicative hiding (some) import Data.List.NonEmpty (NonEmpty (..)) import qualified Control.Applicative.Combinators as C import qualified Data.List.NonEmpty as NE -- | @'some' p@ applies the parser @p@ /one/ or more times and returns a -- list of the values returned by @p@. -- -- > word = some letter some :: Alternative m => m a -> m (NonEmpty a) some p = NE.fromList <$> C.some p {-# INLINE some #-} -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a non-empty list of values returned by @p@. endBy1 :: Alternative m => m a -> m sep -> m (NonEmpty a) endBy1 p sep = NE.fromList <$> C.endBy1 p sep {-# INLINE endBy1 #-} -- | @'someTill' p end@ works similarly to @'C.manyTill' p end@, but @p@ -- should succeed at least once. -- -- See also: 'C.skipSome', 'C.skipSomeTill'. someTill :: Alternative m => m a -> m end -> m (NonEmpty a) someTill p end = NE.fromList <$> C.someTill p end {-# INLINE someTill #-} -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a non-empty list of values returned by @p@. sepBy1 :: Alternative m => m a -> m sep -> m (NonEmpty a) sepBy1 p sep = NE.fromList <$> C.sepBy1 p sep {-# INLINE sepBy1 #-} -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a non-empty list of values returned by -- @p@. sepEndBy1 :: Alternative m => m a -> m sep -> m (NonEmpty a) sepEndBy1 p sep = NE.fromList <$> C.sepEndBy1 p sep {-# INLINE sepEndBy1 #-}