{-# 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 p a (f b) -> p a b -> p a b
forall a b. a -> b -> b
`seq` (f b -> b) -> p a (f b) -> p a b
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap f b -> b
forall a. f a -> a
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 p a b -> p a (f b) -> p a (f b)
forall a b. a -> b -> b
`seq` (b -> f b) -> p a b -> p a (f b)
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap b -> f b
forall a. a -> f a
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 = Identity a -> a
forall a. Identity a -> a
runIdentity
  {-# INLINE untainted #-}
  untaintedDot :: forall (p :: * -> * -> *) a b.
Profunctor p =>
p a (Identity b) -> p a b
untaintedDot = (Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> p a (Identity b) -> p a b
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> p a b -> p a c
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 = (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> p a b -> p a (Identity b)
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> p a b -> p a c
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 = (Backwards f a -> f a) -> Backwards f a -> a
forall (f :: * -> *) (p :: * -> * -> *) a b.
(Settable f, Profunctor p) =>
p a (f b) -> p a b
forall (p :: * -> * -> *) a b. Profunctor p => p a (f b) -> p a b
untaintedDot Backwards f a -> f a
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 = (Compose f g a -> g a) -> Compose f g a -> a
forall (f :: * -> *) (p :: * -> * -> *) a b.
(Settable f, Profunctor p) =>
p a (f b) -> p a b
forall (p :: * -> * -> *) a b. Profunctor p => p a (g b) -> p a b
untaintedDot ((Compose f g a -> f (g a)) -> Compose f g a -> g a
forall (f :: * -> *) (p :: * -> * -> *) a b.
(Settable f, Profunctor p) =>
p a (f b) -> p a b
forall (p :: * -> * -> *) a b. Profunctor p => p a (f b) -> p a b
untaintedDot Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
  {-# INLINE untainted #-}