content: {-# OPTIONS_HADDOCK hide #-}
  {-# LANGUAGE PackageImports #-}
  {-# LANGUAGE GADTs                     #-}
  {-# LANGUAGE NoMonomorphismRestriction #-}
  {-# LANGUAGE Rank2Types                #-}
  {-# LANGUAGE ScopedTypeVariables       #-}
  {-# LANGUAGE TypeFamilies              #-}
  {-# LANGUAGE TypeFamilyDependencies    #-}
  {-# LANGUAGE TypeOperators             #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Data.Generics.Internal.VL.Prism
  -- Copyright   :  (C) 2020 Csongor Kiss
  -- License     :  BSD3
  -- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
  -- Stability   :  experimental
  -- Portability :  non-portable
  --
  -- Internal lens helpers. Only exported for Haddock
  --
  -----------------------------------------------------------------------------
  module Data.Generics.Internal.VL.Prism where
  
  import qualified "generic-lens-core" Data.Generics.Internal.Profunctor.Prism as P
  
  import qualified Data.Profunctor as P
  import Data.Functor.Identity (Identity (..))
  import Data.Coerce (coerce)
  
  -- | Type alias for prism
  type Prism s t a b
    = forall p f. (P.Choice p, Applicative f) => p a (f b) -> p s (f t)
  
  type Prism' s a
    = Prism s s a a
  
  match :: Prism s t a b -> s -> Either t a
  match p = case p (Market Identity Right) of
    Market _ seta -> coerce seta
  {-# INLINE match #-}
  
  build :: Prism s t a b -> b -> t
  build p = case p (Market Identity Right) of
    Market bt _ -> coerce bt
  {-# INLINE build #-}
  
  prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
  prism bt seta eta = P.dimap (\x -> P.left' pure (seta x)) (either id (\x -> fmap bt x)) (P.right' eta)
  {-# INLINE prism #-}
  
  prism2prismvl :: P.APrism i s t a b -> Prism s t a b
  prism2prismvl  _prism = P.withPrism _prism $ \ bt sta -> prism bt sta
  {-# INLINE prism2prismvl #-}
  
  --------------------------------------------------------------------------------
  -- Market
  
  data Market a b s t = Market (b -> t) (s -> Either t a)
  
  instance Functor (Market a b s) where
    fmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta)
    {-# INLINE fmap #-}
  
  instance P.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 #-}
  
  instance P.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' #-}
  