    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE Safe #-}
    #include "free-common.h"

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

    -- |

    -- Module      :  Control.Applicative.Free.Final

    -- Copyright   :  (C) 2012-2013 Edward Kmett

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

    --

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

    -- Stability   :  provisional

    -- Portability :  GADTs, Rank2Types

    --

    -- Final encoding of free 'Applicative' functors.

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

    module Control.Applicative.Free.Final
      (
      -- | Compared to the free monad, they are less expressive. However, they are also more

      -- flexible to inspect and interpret, as the number of ways in which

      -- the values can be nested is more limited.

        Ap(..)
      , runAp
      , runAp_
      , liftAp
      , hoistAp
      , retractAp

      -- * Examples

      -- $examples

      ) where

    import Control.Applicative
    import Data.Functor.Apply

    #if !(MIN_VERSION_base(4,8,0))
    import Data.Monoid
    #endif

    -- | The free 'Applicative' for a 'Functor' @f@.

    newtype Ap f a = Ap { forall (f :: * -> *) a.
    Ap f a
    -> forall (g :: * -> *).
       Applicative g =>
       (forall x. f x -> g x) -> g a
    _runAp :: forall g. Applicative g => (forall x. f x -> g x) -> g a }

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

    --

    -- prop> runAp t == retractApp . hoistApp t

    runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a
    runAp :: forall (g :: * -> *) (f :: * -> *) a.
    Applicative g =>
    (forall x. f x -> g x) -> Ap f a -> g a
    runAp forall x. f x -> g x
    phi Ap f a
    m = Ap f a
    -> forall (g :: * -> *).
       Applicative g =>
       (forall x. f x -> g x) -> g a
    forall (f :: * -> *) a.
    Ap f a
    -> forall (g :: * -> *).
       Applicative g =>
       (forall x. f x -> g x) -> g a
    _runAp Ap f a
    m f x -> g x
    forall x. f x -> g x
    phi

    -- | Perform a monoidal analysis over free applicative value.

    --

    -- Example:

    --

    -- @

    -- count :: Ap f a -> Int

    -- count = getSum . runAp_ (\\_ -> Sum 1)

    -- @

    runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m
    runAp_ :: forall m (f :: * -> *) b.
    Monoid m =>
    (forall a. f a -> m) -> Ap f b -> m
    runAp_ forall a. f a -> m
    f = Const m b -> m
    forall {k} a (b :: k). Const a b -> a
    getConst (Const m b -> m) -> (Ap f b -> Const m b) -> Ap f b -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall x. f x -> Const m x) -> Ap f b -> Const m b
    forall (g :: * -> *) (f :: * -> *) a.
    Applicative g =>
    (forall x. f x -> g x) -> Ap f a -> g a
    runAp (m -> Const m x
    forall {k} a (b :: k). a -> Const a b
    Const (m -> Const m x) -> (f x -> m) -> f x -> Const m x
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f x -> m
    forall a. f a -> m
    f)

    instance Functor (Ap f) where
      fmap :: forall a b. (a -> b) -> Ap f a -> Ap f b
    fmap a -> b
    f (Ap forall (g :: * -> *).
    Applicative g =>
    (forall x. f x -> g x) -> g a
    g) = (forall (g :: * -> *).
     Applicative g =>
     (forall x. f x -> g x) -> g b)
    -> Ap f b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Applicative g =>
     (forall x. f x -> g x) -> g a)
    -> Ap f a
    Ap (\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 :: * -> *).
    Applicative g =>
    (forall x. f x -> g x) -> g a
    g f x -> g x
    forall x. f x -> g x
    k))

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

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

    -- | A version of 'lift' that can be used with just a 'Functor' for @f@.

    liftAp :: f a -> Ap f a
    liftAp :: forall (f :: * -> *) a. f a -> Ap f a
    liftAp f a
    x = (forall (g :: * -> *).
     Applicative g =>
     (forall x. f x -> g x) -> g a)
    -> Ap f a
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Applicative g =>
     (forall x. f x -> g x) -> g a)
    -> Ap f a
    Ap (\forall x. f x -> g x
    k -> f a -> g a
    forall x. f x -> g x
    k f a
    x)

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

    hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b
    hoistAp :: forall (f :: * -> *) (g :: * -> *) b.
    (forall a. f a -> g a) -> Ap f b -> Ap g b
    hoistAp forall a. f a -> g a
    f (Ap forall (g :: * -> *).
    Applicative g =>
    (forall x. f x -> g x) -> g b
    g) = (forall (g :: * -> *).
     Applicative g =>
     (forall x. g x -> g x) -> g b)
    -> Ap g b
    forall (f :: * -> *) a.
    (forall (g :: * -> *).
     Applicative g =>
     (forall x. f x -> g x) -> g a)
    -> Ap f a
    Ap (\forall x. g x -> g x
    k -> (forall x. f x -> g x) -> g b
    forall (g :: * -> *).
    Applicative 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
    f))

    -- | Interprets the free applicative functor over f using the semantics for

    --   `pure` and `<*>` given by the Applicative instance for f.

    --

    --   prop> retractApp == runAp id

    retractAp :: Applicative f => Ap f a -> f a
    retractAp :: forall (f :: * -> *) a. Applicative f => Ap f a -> f a
    retractAp (Ap forall (g :: * -> *).
    Applicative g =>
    (forall x. f x -> g x) -> g a
    g) = (forall x. f x -> f x) -> f a
    forall (g :: * -> *).
    Applicative g =>
    (forall x. f x -> g x) -> g a
    g f x -> f x
    forall a. a -> a
    forall x. f x -> f x
    id

    {- $examples

    <examples/ValidationForm.hs Validation form>

    -}