{-# LANGUAGE CPP #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Prism -- Copyright : (C) 2012-2014 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Prism ( Market(..) , Market' ) where import Data.Profunctor #ifndef SAFE import Data.Profunctor.Unsafe import Unsafe.Coerce #endif ------------------------------------------------------------------------------ -- Prism: Market ------------------------------------------------------------------------------ -- | This type is used internally by the 'Control.Lens.Prism.Prism' code to -- provide efficient access to the two parts of a 'Prism'. data Market a b s t = Market (b -> t) (s -> Either t a) -- | @type 'Market'' a s t = 'Market' a a s t@ type Market' a = Market a a instance Functor (Market a b s) where fmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta) {-# INLINE fmap #-} instance Profunctor (Market a b) where dimap f g (Market bt seta) = Market (g . bt) (either (Left . g) Right . seta . f) {-# INLINE dimap #-} lmap f (Market bt seta) = Market bt (seta . f) {-# INLINE lmap #-} rmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta) {-# INLINE rmap #-} #ifndef SAFE ( #. ) _ = unsafeCoerce {-# INLINE ( #. ) #-} ( .# ) p _ = unsafeCoerce p {-# INLINE ( .# ) #-} #endif instance Choice (Market a b) where left' (Market bt seta) = Market (Left . bt) $ \sc -> case sc of Left s -> case seta s of Left t -> Left (Left t) Right a -> Right a Right c -> Left (Right c) {-# INLINE left' #-} right' (Market bt seta) = Market (Right . bt) $ \cs -> case cs of Left c -> Left (Left c) Right s -> case seta s of Left t -> Left (Right t) Right a -> Right a {-# INLINE right' #-}