{-# LANGUAGE ExistentialQuantification #-}-- |-- Module : Control.Applicative.Permutations-- Copyright : © 2017–present Alex Washburn-- License : BSD 3 clause---- Maintainer : Mark Karpov <markkarpov92@gmail.com>-- 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.0moduleControl.Applicative.Permutations(-- ** Permutation typePermutation ,-- ** Permutation evaluatorsrunPermutation ,intercalateEffect ,-- ** Permutation constructorstoPermutation ,toPermutationWithDefault ,)whereimportControl.ApplicativeimportData.Function((&))-- | An 'Applicative' wrapper-type for constructing permutation parsers.dataPermutation m a =P !(Maybea )[Branch m a ]dataBranch m a =forallz .Branch (Permutation m (z ->a ))(m z )instanceFunctorm =>Functor(Permutation m )wherefmap :: (a -> b) -> Permutation m a -> Permutation m b
fmapa -> b
f (P Maybe a
v [Branch m a]
bs )=Maybe b -> [Branch m b] -> Permutation m b
forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
P (a -> b
f (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Maybe a
v )((a -> b) -> Branch m a -> Branch m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapa -> b
f (Branch m a -> Branch m b) -> [Branch m a] -> [Branch m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Branch m a]
bs )instanceFunctorp =>Functor(Branch p )wherefmap :: (a -> b) -> Branch p a -> Branch p b
fmapa -> b
f (Branch Permutation p (z -> a)
perm p z
p )=Permutation p (z -> b) -> p z -> Branch p b
forall (m :: * -> *) a z.
Permutation m (z -> a) -> m z -> Branch m a
Branch (((z -> a) -> z -> b)
-> Permutation p (z -> a) -> Permutation p (z -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(a -> b
f (a -> b) -> (z -> a) -> z -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)Permutation p (z -> a)
perm )p z
p instanceFunctorm =>Applicative(Permutation m )wherepure :: a -> Permutation m a
purea
value =Maybe a -> [Branch m a] -> Permutation m a
forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
P (a -> Maybe a
forall a. a -> Maybe a
Justa
value )[Branch m a]
forall (f :: * -> *) a. Alternative f => f a
emptylhs :: Permutation m (a -> b)
lhs @(P Maybe (a -> b)
f [Branch m (a -> b)]
v )<*> :: Permutation m (a -> b) -> Permutation m a -> Permutation m b
<*>rhs :: Permutation m a
rhs @(P Maybe a
g [Branch m a]
w )=Maybe b -> [Branch m b] -> Permutation m b
forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
P (Maybe (a -> b)
f Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>Maybe a
g )([Branch m b] -> Permutation m b)
-> [Branch m b] -> Permutation m b
forall a b. (a -> b) -> a -> b
$(Branch m (a -> b) -> Branch m b
forall a. Branch m (a -> a) -> Branch m a
ins2 (Branch m (a -> b) -> Branch m b)
-> [Branch m (a -> b)] -> [Branch m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Branch m (a -> b)]
v )[Branch m b] -> [Branch m b] -> [Branch m b]
forall a. Semigroup a => a -> a -> a
<>(Branch m a -> Branch m b
ins1 (Branch m a -> Branch m b) -> [Branch m a] -> [Branch m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Branch m a]
w )whereins1 :: Branch m a -> Branch m b
ins1 (Branch Permutation m (z -> a)
perm m z
p )=Permutation m (z -> b) -> m z -> Branch m b
forall (m :: * -> *) a z.
Permutation m (z -> a) -> m z -> Branch m a
Branch ((a -> b) -> (z -> a) -> z -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)((a -> b) -> (z -> a) -> z -> b)
-> Permutation m (a -> b) -> Permutation m ((z -> a) -> z -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Permutation m (a -> b)
lhs Permutation m ((z -> a) -> z -> b)
-> Permutation m (z -> a) -> Permutation m (z -> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>Permutation m (z -> a)
perm )m z
p ins2 :: Branch m (a -> a) -> Branch m a
ins2 (Branch Permutation m (z -> a -> a)
perm m z
p )=Permutation m (z -> a) -> m z -> Branch m a
forall (m :: * -> *) a z.
Permutation m (z -> a) -> m z -> Branch m a
Branch ((z -> a -> a) -> a -> z -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip((z -> a -> a) -> a -> z -> a)
-> Permutation m (z -> a -> a) -> Permutation m (a -> z -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Permutation m (z -> a -> a)
perm Permutation m (a -> z -> a)
-> Permutation m a -> Permutation m (z -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>Permutation m a
rhs )m z
p liftA2 :: (a -> b -> c)
-> Permutation m a -> Permutation m b -> Permutation m c
liftA2a -> b -> c
f lhs :: Permutation m a
lhs @(P Maybe a
x [Branch m a]
v )rhs :: Permutation m b
rhs @(P Maybe b
y [Branch m b]
w )=Maybe c -> [Branch m c] -> Permutation m c
forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
P ((a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2a -> b -> c
f Maybe a
x Maybe b
y )([Branch m c] -> Permutation m c)
-> [Branch m c] -> Permutation m c
forall a b. (a -> b) -> a -> b
$(Branch m a -> Branch m c
ins2 (Branch m a -> Branch m c) -> [Branch m a] -> [Branch m c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Branch m a]
v )[Branch m c] -> [Branch m c] -> [Branch m c]
forall a. Semigroup a => a -> a -> a
<>(Branch m b -> Branch m c
ins1 (Branch m b -> Branch m c) -> [Branch m b] -> [Branch m c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Branch m b]
w )whereins1 :: Branch m b -> Branch m c
ins1 (Branch Permutation m (z -> b)
perm m z
p )=Permutation m (z -> c) -> m z -> Branch m c
forall (m :: * -> *) a z.
Permutation m (z -> a) -> m z -> Branch m a
Branch ((a -> (z -> b) -> z -> c)
-> Permutation m a
-> Permutation m (z -> b)
-> Permutation m (z -> c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2((b -> c) -> (z -> b) -> z -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)((b -> c) -> (z -> b) -> z -> c)
-> (a -> b -> c) -> a -> (z -> b) -> z -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> b -> c
f )Permutation m a
lhs Permutation m (z -> b)
perm )m z
p ins2 :: Branch m a -> Branch m c
ins2 (Branch Permutation m (z -> a)
perm m z
p )=Permutation m (z -> c) -> m z -> Branch m c
forall (m :: * -> *) a z.
Permutation m (z -> a) -> m z -> Branch m a
Branch ((b -> (z -> a) -> z -> c)
-> Permutation m b
-> Permutation m (z -> a)
-> Permutation m (z -> c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2(\b
b z -> a
g z
z ->a -> b -> c
f (z -> a
g z
z )b
b )Permutation m b
rhs Permutation m (z -> a)
perm )m z
p -- | \"Unlifts\" a permutation parser into a parser to be evaluated.runPermutation ::Alternativem =>-- | Permutation specificationPermutation m a ->-- | Resulting base monad capable of handling the permutationm a runPermutation :: Permutation m a -> m a
runPermutation =(Branch m a -> m a) -> Permutation m a -> m a
forall (m :: * -> *) a.
Alternative m =>
(Branch m a -> m a) -> Permutation m a -> m a
foldAlt Branch m a -> m a
forall (m :: * -> *) a. Alternative m => Branch m a -> m a
f where-- INCORRECT = runPerms t <*> pf :: Branch m a -> m a
f (Branch Permutation m (z -> a)
t m z
p )=z -> (z -> a) -> a
forall a b. a -> (a -> b) -> b
(&)(z -> (z -> a) -> a) -> m z -> m ((z -> a) -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>m z
p m ((z -> a) -> a) -> m (z -> a) -> m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>Permutation m (z -> a) -> m (z -> a)
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation Permutation m (z -> a)
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 ::Alternativem =>-- | Effect to be intercalated between permutation componentsm b ->-- | Permutation specificationPermutation m a ->-- | Resulting base applicative capable of handling the permutationm a intercalateEffect :: m b -> Permutation m a -> m a
intercalateEffect m b
effect =(Branch m a -> m a) -> Permutation m a -> m a
forall (m :: * -> *) a.
Alternative m =>
(Branch m a -> m a) -> Permutation m a -> m a
foldAlt (m b -> Branch m a -> m a
forall (m :: * -> *) b a. Alternative m => m b -> Branch m a -> m a
runBranchEff m b
effect )whererunPermEff ::Alternativem =>m b ->Permutation m a ->m a runPermEff :: m b -> Permutation m a -> m a
runPermEff m b
eff (P Maybe a
v [Branch m a]
bs )=m b
eff m b -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>(Branch m a -> m a -> m a) -> m a -> [Branch m a] -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr(m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)(m a -> m a -> m a)
-> (Branch m a -> m a) -> Branch m a -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.m b -> Branch m a -> m a
forall (m :: * -> *) b a. Alternative m => m b -> Branch m a -> m a
runBranchEff m b
eff )m a
forall (f :: * -> *) a. Alternative f => f a
empty[Branch m a]
bs m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybem a
forall (f :: * -> *) a. Alternative f => f a
emptya -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pureMaybe a
v runBranchEff ::Alternativem =>m b ->Branch m a ->m a runBranchEff :: m b -> Branch m a -> m a
runBranchEff m b
eff (Branch Permutation m (z -> a)
t m z
p )=z -> (z -> a) -> a
forall a b. a -> (a -> b) -> b
(&)(z -> (z -> a) -> a) -> m z -> m ((z -> a) -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>m z
p m ((z -> a) -> a) -> m (z -> a) -> m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>m b -> Permutation m (z -> a) -> m (z -> a)
forall (m :: * -> *) b a.
Alternative m =>
m b -> Permutation m a -> m a
runPermEff m b
eff Permutation m (z -> a)
t -- | \"Lifts\" a parser to a permutation parser.toPermutation ::Alternativem =>-- | Permutation componentm a ->Permutation m a toPermutation :: m a -> Permutation m a
toPermutation =Maybe a -> [Branch m a] -> Permutation m a
forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
P Maybe a
forall a. Maybe a
Nothing([Branch m a] -> Permutation m a)
-> (m a -> [Branch m a]) -> m a -> Permutation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Branch m a -> [Branch m a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Branch m a -> [Branch m a])
-> (m a -> Branch m a) -> m a -> [Branch m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.m a -> Branch m a
forall (m :: * -> *) a. Functor m => m a -> Branch m a
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 ::Alternativem =>-- | Default Valuea ->-- | Permutation componentm a ->Permutation m a toPermutationWithDefault :: a -> m a -> Permutation m a
toPermutationWithDefault a
v =Maybe a -> [Branch m a] -> Permutation m a
forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
P (a -> Maybe a
forall a. a -> Maybe a
Justa
v )([Branch m a] -> Permutation m a)
-> (m a -> [Branch m a]) -> m a -> Permutation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Branch m a -> [Branch m a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Branch m a -> [Branch m a])
-> (m a -> Branch m a) -> m a -> [Branch m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.m a -> Branch m a
forall (m :: * -> *) a. Functor m => m a -> Branch m a
branch branch ::Functorm =>m a ->Branch m a branch :: m a -> Branch m a
branch =Permutation m (a -> a) -> m a -> Branch m a
forall (m :: * -> *) a z.
Permutation m (z -> a) -> m z -> Branch m a
Branch (Permutation m (a -> a) -> m a -> Branch m a)
-> Permutation m (a -> a) -> m a -> Branch m a
forall a b. (a -> b) -> a -> b
$(a -> a) -> Permutation m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
purea -> a
forall a. a -> a
idfoldAlt ::Alternativem =>(Branch m a ->m a )->Permutation m a ->m a foldAlt :: (Branch m a -> m a) -> Permutation m a -> m a
foldAlt Branch m a -> m a
f (P Maybe a
v [Branch m a]
bs )=(Branch m a -> m a -> m a) -> m a -> [Branch m a] -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr(m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)(m a -> m a -> m a)
-> (Branch m a -> m a) -> Branch m a -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Branch m a -> m a
f )(m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybem a
forall (f :: * -> *) a. Alternative f => f a
emptya -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pureMaybe a
v )[Branch m a]
bs