#ifdef TRUSTWORTHY
#endif
module Control.Lens.Internal.Setter
(
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.Identity
import Data.Profunctor
import Data.Profunctor.Unsafe
import Data.Traversable
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
taintedDot :: Profunctor p => p a b -> p a (f b)
taintedDot g = g `seq` rmap pure g
instance Settable Identity where
untainted = runIdentity
untaintedDot = (runIdentity #.)
taintedDot = (Identity #.)
instance Settable f => Settable (Backwards f) where
untainted = untaintedDot forwards
instance (Settable f, Settable g) => Settable (Compose f g) where
untainted = untaintedDot (untaintedDot getCompose)
newtype Mutator a = Mutator { runMutator :: a }
instance Functor Mutator where
fmap f (Mutator a) = Mutator (f a)
instance Apply Mutator where
Mutator f <.> Mutator a = Mutator (f a)
instance Applicative Mutator where
pure = Mutator
Mutator f <*> Mutator a = Mutator (f a)
instance Bind Mutator where
Mutator x >>- f = f x
instance Monad Mutator where
return = Mutator
Mutator x >>= f = f x
instance Comonad Mutator where
extract = runMutator
extend f w = Mutator (f w)
duplicate = Mutator
instance ComonadApply Mutator where
(<@>) = (<*>)
instance Distributive Mutator where
distribute = Mutator . fmap runMutator
instance Foldable Mutator where
foldMap f (Mutator a) = f a
instance Traversable Mutator where
traverse f (Mutator a) = Mutator <$> f a
instance Settable Mutator where
untainted = runMutator
untaintedDot = (runMutator #.)
taintedDot = (Mutator #.)