{-# LANGUAGE CPP #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Setter -- Copyright : (C) 2012-2014 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 Control.Applicative import Control.Applicative.Backwards import Data.Distributive import Data.Functor.Compose 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 #-}