{-# LANGUAGE CPP #-}

{-# LANGUAGE Trustworthy #-}

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

-- |

-- Module      :  Control.Lens.Internal.Setter

-- Copyright   :  (C) 2012-2016 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(..)
  ) where

import Prelude ()

import Control.Applicative.Backwards
import Control.Lens.Internal.Prelude
import Data.Distributive

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

-- 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 p a (f b)
g = p a (f b)
g seq :: forall a b. a -> b -> b
`seq` forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap forall (f :: * -> *) a. Settable f => f a -> a
untainted p a (f b)
g
  {-# INLINE untaintedDot #-}

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

-- | So you can pass our 'Control.Lens.Setter.Setter' into combinators from other lens libraries.

instance Settable Identity where
  untainted :: forall a. Identity a -> a
untainted = forall a. Identity a -> a
runIdentity
  {-# INLINE untainted #-}
  untaintedDot :: forall (p :: * -> * -> *) a b.
Profunctor p =>
p a (Identity b) -> p a b
untaintedDot = (forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#.)
  {-# INLINE untaintedDot #-}
  taintedDot :: forall (p :: * -> * -> *) a b.
Profunctor p =>
p a b -> p a (Identity b)
taintedDot = (forall a. a -> Identity a
Identity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#.)
  {-# INLINE taintedDot #-}

-- | 'Control.Lens.Fold.backwards'

instance Settable f => Settable (Backwards f) where
  untainted :: forall a. Backwards f a -> a
untainted = forall (f :: * -> *) (p :: * -> * -> *) a b.
(Settable f, Profunctor p) =>
p a (f b) -> p a b
untaintedDot forall {k} (f :: k -> *) (a :: k). Backwards f a -> f a
forwards
  {-# INLINE untainted #-}

instance (Settable f, Settable g) => Settable (Compose f g) where
  untainted :: forall a. Compose f g a -> a
untainted = forall (f :: * -> *) (p :: * -> * -> *) a b.
(Settable f, Profunctor p) =>
p a (f b) -> p a b
untaintedDot (forall (f :: * -> *) (p :: * -> * -> *) a b.
(Settable f, Profunctor p) =>
p a (f b) -> p a b
untaintedDot forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
  {-# INLINE untainted #-}