Injection3.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wall #-}

-- | The third injection of a sum type, as a prism. The sum-type dual of 'Control.Lens.Field3'.
module Data.Lens.Injection.Injection3 (
  Injection3 (..),
) where

import Control.Lens (Prism, prism)
import Data.Lens.Injection.Generic (GInjection, injection)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic, Rep)

{- $setup
>>> :set -XDeriveGeneric -XMultiParamTypeClasses -XFlexibleInstances
>>> import GHC.Generics(Generic)
>>> import Control.Lens((^?), (#))
-}

{- | Access the third constructor of a sum type.

Where 'Control.Lens._3' is the third projection out of a product, '_I3' is the third
injection into a sum.

The default implementation is the prism to the third constructor of a
'Generic' type, @'injection' (Proxy :: Proxy 2)@.

>>> data T = C1 | C2 | C3 Int | C4 deriving (Show, Generic)
>>> instance Injection3 T T Int Int
>>> C3 1 ^? _I3
Just 1

>>> C4 ^? _I3
Nothing

>>> _I3 # 1 :: T
C3 1
-}
class Injection3 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _I3 :: Prism s t a b
  default _I3 :: (Generic s, Generic t, GInjection 2 (Rep s) (Rep t) a b) => Prism s t a b
  _I3 =
    injection (Proxy :: Proxy 2)
  {-# INLINE _I3 #-}

{- |
>>> GT ^? _I3
Just ()

>>> LT ^? _I3
Nothing

>>> EQ ^? _I3
Nothing

>>> _I3 # () :: Ordering
GT
-}
instance Injection3 Ordering Ordering () () where
  _I3 =
    prism (const GT) $ \case
      GT -> Right ()
      o -> Left o
  {-# INLINE _I3 #-}