    {-# LANGUAGE CPP #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE GADTs #-}
    #if __GLASGOW_HASKELL__ >= 707
    {-# LANGUAGE DeriveDataTypeable #-}
    #endif
    {-# OPTIONS_GHC -Wall #-}
    -----------------------------------------------------------------------------
    -- |
    -- 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(..)
      , runAlt
      , liftAlt
      , hoistAlt
      ) where

    import Control.Applicative
    import Data.Functor.Apply
    import Data.Semigroup

    #ifdef GHC_TYPEABLE
    import Data.Typeable
    #endif

    -- | The free 'Alternative' for a 'Functor' @f@.
    data Alt f a where
      Pure :: a -> Alt f a
      Ap   :: f a -> Alt f (a -> b) -> Alt f b
      Alt  :: [Alt f a] -> Alt f a
    #if __GLASGOW_HASKELL__ >= 707
      deriving (Typeable)
    #endif

    -- | Given a natural transformation from @f@ to @g@, this gives a canonical monoidal natural transformation from @'Alt' f@ to @g@.
    runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
    runAlt _ (Pure x) = pure x
    runAlt u (Ap f x) = flip id <$> u f <*> runAlt u x
    runAlt u (Alt as) = foldr (\a r -> runAlt u a <|> r) empty as

    instance Functor (Alt f) where
      fmap f (Pure a)   = Pure (f a)
      fmap f (Ap x y)   = Ap x ((f .) <$> y)
      fmap f (Alt as)   = Alt (fmap f <$> as)

    instance Apply (Alt f) where
      Pure f <.> y = fmap f y
      Ap x y <.> z = Ap x (flip <$> y <.> z)
      Alt as <.> z = Alt (map (<.> z) as) -- This assumes 'left distribution'

    instance Applicative (Alt f) where
      pure = Pure
      Pure f <*> y = fmap f y
      Ap x y <*> z = Ap x (flip <$> y <*> z)
      Alt as <*> z = Alt (map (<*> z) as) -- This assumes 'left distribution'

    instance Alternative (Alt f) where
      empty = Alt []
      {-# INLINE empty #-}
      Alt [] <|> r      = r
      l      <|> Alt [] = l
      Alt as <|> Alt bs = Alt (as ++ bs)
      l      <|> r      = Alt [l, r]
      {-# INLINE (<|>) #-}

    instance Semigroup (Alt f a) where
      (<>) = (<|>)
      {-# INLINE (<>) #-}

    instance Monoid (Alt f a) where
      mempty = empty
      {-# INLINE mempty #-}
      mappend = (<|>)
      {-# INLINE mappend #-}
      mconcat as = fromList (as >>= toList)
        where
          toList (Alt xs) = xs
          toList x       = [x]
          fromList [x] = x
          fromList xs  = Alt xs
      {-# INLINE mconcat #-}

    -- | A version of 'lift' that can be used with just a 'Functor' for @f@.
    liftAlt :: f a -> Alt f a
    liftAlt x = Ap x (Pure id)
    {-# INLINE liftAlt #-}

    -- | 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 _ (Pure a) = Pure a
    hoistAlt f (Ap x y) = Ap (f x) (hoistAlt f y)
    hoistAlt f (Alt as) = Alt (map (hoistAlt f) as)

    #if defined(GHC_TYPEABLE) && __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

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

    #endif