    {-# LANGUAGE CPP #-}
    #ifdef TRUSTWORTHY
    {-# LANGUAGE Trustworthy #-}
    #endif
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.Internal.Setter
    -- Copyright   :  (C) 2012-2013 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  provisional
    -- Portability :  non-portable
    --
    ----------------------------------------------------------------------------
    module Control.Lens.Internal.Setter
      (
      -- ** Setters
        Settable(..)
      , Mutator(..)
      ) where

    import Control.Applicative
    import Control.Applicative.Backwards
    import Control.Comonad
    import Data.Distributive
    import Data.Foldable
    import Data.Functor.Bind
    import Data.Functor.Compose
    import Data.Functor.Extend
    import Data.Functor.Identity
    import Data.Profunctor
    import Data.Profunctor.Unsafe
    import Data.Traversable

    -----------------------------------------------------------------------------
    -- Settable
    -----------------------------------------------------------------------------

    -- | Anything 'Settable' must be isomorphic to the 'Identity' 'Functor'.
    class (Applicative f, Distributive f, Traversable f) => Settable f where
      untainted :: f a -> a

      untaintedDot :: Profunctor p => p a (f b) -> p a b
      untaintedDot g = g `seq` rmap untainted g
      {-# INLINE untaintedDot #-}

      taintedDot :: Profunctor p => p a b -> p a (f b)
      taintedDot g = g `seq` rmap pure g
      {-# INLINE taintedDot #-}

    -- | So you can pass our 'Control.Lens.Setter.Setter' into combinators from other lens libraries.
    instance Settable Identity where
      untainted = runIdentity
      {-# INLINE untainted #-}
      untaintedDot = (runIdentity #.)
      {-# INLINE untaintedDot #-}
      taintedDot = (Identity #.)
      {-# INLINE taintedDot #-}

    -- | 'Control.Lens.Fold.backwards'
    instance Settable f => Settable (Backwards f) where
      untainted = untaintedDot forwards
      {-# INLINE untainted #-}

    instance (Settable f, Settable g) => Settable (Compose f g) where
      untainted = untaintedDot (untaintedDot getCompose)
      {-# INLINE untainted #-}

    -----------------------------------------------------------------------------
    -- Mutator
    -----------------------------------------------------------------------------

    -- | 'Mutator' is just a renamed 'Identity' 'Functor' to give better error
    -- messages when someone attempts to use a 'Control.Lens.Getter.Getter' as a 'Control.Lens.Setter.Setter'.
    --
    -- Most user code will never need to see this type.
    newtype Mutator a = Mutator { runMutator :: a }

    instance Functor Mutator where
      fmap f (Mutator a) = Mutator (f a)
      {-# INLINE fmap #-}

    instance Apply Mutator where
      Mutator f <.> Mutator a = Mutator (f a)
      {-# INLINE (<.>) #-}

    instance Applicative Mutator where
      pure = Mutator
      {-# INLINE pure #-}
      Mutator f <*> Mutator a = Mutator (f a)
      {-# INLINE (<*>) #-}

    instance Bind Mutator where
      Mutator x >>- f = f x
      {-# INLINE (>>-) #-}
      join = runMutator
      {-# INLINE join #-}

    instance Monad Mutator where
      return = Mutator
      {-# INLINE return #-}
      Mutator x >>= f = f x
      {-# INLINE (>>=) #-}

    instance Extend Mutator where
      extended f w = Mutator (f w)
      {-# INLINE extended #-}
      duplicated = Mutator
      {-# INLINE duplicated #-}

    instance Comonad Mutator where
      extract = runMutator
      {-# INLINE extract #-}
      extend f w = Mutator (f w)
      {-# INLINE extend #-}
      duplicate = Mutator
      {-# INLINE duplicate #-}

    instance ComonadApply Mutator where
      Mutator f <@> Mutator a = Mutator (f a)
      {-# INLINE (<@>) #-}

    instance Distributive Mutator where
      distribute = Mutator . fmap runMutator
      {-# INLINE distribute #-}

    instance Foldable Mutator where
      foldMap f (Mutator a) = f a
      {-# INLINE foldMap #-}

    instance Traversable Mutator where
      traverse f (Mutator a) = Mutator <$> f a
      {-# INLINE traverse #-}

    instance Settable Mutator where
      untainted = runMutator
      {-# INLINE untainted #-}
      untaintedDot = (runMutator #.)
      {-# INLINE untaintedDot #-}
      taintedDot = (Mutator #.)
      {-# INLINE taintedDot #-}