content: {-# 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 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
  