    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MonoLocalBinds #-}
    #if __GLASGOW_HASKELL__ >= 702
    {-# LANGUAGE Trustworthy #-}
    #endif

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Semigroup.Applicative
    -- Copyright   :  (c) Edward Kmett 2009
    -- License     :  BSD-style
    -- Maintainer  :  ekmett@gmail.com
    -- Stability   :  experimental
    -- Portability :  non-portable (MPTCs)
    --
    -- Semigroups for working with 'Applicative' 'Functor's.
    --
    -----------------------------------------------------------------------------

    module Data.Semigroup.Applicative
        ( Traversal(..)
        , Ap(..)
        ) where

    import Control.Applicative
    #if __GLASGOW_HASKELL__ < 710
    import Data.Monoid (Monoid(..))
    #endif
    import Data.Semigroup (Semigroup(..))
    import Data.Semigroup.Reducer (Reducer(..))

    -- | A 'Traversal' uses an glues together 'Applicative' actions with (*>)
    --   in the manner of 'traverse_' from "Data.Foldable". Any values returned by
    --   reduced actions are discarded.
    newtype Traversal f = Traversal { Traversal f -> f ()
    getTraversal :: f () }

    instance Applicative f => Semigroup (Traversal f) where
      Traversal a :: f ()
    a <> :: Traversal f -> Traversal f -> Traversal f
    <> Traversal b :: f ()
    b = f () -> Traversal f
    forall (f :: * -> *). f () -> Traversal f
    Traversal (f ()
    a f () -> f () -> f ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> f ()
    b)

    instance Applicative f => Monoid (Traversal f) where
      mempty :: Traversal f
    mempty = f () -> Traversal f
    forall (f :: * -> *). f () -> Traversal f
    Traversal (() -> f ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
      Traversal a :: f ()
    a mappend :: Traversal f -> Traversal f -> Traversal f
    `mappend` Traversal b :: f ()
    b = f () -> Traversal f
    forall (f :: * -> *). f () -> Traversal f
    Traversal (f ()
    a f () -> f () -> f ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> f ()
    b)

    instance Applicative f => Reducer (f a) (Traversal f) where
      unit :: f a -> Traversal f
    unit = f () -> Traversal f
    forall (f :: * -> *). f () -> Traversal f
    Traversal (f () -> Traversal f) -> (f a -> f ()) -> f a -> Traversal f
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (() () -> f a -> f ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$)
      a :: f a
    a cons :: f a -> Traversal f -> Traversal f
    `cons` Traversal b :: f ()
    b = f () -> Traversal f
    forall (f :: * -> *). f () -> Traversal f
    Traversal (f a
    a f a -> f () -> f ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> f ()
    b)
      Traversal a :: f ()
    a snoc :: Traversal f -> f a -> Traversal f
    `snoc` b :: f a
    b = f () -> Traversal f
    forall (f :: * -> *). f () -> Traversal f
    Traversal (() () -> f a -> f ()
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ (f ()
    a f () -> f a -> f a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> f a
    b))

    -- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns ()
    --   A rewrite rule automatically applies this when possible
    snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f
    snocTraversal :: Traversal f -> f () -> Traversal f
    snocTraversal a :: Traversal f
    a = Traversal f -> Traversal f -> Traversal f
    forall a. Semigroup a => a -> a -> a
    (<>) Traversal f
    a (Traversal f -> Traversal f)
    -> (f () -> Traversal f) -> f () -> Traversal f
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f () -> Traversal f
    forall (f :: * -> *). f () -> Traversal f
    Traversal
    {-# RULES "unitTraversal" unit = Traversal #-}
    {-# RULES "snocTraversal" snoc = snocTraversal #-}

    newtype Ap f m = Ap { Ap f m -> f m
    getAp :: f m }
      deriving (a -> Ap f b -> Ap f a
    (a -> b) -> Ap f a -> Ap f b
    (forall a b. (a -> b) -> Ap f a -> Ap f b)
    -> (forall a b. a -> Ap f b -> Ap f a) -> Functor (Ap f)
    forall a b. a -> Ap f b -> Ap f a
    forall a b. (a -> b) -> Ap f a -> Ap f b
    forall (f :: * -> *) a b. Functor f => a -> Ap f b -> Ap f a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> Ap f a -> Ap f b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: a -> Ap f b -> Ap f a
    $c<$ :: forall (f :: * -> *) a b. Functor f => a -> Ap f b -> Ap f a
    fmap :: (a -> b) -> Ap f a -> Ap f b
    $cfmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> Ap f a -> Ap f b
    Functor,Functor (Ap f)
    a -> Ap f a
    Functor (Ap f) =>
    (forall a. a -> Ap f a)
    -> (forall a b. Ap f (a -> b) -> Ap f a -> Ap f b)
    -> (forall a b c. (a -> b -> c) -> Ap f a -> Ap f b -> Ap f c)
    -> (forall a b. Ap f a -> Ap f b -> Ap f b)
    -> (forall a b. Ap f a -> Ap f b -> Ap f a)
    -> Applicative (Ap f)
    Ap f a -> Ap f b -> Ap f b
    Ap f a -> Ap f b -> Ap f a
    Ap f (a -> b) -> Ap f a -> Ap f b
    (a -> b -> c) -> Ap f a -> Ap f b -> Ap f c
    forall a. a -> Ap f a
    forall a b. Ap f a -> Ap f b -> Ap f a
    forall a b. Ap f a -> Ap f b -> Ap f b
    forall a b. Ap f (a -> b) -> Ap f a -> Ap f b
    forall a b c. (a -> b -> c) -> Ap f a -> Ap f b -> Ap f c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    forall (f :: * -> *). Applicative f => Functor (Ap f)
    forall (f :: * -> *) a. Applicative f => a -> Ap f a
    forall (f :: * -> *) a b.
    Applicative f =>
    Ap f a -> Ap f b -> Ap f a
    forall (f :: * -> *) a b.
    Applicative f =>
    Ap f a -> Ap f b -> Ap f b
    forall (f :: * -> *) a b.
    Applicative f =>
    Ap f (a -> b) -> Ap f a -> Ap f b
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> Ap f a -> Ap f b -> Ap f c
    <* :: Ap f a -> Ap f b -> Ap f a
    $c<* :: forall (f :: * -> *) a b.
    Applicative f =>
    Ap f a -> Ap f b -> Ap f a
    *> :: Ap f a -> Ap f b -> Ap f b
    $c*> :: forall (f :: * -> *) a b.
    Applicative f =>
    Ap f a -> Ap f b -> Ap f b
    liftA2 :: (a -> b -> c) -> Ap f a -> Ap f b -> Ap f c
    $cliftA2 :: forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> Ap f a -> Ap f b -> Ap f c
    <*> :: Ap f (a -> b) -> Ap f a -> Ap f b
    $c<*> :: forall (f :: * -> *) a b.
    Applicative f =>
    Ap f (a -> b) -> Ap f a -> Ap f b
    pure :: a -> Ap f a
    $cpure :: forall (f :: * -> *) a. Applicative f => a -> Ap f a
    $cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (Ap f)
    Applicative)

    instance (Applicative f, Semigroup m) => Semigroup (Ap f m) where
      <> :: Ap f m -> Ap f m -> Ap f m
    (<>) = (m -> m -> m) -> Ap f m -> Ap f m -> Ap f m
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 m -> m -> m
    forall a. Semigroup a => a -> a -> a
    (<>)

    instance (Applicative f, Monoid m) => Monoid (Ap f m) where
      mempty :: Ap f m
    mempty = m -> Ap f m
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure m
    forall a. Monoid a => a
    mempty
      mappend :: Ap f m -> Ap f m -> Ap f m
    mappend = (m -> m -> m) -> Ap f m -> Ap f m -> Ap f m
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 m -> m -> m
    forall a. Monoid a => a -> a -> a
    mappend

    instance (Applicative f, Reducer c m) => Reducer (f c) (Ap f m) where
      unit :: f c -> Ap f m
    unit = (c -> m) -> Ap f c -> Ap f m
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap c -> m
    forall c m. Reducer c m => c -> m
    unit (Ap f c -> Ap f m) -> (f c -> Ap f c) -> f c -> Ap f m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f c -> Ap f c
    forall (f :: * -> *) m. f m -> Ap f m
    Ap