diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## 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. diff --git a/Control/Applicative/Combinators.hs b/Control/Applicative/Combinators.hs --- a/Control/Applicative/Combinators.hs +++ b/Control/Applicative/Combinators.hs @@ -28,9 +28,9 @@ -- 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 of the left hand side to --- backtrack in order for the other alternative branch of paring to be --- tried. Thus it is the responsibility of the programmer to wrap more --- complex, composite parsers in @try@ to achieve correct behavior. +-- 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 #-} {-# LANGUAGE CPP #-} diff --git a/Control/Applicative/Combinators/NonEmpty.hs b/Control/Applicative/Combinators/NonEmpty.hs new file mode 100644 --- /dev/null +++ b/Control/Applicative/Combinators/NonEmpty.hs @@ -0,0 +1,66 @@ +-- | +-- Module : Control.Applicative.Combinators +-- Copyright : © 2017 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- This module provides 'NonEmpty' list variants of some of the functions in +-- "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 returned values of @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 #-} diff --git a/Control/Applicative/Permutations.hs b/Control/Applicative/Permutations.hs new file mode 100644 --- /dev/null +++ b/Control/Applicative/Permutations.hs @@ -0,0 +1,213 @@ +-- | +-- Module : Control.Applicative.Permutations +-- Copyright : © 2017 Mark Karpov +-- 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 Loh and Doaitse +-- Swierstra. Published as a functional pearl at the Haskell Workshop 2001. +-- +-- 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 Applicatives, Monads, 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') +-- +-- Equivalently, this can also be describe using the convenience operators +-- reminiscent of other parsing libraries: +-- +-- > test = runPermutation $ +-- > (,,) <$?> ("", some (char 'a')) +-- > <||> char 'b' +-- > <|?> ('_', char 'c') +-- +-- @since 0.2.0 + +module Control.Applicative.Permutations + ( -- ** Permutation type + Permutation + -- ** Permutation evaluators + , runPermutation + , intercalateEffect + -- ** Permutation constructors + , toPermutation + , toPermutationWithDefault + -- ** Convenience operators + , (<$$>) + , (<$?>) + , (<||>) + , (<|?>) ) +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 + +-- | \"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 ':') $ +-- > (,,) <$?> ("", some (char 'a')) +-- > <||> char 'b' +-- > <|?> ('_', 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 + +infixl 1 <||>, <|?> +infixl 2 <$$>, <$?> + +-- | The expression @f \<$$> p@ creates a fresh permutation parser +-- consisting of parser @p@. The the final result of the permutation parser +-- is the function @f@ applied to the return value of @p@. The parser @p@ is +-- not allowed to accept empty input—use the optional combinator ('<$?>') +-- instead. +-- +-- If the function @f@ takes more than one parameter, the type variable @b@ +-- is instantiated to a functional type which combines nicely with the adds +-- parser @p@ to the ('<||>') combinator. This results in stylized code +-- where a permutation parser starts with a combining function @f@ followed +-- by the parsers. The function @f@ gets its parameters in the order in +-- which the parsers are specified, but actual input can be in any order. + +(<$$>) + :: Alternative m + => (a -> b) -- ^ Function to use on result of parsing + -> m a -- ^ Normal parser + -> Permutation m b -- ^ Permutation parser build from it +f <$$> c = toPermutation $ f <$> c + +-- | The expression @f \<$?> (x, p)@ creates a fresh permutation parser +-- consisting of parser @p@. The final result of the permutation parser is +-- the function @f@ applied to the return value of @p@. The parser @p@ is +-- optional—if it cannot be applied, the default value @x@ will be used +-- instead. + +(<$?>) + :: Alternative m + => (a -> b) -- ^ Function to use on result of parsing + -> (a, m a) -- ^ Default value and parser + -> Permutation m b -- ^ Permutation parser +f <$?> (v,c) = f <$> toPermutationWithDefault v c + +-- | The expression @perm \<||> p@ adds parser @p@ to the permutation parser +-- @perm@. The parser @p@ is not allowed to accept empty input—use the +-- optional combinator ('<|?>') instead. Returns a new permutation parser +-- that includes @p@. + +(<||>) + :: Alternative m + => Permutation m (a -> b) -- ^ Given permutation parser + -> m a -- ^ Parser to add (should not accept empty input) + -> Permutation m b -- ^ Resulting parser +p <||> c = p <*> toPermutation c + +-- | The expression @perm \<||> (x, p)@ adds parser @p@ to the permutation +-- parser @perm@. The parser @p@ is optional—if it cannot be applied, the +-- default value @x@ will be used instead. Returns a new permutation parser +-- that includes the optional parser @p@. + +(<|?>) + :: Alternative m + => Permutation m (a -> b) -- ^ Given permutation parser + -> (a, m a) -- ^ Default value and parser + -> Permutation m b -- ^ Resulting parser +p <|?> (v,c) = p <*> toPermutationWithDefault v c diff --git a/parser-combinators.cabal b/parser-combinators.cabal --- a/parser-combinators.cabal +++ b/parser-combinators.cabal @@ -1,6 +1,6 @@ name: parser-combinators -version: 0.1.0 -cabal-version: >= 1.10 +version: 0.2.0 +cabal-version: >= 1.18 tested-with: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 license: BSD3 license-file: LICENSE.md @@ -26,7 +26,13 @@ library build-depends: base >= 4.5 && < 5.0 + + if !impl(ghc >= 8.0) + build-depends: semigroups == 0.18.* + exposed-modules: Control.Applicative.Combinators + , Control.Applicative.Combinators.NonEmpty + , Control.Applicative.Permutations if flag(dev) ghc-options: -Wall -Werror else