    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.Parser.Permutation
    -- Copyright   :  (c) Edward Kmett 2011-2012
    --                (c) Paolo Martini 2007
    --                (c) Daan Leijen 1999-2001
    -- License     :  BSD-style
    --
    -- Maintainer  :  ekmett@gmail.com
    -- Stability   :  provisional
    -- Portability :  non-portable
    --
    -- This module implements permutation parsers. 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.
    --
    -----------------------------------------------------------------------------
    module Text.Parser.Permutation
        ( Permutation
        , permute
        , (<||>), (<$$>)
        , (<|?>), (<$?>)
        ) where

    import Control.Applicative
    import qualified Data.Foldable as F (asum)

    infixl 1 <||>, <|?>
    infixl 2 <$$>, <$?>

    ----------------------------------------------------------------
    --  Building a permutation parser
    ----------------------------------------------------------------

    -- | 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@.

    (<||>) :: Functor m => Permutation m (a -> b) -> m a -> Permutation m b
    <||> :: forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> m a -> Permutation m b
    (<||>) = Permutation m (a -> b) -> m a -> Permutation m b
    forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> m a -> Permutation m b
    add
    {-# INLINE (<||>) #-}

    -- | The expression @f \<$$> 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 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.

    (<$$>) :: Functor m => (a -> b) -> m a -> Permutation m b
    <$$> :: forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> m a -> Permutation m b
    (<$$>) a -> b
    f m a
    p = (a -> b) -> Permutation m (a -> b)
    forall a b (m :: * -> *). (a -> b) -> Permutation m (a -> b)
    newPermutation a -> b
    f Permutation m (a -> b) -> m a -> Permutation m b
    forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> m a -> Permutation m b
    <||> m a
    p
    {-# INLINE (<$$>) #-}

    -- | The expression @perm \<|?> (x,p)@ adds parser @p@ to the
    -- permutation parser @perm@. The parser @p@ is optional - if it can
    -- not be applied, the default value @x@ will be used instead. Returns
    -- a new permutation parser that includes the optional parser @p@.

    (<|?>) :: Functor m => Permutation m (a -> b) -> (a, m a) -> Permutation m b
    <|?> :: forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> (a, m a) -> Permutation m b
    (<|?>) Permutation m (a -> b)
    perm (a
    x,m a
    p) = Permutation m (a -> b) -> a -> m a -> Permutation m b
    forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> a -> m a -> Permutation m b
    addOpt Permutation m (a -> b)
    perm a
    x m a
    p
    {-# INLINE (<|?>) #-}

    -- | 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 can not be applied, the default value
    -- @x@ will be used instead.

    (<$?>) :: Functor m => (a -> b) -> (a, m a) -> Permutation m b
    <$?> :: forall (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> (a, m a) -> Permutation m b
    (<$?>) a -> b
    f (a
    x,m a
    p) = (a -> b) -> Permutation m (a -> b)
    forall a b (m :: * -> *). (a -> b) -> Permutation m (a -> b)
    newPermutation a -> b
    f Permutation m (a -> b) -> (a, m a) -> Permutation m b
    forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> (a, m a) -> Permutation m b
    <|?> (a
    x,m a
    p)
    {-# INLINE (<$?>) #-}

    ----------------------------------------------------------------
    -- The permutation tree
    ----------------------------------------------------------------

    -- | The type @Permutation m a@ denotes a permutation parser that,
    -- when converted by the 'permute' function, parses
    -- using the base parsing monad @m@ and returns a value of
    -- type @a@ on success.
    --
    -- Normally, a permutation parser is first build with special operators
    -- like ('<||>') and than transformed into a normal parser
    -- using 'permute'.

    data Permutation m a = Permutation (Maybe a) [Branch m a]

    instance Functor m => Functor (Permutation m) where
      fmap :: forall a b. (a -> b) -> Permutation m a -> Permutation m b
    fmap a -> b
    f (Permutation Maybe a
    x [Branch m a]
    xs) = Maybe b -> [Branch m b] -> Permutation m b
    forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
    Permutation ((a -> b) -> Maybe a -> Maybe b
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Maybe a
    x) ((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]
    xs)

    data Branch m a = forall b. Branch (Permutation m (b -> a)) (m b)

    instance Functor m => Functor (Branch m) where
      fmap :: forall a b. (a -> b) -> Branch m a -> Branch m b
    fmap a -> b
    f (Branch Permutation m (b -> a)
    perm m b
    p) = Permutation m (b -> b) -> m b -> Branch m b
    forall (m :: * -> *) a b.
    Permutation m (b -> a) -> m b -> Branch m a
    Branch (((b -> a) -> b -> b)
    -> Permutation m (b -> a) -> Permutation m (b -> b)
    forall a b. (a -> b) -> Permutation m a -> Permutation m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> b
    f(a -> b) -> (b -> a) -> b -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) Permutation m (b -> a)
    perm) m b
    p

    -- | The parser @permute perm@ parses a permutation of parser described
    -- by @perm@. For example, suppose we want to parse a permutation of:
    -- an optional string of @a@'s, the character @b@ and an optional @c@.
    -- This can be described by:
    --
    -- >  test  = permute (tuple <$?> ("",some (char 'a'))
    -- >                         <||> char 'b'
    -- >                         <|?> ('_',char 'c'))
    -- >        where
    -- >          tuple a b c  = (a,b,c)

    -- transform a permutation tree into a normal parser
    permute :: forall m a. Alternative m => Permutation m a -> m a
    permute :: forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
    permute (Permutation Maybe a
    def [Branch m a]
    xs)
      = [m a] -> m a
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    F.asum ((Branch m a -> m a) -> [Branch m a] -> [m a]
    forall a b. (a -> b) -> [a] -> [b]
    map Branch m a -> m a
    forall {m :: * -> *} {a}. Alternative m => Branch m a -> m a
    branch [Branch m a]
    xs [m a] -> [m a] -> [m a]
    forall a. [a] -> [a] -> [a]
    ++ [m a]
    e)
      where
        e :: [m a]
        e :: [m a]
    e = [m a] -> (a -> [m a]) -> Maybe a -> [m a]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (m a -> [m a]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (m a -> [m a]) -> (a -> m a) -> a -> [m a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> m a
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure) Maybe a
    def
        branch :: Branch m a -> m a
    branch (Branch Permutation m (b -> a)
    perm m b
    p) = ((b -> a) -> b -> a) -> b -> (b -> a) -> a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (b -> a) -> b -> a
    forall a. a -> a
    id (b -> (b -> a) -> a) -> m b -> m ((b -> a) -> a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m b
    p m ((b -> a) -> a) -> m (b -> 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 (b -> a) -> m (b -> a)
    forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
    permute Permutation m (b -> a)
    perm

    -- build permutation trees
    newPermutation :: (a -> b) -> Permutation m (a -> b)
    newPermutation :: forall a b (m :: * -> *). (a -> b) -> Permutation m (a -> b)
    newPermutation a -> b
    f = Maybe (a -> b) -> [Branch m (a -> b)] -> Permutation m (a -> b)
    forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
    Permutation ((a -> b) -> Maybe (a -> b)
    forall a. a -> Maybe a
    Just a -> b
    f) []
    {-# INLINE newPermutation #-}

    add :: Functor m => Permutation m (a -> b) -> m a -> Permutation m b
    add :: forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> m a -> Permutation m b
    add perm :: Permutation m (a -> b)
    perm@(Permutation Maybe (a -> b)
    _mf [Branch m (a -> b)]
    fs) m a
    p
      = Maybe b -> [Branch m b] -> Permutation m b
    forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
    Permutation Maybe b
    forall a. Maybe a
    Nothing (Branch m b
    firstBranch m b -> [Branch m b] -> [Branch m b]
    forall a. a -> [a] -> [a]
    :(Branch m (a -> b) -> Branch m b)
    -> [Branch m (a -> b)] -> [Branch m b]
    forall a b. (a -> b) -> [a] -> [b]
    map Branch m (a -> b) -> Branch m b
    forall {a}. Branch m (a -> a) -> Branch m a
    insert [Branch m (a -> b)]
    fs)
      where
        first :: Branch m b
    first = Permutation m (a -> b) -> m a -> Branch m b
    forall (m :: * -> *) a b.
    Permutation m (b -> a) -> m b -> Branch m a
    Branch Permutation m (a -> b)
    perm m a
    p
        insert :: Branch m (a -> a) -> Branch m a
    insert (Branch Permutation m (b -> a -> a)
    perm' m b
    p')
                = Permutation m (b -> a) -> m b -> Branch m a
    forall (m :: * -> *) a b.
    Permutation m (b -> a) -> m b -> Branch m a
    Branch (Permutation m (a -> b -> a) -> m a -> Permutation m (b -> a)
    forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> m a -> Permutation m b
    add (((b -> a -> a) -> a -> b -> a)
    -> Permutation m (b -> a -> a) -> Permutation m (a -> b -> a)
    forall a b. (a -> b) -> Permutation m a -> Permutation m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (b -> a -> a) -> a -> b -> a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Permutation m (b -> a -> a)
    perm') m a
    p) m b
    p'

    addOpt :: Functor m => Permutation m (a -> b) -> a -> m a -> Permutation m b
    addOpt :: forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> a -> m a -> Permutation m b
    addOpt perm :: Permutation m (a -> b)
    perm@(Permutation Maybe (a -> b)
    mf [Branch m (a -> b)]
    fs) a
    x m a
    p
      = Maybe b -> [Branch m b] -> Permutation m b
    forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
    Permutation (((a -> b) -> b) -> Maybe (a -> b) -> Maybe b
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ a
    x) Maybe (a -> b)
    mf) (Branch m b
    firstBranch m b -> [Branch m b] -> [Branch m b]
    forall a. a -> [a] -> [a]
    :(Branch m (a -> b) -> Branch m b)
    -> [Branch m (a -> b)] -> [Branch m b]
    forall a b. (a -> b) -> [a] -> [b]
    map Branch m (a -> b) -> Branch m b
    forall {a}. Branch m (a -> a) -> Branch m a
    insert [Branch m (a -> b)]
    fs)
      where
        first :: Branch m b
    first = Permutation m (a -> b) -> m a -> Branch m b
    forall (m :: * -> *) a b.
    Permutation m (b -> a) -> m b -> Branch m a
    Branch Permutation m (a -> b)
    perm m a
    p
        insert :: Branch m (a -> a) -> Branch m a
    insert (Branch Permutation m (b -> a -> a)
    perm' m b
    p') = Permutation m (b -> a) -> m b -> Branch m a
    forall (m :: * -> *) a b.
    Permutation m (b -> a) -> m b -> Branch m a
    Branch (Permutation m (a -> b -> a) -> a -> m a -> Permutation m (b -> a)
    forall (m :: * -> *) a b.
    Functor m =>
    Permutation m (a -> b) -> a -> m a -> Permutation m b
    addOpt (((b -> a -> a) -> a -> b -> a)
    -> Permutation m (b -> a -> a) -> Permutation m (a -> b -> a)
    forall a b. (a -> b) -> Permutation m a -> Permutation m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (b -> a -> a) -> a -> b -> a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Permutation m (b -> a -> a)
    perm') a
    x m a
    p) m b
    p'