    {-# LANGUAGE CPP #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    #if __GLASGOW_HASKELL__ >= 707
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE Safe #-}
    #else
    -- Manual Typeable instances

    {-# LANGUAGE Trustworthy #-}
    #endif
    #include "free-common.h"

    -----------------------------------------------------------------------------

    -- |

    -- Module      :  Control.Alternative.Free

    -- Copyright   :  (C) 2012 Edward Kmett

    -- License     :  BSD-style (see the file LICENSE)

    --

    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>

    -- Stability   :  provisional

    -- Portability :  GADTs, Rank2Types

    --

    -- Left distributive 'Alternative' functors for free, based on a design

    -- by Stijn van Drongelen.

    ----------------------------------------------------------------------------

    module Control.Alternative.Free
      ( Alt(..)
      , AltF(..)
      , runAlt
      , liftAlt
      , hoistAlt
      ) where

    import Control.Applicative
    import Data.Functor.Apply
    import Data.Functor.Alt ((<!>))
    import qualified Data.Functor.Alt as Alt
    import Data.Typeable

    #if !(MIN_VERSION_base(4,11,0))
    import Data.Semigroup
    #endif

    infixl 3 `Ap`

    data AltF f a where
      Ap     :: f a -> Alt f (a -> b) -> AltF f b
      Pure   :: a                     -> AltF f a
    #if __GLASGOW_HASKELL__ >= 707
      deriving Typeable
    #endif

    newtype Alt f a = Alt { forall (f :: * -> *) a. Alt f a -> [AltF f a]
    alternatives :: [AltF f a] }
    #if __GLASGOW_HASKELL__ >= 707
      deriving Typeable
    #endif

    instance Functor (AltF f) where
      fmap :: forall a b. (a -> b) -> AltF f a -> AltF f b
    fmap a -> b
    f (Pure a
    a) = b -> AltF f b
    forall a (f :: * -> *). a -> AltF f a
    Pure (b -> AltF f b) -> b -> AltF f b
    forall a b. (a -> b) -> a -> b
    $ a -> b
    f a
    a
      fmap a -> b
    f (Ap f a
    x Alt f (a -> a)
    g) = f a
    x f a -> Alt f (a -> b) -> AltF f b
    forall (f :: * -> *) a b. f a -> Alt f (a -> b) -> AltF f b
    `Ap` ((a -> a) -> a -> b) -> Alt f (a -> a) -> Alt f (a -> b)
    forall a b. (a -> b) -> Alt f a -> Alt f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> b
    f (a -> b) -> (a -> a) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) Alt f (a -> a)
    g

    instance Functor (Alt f) where
      fmap :: forall a b. (a -> b) -> Alt f a -> Alt f b
    fmap a -> b
    f (Alt [AltF f a]
    xs) = [AltF f b] -> Alt f b
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt ([AltF f b] -> Alt f b) -> [AltF f b] -> Alt f b
    forall a b. (a -> b) -> a -> b
    $ (AltF f a -> AltF f b) -> [AltF f a] -> [AltF f b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> b) -> AltF f a -> AltF f b
    forall a b. (a -> b) -> AltF f a -> AltF f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) [AltF f a]
    xs

    instance Applicative (AltF f) where
      pure :: forall a. a -> AltF f a
    pure = a -> AltF f a
    forall a (f :: * -> *). a -> AltF f a
    Pure
      {-# INLINE pure #-}
      (Pure a -> b
    f)   <*> :: forall a b. AltF f (a -> b) -> AltF f a -> AltF f b
    <*> AltF f a
    y         = (a -> b) -> AltF f a -> AltF f b
    forall a b. (a -> b) -> AltF f a -> AltF f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f AltF f a
    y      -- fmap

      AltF f (a -> b)
    y          <*> (Pure a
    a)  = ((a -> b) -> b) -> AltF f (a -> b) -> AltF f b
    forall a b. (a -> b) -> AltF f a -> AltF f 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
    a) AltF f (a -> b)
    y  -- interchange

      (Ap f a
    a Alt f (a -> a -> b)
    f)   <*> AltF f a
    b         = f a
    a f a -> Alt f (a -> b) -> AltF f b
    forall (f :: * -> *) a b. f a -> Alt f (a -> b) -> AltF f b
    `Ap` ((a -> a -> b) -> a -> a -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((a -> a -> b) -> a -> a -> b)
    -> Alt f (a -> a -> b) -> Alt f (a -> a -> b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Alt f (a -> a -> b)
    f Alt f (a -> a -> b) -> Alt f a -> Alt f (a -> b)
    forall a b. Alt f (a -> b) -> Alt f a -> Alt f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ([AltF f a] -> Alt f a
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt [AltF f a
    b]))
      {-# INLINE (<*>) #-}

    instance Applicative (Alt f) where
      pure :: forall a. a -> Alt f a
    pure a
    a = [AltF f a] -> Alt f a
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt [a -> AltF f a
    forall a. a -> AltF f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    a]
      {-# INLINE pure #-}

      (Alt [AltF f (a -> b)]
    xs) <*> :: forall a b. Alt f (a -> b) -> Alt f a -> Alt f b
    <*> Alt f a
    ys = [AltF f b] -> Alt f b
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt ([AltF f (a -> b)]
    xs [AltF f (a -> b)] -> (AltF f (a -> b) -> [AltF f b]) -> [AltF f b]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Alt f b -> [AltF f b]
    forall (f :: * -> *) a. Alt f a -> [AltF f a]
    alternatives (Alt f b -> [AltF f b])
    -> (AltF f (a -> b) -> Alt f b) -> AltF f (a -> b) -> [AltF f b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AltF f (a -> b) -> Alt f a -> Alt f b
    forall a b. AltF f (a -> b) -> Alt f a -> Alt f b
    `ap'` Alt f a
    ys))
        where
          ap' :: AltF f (a -> b) -> Alt f a -> Alt f b

          Pure a -> b
    f ap' :: forall a b. AltF f (a -> b) -> Alt f a -> Alt f b
    `ap'` Alt f a
    u      = (a -> b) -> Alt f a -> Alt f b
    forall a b. (a -> b) -> Alt f a -> Alt f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Alt f a
    u
          (f a
    u `Ap` Alt f (a -> a -> b)
    f) `ap'` Alt f a
    v  = [AltF f b] -> Alt f b
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt [f a
    u f a -> Alt f (a -> b) -> AltF f b
    forall (f :: * -> *) a b. f a -> Alt f (a -> b) -> AltF f b
    `Ap` ((a -> a -> b) -> a -> a -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((a -> a -> b) -> a -> a -> b)
    -> Alt f (a -> a -> b) -> Alt f (a -> a -> b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Alt f (a -> a -> b)
    f) Alt f (a -> a -> b) -> Alt f a -> Alt f (a -> b)
    forall a b. Alt f (a -> b) -> Alt f a -> Alt f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Alt f a
    v]
      {-# INLINE (<*>) #-}

    liftAltF :: f a -> AltF f a
    liftAltF :: forall (f :: * -> *) a. f a -> AltF f a
    liftAltF f a
    x = f a
    x f a -> Alt f (a -> a) -> AltF f a
    forall (f :: * -> *) a b. f a -> Alt f (a -> b) -> AltF f b
    `Ap` (a -> a) -> Alt f (a -> a)
    forall a. a -> Alt f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a -> a
    forall a. a -> a
    id
    {-# INLINE liftAltF #-}

    -- | A version of 'lift' that can be used with any @f@.

    liftAlt :: f a -> Alt f a
    liftAlt :: forall (f :: * -> *) a. f a -> Alt f a
    liftAlt = [AltF f a] -> Alt f a
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt ([AltF f a] -> Alt f a) -> (f a -> [AltF f a]) -> f a -> Alt f a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (AltF f a -> [AltF f a] -> [AltF f a]
    forall a. a -> [a] -> [a]
    :[]) (AltF f a -> [AltF f a]) -> (f a -> AltF f a) -> f a -> [AltF f a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f a -> AltF f a
    forall (f :: * -> *) a. f a -> AltF f a
    liftAltF
    {-# INLINE liftAlt #-}

    -- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.

    runAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
    runAlt :: forall (f :: * -> *) (g :: * -> *) a.
    Alternative g =>
    (forall x. f x -> g x) -> Alt f a -> g a
    runAlt forall x. f x -> g x
    u Alt f a
    xs0 = Alt f a -> g a
    forall b. Alt f b -> g b
    go Alt f a
    xs0 where

      go  :: Alt f b -> g b
      go :: forall b. Alt f b -> g b
    go (Alt [AltF f b]
    xs) = (AltF f b -> g b -> g b) -> g b -> [AltF f b] -> g b
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\AltF f b
    r g b
    a -> (AltF f b -> g b
    forall b. AltF f b -> g b
    go2 AltF f b
    r) g b -> g b -> g b
    forall a. g a -> g a -> g a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> g b
    a) g b
    forall a. g a
    forall (f :: * -> *) a. Alternative f => f a
    empty [AltF f b]
    xs

      go2 :: AltF f b -> g b
      go2 :: forall b. AltF f b -> g b
    go2 (Pure b
    a) = b -> g b
    forall a. a -> g a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure b
    a
      go2 (Ap f a
    x Alt f (a -> b)
    f) = ((a -> b) -> a -> b) -> a -> (a -> b) -> b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (a -> b) -> a -> b
    forall a. a -> a
    id (a -> (a -> b) -> b) -> g a -> g ((a -> b) -> b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> f a -> g a
    forall x. f x -> g x
    u f a
    x g ((a -> b) -> b) -> g (a -> b) -> g b
    forall a b. g (a -> b) -> g a -> g b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Alt f (a -> b) -> g (a -> b)
    forall b. Alt f b -> g b
    go Alt f (a -> b)
    f
    {-# INLINABLE runAlt #-}

    instance Apply (Alt f) where
      <.> :: forall a b. Alt f (a -> b) -> Alt f a -> Alt f b
    (<.>) = Alt f (a -> b) -> Alt f a -> Alt f b
    forall a b. Alt f (a -> b) -> Alt f a -> Alt f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    (<*>)
      {-# INLINE (<.>) #-}

    instance Alt.Alt (Alt f) where
      <!> :: forall a. Alt f a -> Alt f a -> Alt f a
    (<!>) = Alt f a -> Alt f a -> Alt f a
    forall a. Alt f a -> Alt f a -> Alt f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    (<|>)
      {-# INLINE (<!>) #-}

    instance Alternative (Alt f) where
      empty :: forall a. Alt f a
    empty = [AltF f a] -> Alt f a
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt []
      {-# INLINE empty #-}
      Alt [AltF f a]
    as <|> :: forall a. Alt f a -> Alt f a -> Alt f a
    <|> Alt [AltF f a]
    bs = [AltF f a] -> Alt f a
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt ([AltF f a]
    as [AltF f a] -> [AltF f a] -> [AltF f a]
    forall a. [a] -> [a] -> [a]
    ++ [AltF f a]
    bs)
      {-# INLINE (<|>) #-}

    instance Semigroup (Alt f a) where
      <> :: Alt f a -> Alt f a -> Alt f a
    (<>) = Alt f a -> Alt f a -> Alt f a
    forall a. Alt f a -> Alt f a -> Alt f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    (<|>)
      {-# INLINE (<>) #-}

    instance Monoid (Alt f a) where
      mempty :: Alt f a
    mempty = Alt f a
    forall a. Alt f a
    forall (f :: * -> *) a. Alternative f => f a
    empty
      {-# INLINE mempty #-}
      mappend :: Alt f a -> Alt f a -> Alt f a
    mappend = Alt f a -> Alt f a -> Alt f a
    forall a. Semigroup a => a -> a -> a
    (<>)
      {-# INLINE mappend #-}
      mconcat :: [Alt f a] -> Alt f a
    mconcat [Alt f a]
    as = [AltF f a] -> Alt f a
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt ([Alt f a]
    as [Alt f a] -> (Alt f a -> [AltF f a]) -> [AltF f a]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Alt f a -> [AltF f a]
    forall (f :: * -> *) a. Alt f a -> [AltF f a]
    alternatives)
      {-# INLINE mconcat #-}

    hoistAltF :: (forall a. f a -> g a) -> AltF f b -> AltF g b
    hoistAltF :: forall (f :: * -> *) (g :: * -> *) b.
    (forall a. f a -> g a) -> AltF f b -> AltF g b
    hoistAltF forall a. f a -> g a
    _ (Pure b
    a) = b -> AltF g b
    forall a (f :: * -> *). a -> AltF f a
    Pure b
    a
    hoistAltF forall a. f a -> g a
    f (Ap f a
    x Alt f (a -> b)
    y) = g a -> Alt g (a -> b) -> AltF g b
    forall (f :: * -> *) a b. f a -> Alt f (a -> b) -> AltF f b
    Ap (f a -> g a
    forall a. f a -> g a
    f f a
    x) ((forall a. f a -> g a) -> Alt f (a -> b) -> Alt g (a -> b)
    forall (f :: * -> *) (g :: * -> *) b.
    (forall a. f a -> g a) -> Alt f b -> Alt g b
    hoistAlt f a -> g a
    forall a. f a -> g a
    f Alt f (a -> b)
    y)
    {-# INLINE hoistAltF #-}

    -- | Given a natural transformation from @f@ to @g@ this gives a monoidal natural transformation from @Alt f@ to @Alt g@.

    hoistAlt :: (forall a. f a -> g a) -> Alt f b -> Alt g b
    hoistAlt :: forall (f :: * -> *) (g :: * -> *) b.
    (forall a. f a -> g a) -> Alt f b -> Alt g b
    hoistAlt forall a. f a -> g a
    f (Alt [AltF f b]
    as) = [AltF g b] -> Alt g b
    forall (f :: * -> *) a. [AltF f a] -> Alt f a
    Alt ((AltF f b -> AltF g b) -> [AltF f b] -> [AltF g b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((forall a. f a -> g a) -> AltF f b -> AltF g b
    forall (f :: * -> *) (g :: * -> *) b.
    (forall a. f a -> g a) -> AltF f b -> AltF g b
    hoistAltF f a -> g a
    forall a. f a -> g a
    f) [AltF f b]
    as)
    {-# INLINE hoistAlt #-}

    #if __GLASGOW_HASKELL__ < 707
    instance Typeable1 f => Typeable1 (Alt f) where
      typeOf1 t = mkTyConApp altTyCon [typeOf1 (f t)] where
        f :: Alt f a -> f a
        f = undefined

    instance Typeable1 f => Typeable1 (AltF f) where
      typeOf1 t = mkTyConApp altFTyCon [typeOf1 (f t)] where
        f :: AltF f a -> f a
        f = undefined

    altTyCon, altFTyCon :: TyCon
    #if __GLASGOW_HASKELL__ < 704
    altTyCon = mkTyCon "Control.Alternative.Free.Alt"
    altFTyCon = mkTyCon "Control.Alternative.Free.AltF"
    #else
    altTyCon = mkTyCon3 "free" "Control.Alternative.Free" "Alt"
    altFTyCon = mkTyCon3 "free" "Control.Alternative.Free" "AltF"
    #endif
    {-# NOINLINE altTyCon #-}
    {-# NOINLINE altFTyCon #-}
    #endif