parser-combinators-1.3.0/0000755000000000000000000000000007346545000013516 5ustar0000000000000000parser-combinators-1.3.0/CHANGELOG.md0000644000000000000000000000512207346545000015327 0ustar0000000000000000## Parser combinators 1.3.0 * Changed the `Control.Applicative.Permutations` module to only require `Applicative` and not `Monad`. This module is the least restrictive and works with parsers which are not `Monad`s. * Added the `Control.Monad.Permutations` module. This module may be substantially more efficient for some parsers which are `Monad`s. * Corrected how permutation parsers intercalate effects and components; parsing an effect requires that a component immediately follows or else a parse error will result. ## Parser combinators 1.2.1 * The tests in `parser-combinators-tests` now work with Megaparsec 8. * Dropped support for GHC 8.2. ## Parser combinators 1.2.0 * Added `manyTill_` and `someTill_` combinators which work like the older `manyTill` and `someTill` except they also return the result of the `end` parser. * Dropped support for GHC 8.0. ## Parser combinators 1.1.0 * Added support for ternary operators; see `TernR` in `Control.Monad.Combinators.Expr`. ## 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.3.0/Control/Applicative/0000755000000000000000000000000007346545000017377 5ustar0000000000000000parser-combinators-1.3.0/Control/Applicative/Combinators.hs0000644000000000000000000002514707346545000022224 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TupleSections #-} -- | -- Module : Control.Applicative.Combinators -- Copyright : © 2017–present 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. 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, manyTill_, someTill, 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@. @end@ result -- is consumed and lost. Use 'manyTill_' if you wish to keep it. -- -- 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 #-} -- | @'manyTill_' p end@ applies parser @p@ /zero/ or more times until -- parser @end@ succeeds. Returns the list of values returned by @p@ and the -- @end@ result. Use 'manyTill' if you have no need in the result of the -- @end@. -- -- See also: 'skipMany', 'skipManyTill'. -- -- @since 1.2.0 manyTill_ :: Alternative m => m a -> m end -> m ([a], end) manyTill_ p end = go where go = (([],) <$> end) <|> liftA2 (\x (xs, y) -> (x : xs, y)) p go {-# INLINE manyTill_ #-} -- | @'someTill' p end@ works similarly to @'manyTill' p end@, but @p@ -- should succeed at least once. @end@ result is consumed and lost. Use -- 'someTill_' if you wish to keep it. -- -- > someTill p end = liftA2 (:) p (manyTill p end) -- -- See also: 'skipSome', 'skipSomeTill'. someTill :: Alternative m => m a -> m end -> m [a] someTill p end = liftA2 (:) p (manyTill p end) {-# INLINE someTill #-} -- | @'someTill_' p end@ works similarly to @'manyTill_' p end@, but @p@ -- should succeed at least once. Use 'someTill' if you have no need in the -- result of the @end@. -- -- See also: 'skipSome', 'skipSomeTill'. -- -- @since 1.2.0 someTill_ :: Alternative m => m a -> m end -> m ([a], end) someTill_ p end = liftA2 (\x (xs, y) -> (x : xs, y)) 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' ()@. -- -- > 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.3.0/Control/Applicative/Combinators/0000755000000000000000000000000007346545000021657 5ustar0000000000000000parser-combinators-1.3.0/Control/Applicative/Combinators/NonEmpty.hs0000644000000000000000000000401707346545000023766 0ustar0000000000000000-- | -- Module : Control.Applicative.Combinators -- Copyright : © 2017–present 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 qualified Control.Applicative.Combinators as C import Data.List.NonEmpty (NonEmpty (..)) 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 #-} parser-combinators-1.3.0/Control/Applicative/Permutations.hs0000644000000000000000000001413307346545000022427 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} -- | -- Module : Control.Applicative.Permutations -- Copyright : © 2017–present 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@ (e.g. 'Text.ParserCombinators.ReadP.ReadP') -- 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 module Control.Applicative.Permutations ( -- ** Permutation type Permutation, -- ** Permutation evaluators runPermutation, intercalateEffect, -- ** Permutation constructors toPermutation, toPermutationWithDefault, ) where import Control.Applicative import Data.Function ((&)) -- | An 'Applicative' wrapper-type for constructing permutation parsers. data Permutation m a = P !(Maybe a) [Branch m a] data Branch m a = forall z. Branch (Permutation m (z -> a)) (m z) instance Functor m => Functor (Permutation m) where fmap f (P v bs) = P (f <$> v) (fmap f <$> bs) instance Functor p => Functor (Branch p) where fmap f (Branch perm p) = Branch (fmap (f .) perm) p instance Functor m => Applicative (Permutation m) where pure value = P (Just value) empty lhs@(P f v) <*> rhs@(P g w) = P (f <*> g) $ (ins2 <$> v) <> (ins1 <$> w) where ins1 (Branch perm p) = Branch ((.) <$> lhs <*> perm) p ins2 (Branch perm p) = Branch (flip <$> perm <*> rhs) p liftA2 f lhs@(P x v) rhs@(P y w) = P (liftA2 f x y) $ (ins2 <$> v) <> (ins1 <$> w) where ins1 (Branch perm p) = Branch (liftA2 ((.) . f) lhs perm) p ins2 (Branch perm p) = Branch (liftA2 (\b g z -> f (g z) b) rhs perm) p -- | \"Unlifts\" a permutation parser into a parser to be evaluated. runPermutation :: Alternative m => -- | Permutation specification Permutation m a -> -- | Resulting base monad capable of handling the permutation m a runPermutation = foldAlt f where -- INCORRECT = runPerms t <*> p f (Branch t p) = (&) <$> p <*> runPermutation t -- | \"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. -- * If an effect is encountered after a component, another component must -- immediately follow the effect. intercalateEffect :: Alternative m => -- | Effect to be intercalated between permutation components m b -> -- | Permutation specification Permutation m a -> -- | Resulting base applicative capable of handling the permutation m a intercalateEffect effect = foldAlt (runBranchEff effect) where runPermEff :: Alternative m => m b -> Permutation m a -> m a runPermEff eff (P v bs) = eff *> foldr ((<|>) . runBranchEff eff) empty bs <|> maybe empty pure v runBranchEff :: Alternative m => m b -> Branch m a -> m a runBranchEff eff (Branch t p) = (&) <$> p <*> runPermEff eff t -- | \"Lifts\" a parser to a permutation parser. toPermutation :: Alternative m => -- | Permutation component m a -> Permutation m a toPermutation = P Nothing . pure . branch -- | \"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 => -- | Default Value a -> -- | Permutation component m a -> Permutation m a toPermutationWithDefault v = P (Just v) . pure . branch branch :: Functor m => m a -> Branch m a branch = Branch $ pure id foldAlt :: Alternative m => (Branch m a -> m a) -> Permutation m a -> m a foldAlt f (P v bs) = foldr ((<|>) . f) (maybe empty pure v) bs parser-combinators-1.3.0/Control/Monad/0000755000000000000000000000000007346545000016174 5ustar0000000000000000parser-combinators-1.3.0/Control/Monad/Combinators.hs0000644000000000000000000002216407346545000021015 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | -- Module : Control.Monad.Combinators -- Copyright : © 2017–present 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 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, manyTill_, some, someTill, someTill_, C.option, sepBy, sepBy1, sepEndBy, sepEndBy1, skipMany, skipSome, skipCount, skipManyTill, skipSomeTill, ) where import qualified Control.Applicative.Combinators as C import Control.Monad ---------------------------------------------------------------------------- -- 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 <- C.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 -> 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 -> 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 <- C.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@. __Note__ that -- @end@ result is consumed and lost. Use 'manyTill_' if you wish to keep -- it. -- -- See also: 'skipMany', 'skipManyTill'. manyTill :: MonadPlus m => m a -> m end -> m [a] manyTill p end = fst <$> manyTill_ p end {-# INLINE manyTill #-} -- | @'manyTill_' p end@ applies parser @p@ /zero/ or more times until -- parser @end@ succeeds. Returns the list of values returned by @p@ and the -- @end@ result. Use 'manyTill' if you have no need in the result of the -- @end@. -- -- See also: 'skipMany', 'skipManyTill'. -- -- @since 1.2.0 manyTill_ :: MonadPlus m => m a -> m end -> m ([a], end) manyTill_ p end = go id where go f = do done <- C.optional end case done of Just done' -> return (f [], done') Nothing -> 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. __Note__ that @end@ result is consumed and -- lost. Use 'someTill_' if you wish to keep it. -- -- > someTill p end = liftM2 (:) p (manyTill p end) -- -- See also: 'skipSome', 'skipSomeTill'. someTill :: MonadPlus m => m a -> m end -> m [a] someTill p end = liftM2 (:) p (manyTill p end) {-# INLINE someTill #-} -- | @'someTill_' p end@ works similarly to @'manyTill_' p end@, but @p@ -- should succeed at least once. Use 'someTill' if you have no need in the -- result of the @end@. -- -- See also: 'skipSome', 'skipSomeTill'. -- -- @since 1.2.0 someTill_ :: MonadPlus m => m a -> m end -> m ([a], end) someTill_ p end = liftM2 (\x (xs, y) -> (x : xs, y)) 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 <- C.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 <- C.optional p case r of Nothing -> return (f []) Just x -> do more <- C.option False (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 <- C.option False (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 <- C.option False (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' ()@. -- -- 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 <- C.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 #-} parser-combinators-1.3.0/Control/Monad/Combinators/0000755000000000000000000000000007346545000020454 5ustar0000000000000000parser-combinators-1.3.0/Control/Monad/Combinators/Expr.hs0000644000000000000000000001514307346545000021732 0ustar0000000000000000-- | -- Module : Control.Monad.Combinators.Expr -- Copyright : © 2017–present 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 = -- | Non-associative infix InfixN (m (a -> a -> a)) | -- | Left-associative infix InfixL (m (a -> a -> a)) | -- | Right-associative infix InfixR (m (a -> a -> a)) | -- | Prefix Prefix (m (a -> a)) | -- | Postfix Postfix (m (a -> a)) | -- | Right-associative ternary. Right-associative means that -- @a ? b : d ? e : f@ parsed as -- @a ? b : (d ? e : f)@ and not as @(a ? b : d) ? e : f@. -- -- The outer monadic action parses the first separator (e.g. @?@) and -- returns an action (of type @m (a -> a -> a -> a)@) that parses the -- second separator (e.g. @:@). -- -- Example usage: -- -- >>> TernR ((If <$ char ':') <$ char '?') TernR (m (m (a -> a -> a -> a))) -- | @'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 => -- | Term parser m a -> -- | Operator table, see 'Operator' [[Operator m a]] -> -- | Resulting expression parser m a 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, tern' x, return x] where (ras, las, nas, prefix, postfix, tern) = 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' tern' = pTernR (choice tern) 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 #-} -- | Parse the first separator of a ternary operator pTernR :: MonadPlus m => m (m (a -> a -> a -> a)) -> m a -> a -> m a pTernR sep1 p x = do sep2 <- sep1 y <- p >>= \r -> pTernR sep1 p r `mplus` return r f <- sep2 z <- p >>= \r -> pTernR sep1 p r `mplus` return r return $ f x y z {-# INLINE pTernR #-} type Batch m a = ( [m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a)], [m (a -> a)], [m (m (a -> a -> 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, tern) = (op : r, l, n, pre, post, tern) splitOp (InfixL op) (r, l, n, pre, post, tern) = (r, op : l, n, pre, post, tern) splitOp (InfixN op) (r, l, n, pre, post, tern) = (r, l, op : n, pre, post, tern) splitOp (Prefix op) (r, l, n, pre, post, tern) = (r, l, n, op : pre, post, tern) splitOp (Postfix op) (r, l, n, pre, post, tern) = (r, l, n, pre, op : post, tern) splitOp (TernR op) (r, l, n, pre, post, tern) = (r, l, n, pre, post, op : tern) parser-combinators-1.3.0/Control/Monad/Combinators/NonEmpty.hs0000644000000000000000000000374207346545000022567 0ustar0000000000000000-- | -- Module : Control.Monad.Combinators.NonEmpty -- Copyright : © 2017–present 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 qualified Control.Monad.Combinators as C import Data.List.NonEmpty (NonEmpty (..)) 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.3.0/Control/Monad/Permutations.hs0000644000000000000000000000616607346545000021233 0ustar0000000000000000-- | -- Module : Control.Monad.Permutations -- Copyright : © 2017–present Alex Washburn -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- This module specialized the interface to 'Monad' for potential efficiency -- considerations, depending on the monad the permutations are run over. -- -- For a more general interface requiring only 'Applicative', and for more -- complete documentation, see the 'Control.Applicative.Permutations' module. -- -- @since 1.3.0 module Control.Monad.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 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 -- | \"Unlifts\" a permutation parser into a parser to be evaluated. runPermutation :: ( Alternative m, Monad m ) => -- | Permutation specification Permutation m a -> -- | Resulting base monad capable of handling the permutation m a 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. intercalateEffect :: ( Alternative m, Monad m ) => -- | Effect to be intercalated between permutation components m b -> -- | Permutation specification Permutation m a -> -- | Resulting base monad capable of handling the permutation m a 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 *> parser) >>= f where f Nothing = maybe empty pure value f (Just p) = run tailSep tailSep p -- | \"Lifts\" a parser to a permutation parser. toPermutation :: Alternative m => -- | Permutation component m a -> 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 => -- | Default Value a -> -- | Permutation component m a -> Permutation m a toPermutationWithDefault v p = P (Just v) $ pure <$> p parser-combinators-1.3.0/LICENSE.md0000644000000000000000000000265607346545000015133 0ustar0000000000000000Copyright © 2017–present 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.3.0/README.md0000644000000000000000000000222007346545000014771 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) ![CI](https://github.com/mrkkrp/parser-combinators/workflows/CI/badge.svg?branch=master) 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. ## License Copyright © 2017–present Mark Karpov Distributed under BSD 3 clause license. parser-combinators-1.3.0/Setup.hs0000644000000000000000000000012707346545000015152 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain parser-combinators-1.3.0/parser-combinators.cabal0000644000000000000000000000304207346545000020313 0ustar0000000000000000cabal-version: 1.18 name: parser-combinators version: 1.3.0 license: BSD3 license-file: LICENSE.md maintainer: Mark Karpov author: Mark Karpov Alex Washburn tested-with: ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.3 homepage: https://github.com/mrkkrp/parser-combinators bug-reports: https://github.com/mrkkrp/parser-combinators/issues synopsis: Lightweight package providing commonly useful parser combinators description: Lightweight package providing commonly useful parser combinators. category: Parsing build-type: Simple 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. default: False manual: True library exposed-modules: Control.Applicative.Combinators Control.Applicative.Combinators.NonEmpty Control.Applicative.Permutations Control.Monad.Combinators Control.Monad.Combinators.Expr Control.Monad.Combinators.NonEmpty Control.Monad.Permutations default-language: Haskell2010 build-depends: base >=4.12 && <5.0 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