{-# LANGUAGE Rank2Types #-} {-# LANGUAGE KindSignatures #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Evil -- Copyright : (C) 2012 Edward Kmett, Shachaf Ben-Kiki -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional -- Portability : Rank2Types, KindSignatures -- -- This module is not exported from this package. However, the 'EvilBazaar' -- type (and only the type) is re-exported from @Control.Lens.Internal@. -- ---------------------------------------------------------------------------- module Control.Lens.Evil ( EvilBazaar(..) , evilBazaar , evilSell ) where import Control.Applicative -- | 'EvilBazaar' is like 'Control.Lens.Internal.Bazaar', except that it has an evil 'Gettable' instance -- where @'Control.Lens.Internal.coerce' = 'Unsafe.Coerce.unsafeCoerce'@. -- -- This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there *must* be a better way!. -- -- This type isn't exported from the package in a way that allows anyone to -- write 'Unsafe.Coerce.unsafeCoerce' with it. It's only used in the implementation of -- 'Control.Lens.Traversal.taking'. -- -- @g@ is a phantom type used in the 'Control.Lens.Internal.Gettable' instance. newtype EvilBazaar (g :: * -> *) a b s = EvilBazaar (forall f. Applicative f => (a -> f b) -> f s) instance Functor (EvilBazaar g a b) where fmap f (EvilBazaar k) = EvilBazaar (fmap f . k) {-# INLINE fmap #-} instance Applicative (EvilBazaar g a b) where pure a = EvilBazaar (\_ -> pure a) {-# INLINE pure #-} EvilBazaar mf <*> EvilBazaar ma = EvilBazaar (\k -> mf k <*> ma k) {-# INLINE (<*>) #-} -- NB: We can't import .Internal yet, so the 'Gettable' instance is defined there -- instead. evilBazaar :: Applicative f => (a -> f b) -> EvilBazaar g a b s -> f s evilBazaar afb (EvilBazaar m) = m afb {-# INLINE evilBazaar #-} -- | A trivial 'Bazaar'. evilSell :: a -> EvilBazaar f a b b evilSell i = EvilBazaar (\k -> k i) {-# INLINE evilSell #-}