    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE Safe #-}

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

    -- |

    -- Module      :  Control.Alternative.Free.Final

    -- Copyright   :  (C) 2012 Edward Kmett

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

    --

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

    -- Stability   :  provisional

    -- Portability :  GADTs, Rank2Types

    --

    -- Final encoding of free 'Alternative' functors.

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

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

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

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

    -- | The free 'Alternative' for any @f@.

    newtype Alt f a = Alt { forall (f :: * -> *) a.
    Alt f a
    -> forall (g :: * -> *).
       Alternative g =>
       (forall x. f x -> g x) -> g a
    _runAlt :: forall g. Alternative g => (forall x. f x -> g x) -> g a }

    instance Functor (Alt f) where
      fmap :: forall a b. (a -> b) -> Alt f a -> Alt f b
    fmap a -> b
    f (Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    g) = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g b)
    -> Alt f b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    k -> (a -> b) -> g a -> g b
    forall a b. (a -> b) -> g a -> g b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f ((forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    g f x -> g x
    forall x. f x -> g x
    k))

    instance Apply (Alt f) where
      Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g (a -> b)
    f <.> :: forall a b. Alt f (a -> b) -> Alt f a -> Alt f b
    <.> Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g b)
    -> Alt f b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    k -> (forall x. f x -> g x) -> g (a -> b)
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g (a -> b)
    f f x -> g x
    forall x. f x -> g x
    k g (a -> b) -> g a -> 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
    <*> (forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k)

    instance Applicative (Alt f) where
      pure :: forall a. a -> Alt f a
    pure a
    x = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    _ -> a -> g a
    forall a. a -> g a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    x)
      Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g (a -> b)
    f <*> :: forall a b. Alt f (a -> b) -> Alt f a -> Alt f b
    <*> Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g b)
    -> Alt f b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    k -> (forall x. f x -> g x) -> g (a -> b)
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g (a -> b)
    f f x -> g x
    forall x. f x -> g x
    k g (a -> b) -> g a -> 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
    <*> (forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k)

    instance Alt.Alt (Alt f) where
      Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x <!> :: forall a. Alt f a -> Alt f a -> Alt f a
    <!> Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    y = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    k -> (forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k g a -> g a -> g a
    forall a. g a -> g a -> g a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    y f x -> g x
    forall x. f x -> g x
    k)

    instance Alternative (Alt f) where
      empty :: forall a. Alt f a
    empty = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    _ -> g a
    forall a. g a
    forall (f :: * -> *) a. Alternative f => f a
    empty)
      Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x <|> :: forall a. Alt f a -> Alt f a -> Alt f a
    <|> Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    y = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    k -> (forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k g a -> g a -> g a
    forall a. g a -> g a -> g a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    y f x -> g x
    forall x. f x -> g x
    k)
      some :: forall a. Alt f a -> Alt f [a]
    some (Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x) = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g [a])
    -> Alt f [a]
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt ((forall (g :: * -> *).
      Alternative g =>
      (forall x. f x -> g x) -> g [a])
     -> Alt f [a])
    -> (forall (g :: * -> *).
        Alternative g =>
        (forall x. f x -> g x) -> g [a])
    -> Alt f [a]
    forall a b. (a -> b) -> a -> b
    $ \forall x. f x -> g x
    k -> g a -> g [a]
    forall a. g a -> g [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    some ((forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k)
      many :: forall a. Alt f a -> Alt f [a]
    many (Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x) = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g [a])
    -> Alt f [a]
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt ((forall (g :: * -> *).
      Alternative g =>
      (forall x. f x -> g x) -> g [a])
     -> Alt f [a])
    -> (forall (g :: * -> *).
        Alternative g =>
        (forall x. f x -> g x) -> g [a])
    -> Alt f [a]
    forall a b. (a -> b) -> a -> b
    $ \forall x. f x -> g x
    k -> g a -> g [a]
    forall a. g a -> g [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many ((forall x. f x -> g x) -> g a
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g a
    x f x -> g x
    forall x. f x -> g x
    k)

    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
    (<|>)

    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
      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
    (<>)

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

    liftAlt :: f a -> Alt f a
    liftAlt :: forall (f :: * -> *) a. f a -> Alt f a
    liftAlt f a
    f = (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. f x -> g x
    k -> f a -> g a
    forall x. f x -> g x
    k f a
    f)

    -- | 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
    phi Alt f a
    g = Alt f a
    -> forall (g :: * -> *).
       Alternative g =>
       (forall x. f x -> g x) -> g a
    forall (f :: * -> *) a.
    Alt f a
    -> forall (g :: * -> *).
       Alternative g =>
       (forall x. f x -> g x) -> g a
    _runAlt Alt f a
    g f x -> g x
    forall x. f x -> g x
    phi

    -- | 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
    phi (Alt forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g b
    g) = (forall (g :: * -> *).
     Alternative g =>
     (forall x. g x -> g x) -> g b)
    -> Alt g b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Alternative g =>
     (forall x. f x -> g x) -> g a)
    -> Alt f a
    Alt (\forall x. g x -> g x
    k -> (forall x. f x -> g x) -> g b
    forall (g :: * -> *).
    Alternative g =>
    (forall x. f x -> g x) -> g b
    g (g x -> g x
    forall x. g x -> g x
    k (g x -> g x) -> (f x -> g x) -> f x -> g x
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f x -> g x
    forall a. f a -> g a
    phi))