    {-# 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.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 :: forall a b. (a -> b) -> Permutation m a -> Permutation m b
    fmap a -> 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 a b. (a -> b) -> Branch m a -> Branch m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> 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)

    instance Functor p => Functor (Branch p) where
      fmap :: forall a b. (a -> b) -> Branch p a -> Branch p b
    fmap a -> 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 a b. (a -> b) -> Permutation p a -> Permutation p 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

    instance Functor m => Applicative (Permutation m) where
      pure :: forall a. a -> Permutation m a
    pure a
    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
    Just a
    value) [Branch m a]
    forall a. [a]
    forall (f :: * -> *) a. Alternative f => f a
    empty
      lhs :: Permutation m (a -> b)
    lhs@(P Maybe (a -> b)
    f [Branch m (a -> b)]
    v) <*> :: forall a b.
    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 a b. 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)
        where
          ins1 :: 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 a b.
    Permutation m (a -> b) -> Permutation m a -> Permutation m 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 a b.
    Permutation m (a -> b) -> Permutation m a -> Permutation m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Permutation m a
    rhs) m z
    p
      liftA2 :: forall a b c.
    (a -> b -> c)
    -> Permutation m a -> Permutation m b -> Permutation m c
    liftA2 a -> 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 a b c. (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
    liftA2 a -> 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)
        where
          ins1 :: 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 a b c.
    (a -> b -> c)
    -> Permutation m a -> Permutation m b -> Permutation m 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 a b c.
    (a -> b -> c)
    -> Permutation m a -> Permutation m b -> Permutation m 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 ::
      Alternative m =>
      -- | Permutation specification
      Permutation m a ->
      -- | Resulting base monad capable of handling the permutation
      m a
    runPermutation :: forall (m :: * -> *) a. Alternative m => 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 <*> p
        f :: 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 a b. m (a -> b) -> m a -> m b
    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 ::
      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 :: forall (m :: * -> *) b a.
    Alternative m =>
    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)
      where
        runPermEff :: Alternative m => m b -> Permutation m a -> m a
        runPermEff :: forall (m :: * -> *) b a.
    Alternative m =>
    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 a b. m a -> m b -> m b
    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 a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (m a -> m a -> m a
    forall a. 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 a. m a
    forall (f :: * -> *) a. Alternative f => f a
    empty [Branch m a]
    bs m a -> m a -> m a
    forall a. 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
    maybe m a
    forall a. m a
    forall (f :: * -> *) a. Alternative f => f a
    empty a -> m a
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe a
    v

        runBranchEff :: Alternative m => m b -> Branch m a -> m a
        runBranchEff :: forall (m :: * -> *) b a. Alternative m => 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 a b. m (a -> b) -> m a -> m b
    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 ::
      Alternative m =>
      -- | Permutation component
      m a ->
      Permutation m a
    toPermutation :: forall (m :: * -> *) a. Alternative m => 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 a. a -> [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 ::
      Alternative m =>
      -- | Default Value
      a ->
      -- | Permutation component
      m a ->
      Permutation m a
    toPermutationWithDefault :: forall (m :: * -> *) a.
    Alternative m =>
    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
    Just a
    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 a. a -> [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 :: Functor m => m a -> Branch m a
    branch :: forall (m :: * -> *) a. Functor m => 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 a. a -> Permutation m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a -> a
    forall a. a -> a
    id

    foldAlt :: Alternative m => (Branch m a -> m a) -> Permutation m a -> m a
    foldAlt :: forall (m :: * -> *) a.
    Alternative m =>
    (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 a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (m a -> m a -> m a
    forall a. 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
    maybe m a
    forall a. m a
    forall (f :: * -> *) a. Alternative f => f a
    empty a -> m a
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe a
    v) [Branch m a]
    bs