Optics.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

module Control.Exitcode.Optics
  ( GetExitcode (..),
    HasExitcode (..),
    ReviewExitcode (..),
    AsExitcode (..),
    GetExitcodeBifunctor (..),
    HasExitcodeBifunctor (..),
    ReviewExitcodeBifunctor (..),
    AsExitcodeBifunctor (..),
  )
where

import Control.Category (id, (.))
import Control.Exitcode.Exitcode (Exitcode, ExitcodeBifunctor (ExitcodeBifunctor))
import Control.Lens (Getter, Lens', Prism', Review, lens, prism', unto)
import Data.Maybe (Maybe (Just))

-- $setup
-- >>> import Prelude
-- >>> import Control.Lens
-- >>> import Control.Exitcode

-- * Exitcode optics

-- | Type class for values that can be viewed as an @Exitcode@.
--
-- >>> view getExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Exitcode' () String
-- Exitcode (Identity (Right "abc"))
class GetExitcode s e f a | s -> e f a where
  getExitcode :: Getter s (Exitcode e f a)

-- |
--
-- >>> view getExitcode (mkExitSuccess' "abc" :: Exitcode' () String)
-- Exitcode (Identity (Right "abc"))
instance GetExitcode (Exitcode e f a) e f a where
  getExitcode = id
  {-# INLINE getExitcode #-}

-- |
--
-- >>> view getExitcode (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- Exitcode (Identity (Right "abc"))
instance GetExitcode (ExitcodeBifunctor f e a) e f a where
  getExitcode = lens (\(ExitcodeBifunctor x) -> x) (\_ -> ExitcodeBifunctor)
  {-# INLINE getExitcode #-}

-- | Type class for values with a lens into an @Exitcode@.
--
-- >>> view exitcode (mkExitSuccess' "abc" :: Exitcode' () String)
-- Exitcode (Identity (Right "abc"))
class (GetExitcode s e f a) => HasExitcode s e f a | s -> e f a where
  exitcode :: Lens' s (Exitcode e f a)

-- |
--
-- >>> view exitcode (mkExitSuccess' "abc" :: Exitcode' () String)
-- Exitcode (Identity (Right "abc"))
instance HasExitcode (Exitcode e f a) e f a where
  exitcode = id
  {-# INLINE exitcode #-}

-- |
--
-- >>> view exitcode (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- Exitcode (Identity (Right "abc"))
-- >>> set exitcode (mkExitFailure1' ()) (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- ExitcodeBifunctor (Exitcode (Identity (Left ((),NotZero True (Positive 1)))))
instance HasExitcode (ExitcodeBifunctor f e a) e f a where
  exitcode = lens (\(ExitcodeBifunctor x) -> x) (\_ x -> ExitcodeBifunctor x)
  {-# INLINE exitcode #-}

-- | Type class for values that can be constructed from an @Exitcode@.
--
-- >>> review reviewExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Exitcode' () String
-- Exitcode (Identity (Right "abc"))
class ReviewExitcode t e f a | t -> e f a where
  reviewExitcode :: Review t (Exitcode e f a)

-- |
--
-- >>> review reviewExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Exitcode' () String
-- Exitcode (Identity (Right "abc"))
instance ReviewExitcode (Exitcode e f a) e f a where
  reviewExitcode = unto id
  {-# INLINE reviewExitcode #-}

-- |
--
-- >>> review reviewExitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: ExitcodeBifunctor' () String
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
instance ReviewExitcode (ExitcodeBifunctor f e a) e f a where
  reviewExitcode = unto ExitcodeBifunctor
  {-# INLINE reviewExitcode #-}

-- | Type class for values with a prism into an @Exitcode@.
--
-- >>> preview _Exitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Maybe (Exitcode' () String)
-- Just (Exitcode (Identity (Right "abc")))
class (ReviewExitcode t e f a) => AsExitcode t e f a | t -> e f a where
  _Exitcode :: Prism' t (Exitcode e f a)

-- |
--
-- >>> preview _Exitcode (mkExitSuccess' "abc" :: Exitcode' () String) :: Maybe (Exitcode' () String)
-- Just (Exitcode (Identity (Right "abc")))
instance AsExitcode (Exitcode e f a) e f a where
  _Exitcode = id
  {-# INLINE _Exitcode #-}

-- |
--
-- >>> preview _Exitcode (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: Maybe (Exitcode' () String)
-- Just (Exitcode (Identity (Right "abc")))
instance AsExitcode (ExitcodeBifunctor f e a) e f a where
  _Exitcode = prism' ExitcodeBifunctor (\(ExitcodeBifunctor x) -> Just x)
  {-# INLINE _Exitcode #-}

-- * ExitcodeBifunctor optics

-- | Type class for values that can be viewed as an @ExitcodeBifunctor@.
--
-- >>> view getExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
class GetExitcodeBifunctor s f e a | s -> f e a where
  getExitcodeBifunctor :: Getter s (ExitcodeBifunctor f e a)

-- |
--
-- >>> view getExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
instance GetExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where
  getExitcodeBifunctor = id
  {-# INLINE getExitcodeBifunctor #-}

-- |
--
-- >>> view getExitcodeBifunctor (mkExitSuccess' "abc" :: Exitcode' () String)
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
instance GetExitcodeBifunctor (Exitcode e f a) f e a where
  getExitcodeBifunctor = lens ExitcodeBifunctor (\_ (ExitcodeBifunctor x) -> x)
  {-# INLINE getExitcodeBifunctor #-}

-- | Type class for values with a lens into an @ExitcodeBifunctor@.
--
-- >>> view exitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
class (GetExitcodeBifunctor s f e a) => HasExitcodeBifunctor s f e a | s -> f e a where
  exitcodeBifunctor :: Lens' s (ExitcodeBifunctor f e a)

-- |
--
-- >>> view exitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
instance HasExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where
  exitcodeBifunctor = id
  {-# INLINE exitcodeBifunctor #-}

-- |
--
-- >>> view exitcodeBifunctor (mkExitSuccess' "abc" :: Exitcode' () String)
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
-- >>> set exitcodeBifunctor (ExitcodeBifunctor (mkExitFailure1' ())) (mkExitSuccess' "abc" :: Exitcode' () String)
-- Exitcode (Identity (Left ((),NotZero True (Positive 1))))
instance HasExitcodeBifunctor (Exitcode e f a) f e a where
  exitcodeBifunctor = lens ExitcodeBifunctor (\_ (ExitcodeBifunctor x) -> x)
  {-# INLINE exitcodeBifunctor #-}

-- | Type class for values that can be constructed from an @ExitcodeBifunctor@.
--
-- >>> review reviewExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: ExitcodeBifunctor' () String
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
class ReviewExitcodeBifunctor t f e a | t -> f e a where
  reviewExitcodeBifunctor :: Review t (ExitcodeBifunctor f e a)

-- |
--
-- >>> review reviewExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: ExitcodeBifunctor' () String
-- ExitcodeBifunctor (Exitcode (Identity (Right "abc")))
instance ReviewExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where
  reviewExitcodeBifunctor = unto id
  {-# INLINE reviewExitcodeBifunctor #-}

-- |
--
-- >>> review reviewExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String) :: Exitcode' () String
-- Exitcode (Identity (Right "abc"))
instance ReviewExitcodeBifunctor (Exitcode e f a) f e a where
  reviewExitcodeBifunctor = unto (\(ExitcodeBifunctor x) -> x)
  {-# INLINE reviewExitcodeBifunctor #-}

-- | Type class for values with a prism into an @ExitcodeBifunctor@.
--
-- >>> preview _ExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- Just (ExitcodeBifunctor (Exitcode (Identity (Right "abc"))))
class (ReviewExitcodeBifunctor t f e a) => AsExitcodeBifunctor t f e a | t -> f e a where
  _ExitcodeBifunctor :: Prism' t (ExitcodeBifunctor f e a)

-- |
--
-- >>> preview _ExitcodeBifunctor (ExitcodeBifunctor (mkExitSuccess' "abc") :: ExitcodeBifunctor' () String)
-- Just (ExitcodeBifunctor (Exitcode (Identity (Right "abc"))))
instance AsExitcodeBifunctor (ExitcodeBifunctor f e a) f e a where
  _ExitcodeBifunctor = id
  {-# INLINE _ExitcodeBifunctor #-}

-- |
--
-- >>> preview _ExitcodeBifunctor (mkExitSuccess' "abc" :: Exitcode' () String)
-- Just (ExitcodeBifunctor (Exitcode (Identity (Right "abc"))))
instance AsExitcodeBifunctor (Exitcode e f a) f e a where
  _ExitcodeBifunctor = prism' (\(ExitcodeBifunctor x) -> x) (Just . ExitcodeBifunctor)
  {-# INLINE _ExitcodeBifunctor #-}