content: {-# LANGUAGE ScopedTypeVariables #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Control.Lens.Internal.Prism
  -- Copyright   :  (C) 2012-2016 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 Prelude ()
  
  import Control.Lens.Internal.Prelude
  
  ------------------------------------------------------------------------------
  -- 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 #-}
  
    (#.) _ = coerce
    {-# INLINE (#.) #-}
    (.#) p _ = coerce p
    {-# INLINE (.#) #-}
  
  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' #-}
  