GetterOne.hs

{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall -Werror #-}

module Control.One.GetterOne where

import Control.Applicative (Const (..))
import Control.Lens (Getter, to, _Wrapped)
import Data.Functor.Identity (Identity (..))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Ord (Down (..))
import Data.Semigroup (Dual (..), First (..), Last (..), Max (..), Min (..), Product (..), Sum (..), WrappedMonoid (..))
import Data.Tuple (Solo (..))
import GHC.Generics (Par1 (..))

-- $setup
-- >>> import Control.Lens (view)

class GetterOne x where
  type GetterOneItem x

  getOne :: Getter x (GetterOneItem x)

-- | >>> view getOne (1 :| [2, 3])
-- 1
instance GetterOne (NonEmpty a) where
  type GetterOneItem (NonEmpty a) = a

  getOne = to (\(a :| _) -> a)

-- | >>> view getOne ("hello", 42 :: Int)
-- 42
instance GetterOne (x, a) where
  type GetterOneItem (x, a) = a

  getOne = to snd

-- | >>> view getOne (Identity 7)
-- 7
instance GetterOne (Identity a) where
  type GetterOneItem (Identity a) = a

  getOne = _Wrapped

-- | >>> view getOne (Const 7 :: Const Int String)
-- 7
instance GetterOne (Const a b) where
  type GetterOneItem (Const a b) = a

  getOne = _Wrapped

-- | >>> view getOne (First 7)
-- 7
instance GetterOne (First a) where
  type GetterOneItem (First a) = a

  getOne = _Wrapped

-- | >>> view getOne (Last 7)
-- 7
instance GetterOne (Last a) where
  type GetterOneItem (Last a) = a

  getOne = _Wrapped

-- | >>> view getOne (WrapMonoid "hello")
-- "hello"
instance GetterOne (WrappedMonoid a) where
  type GetterOneItem (WrappedMonoid a) = a

  getOne = _Wrapped

-- | >>> view getOne (Dual 7)
-- 7
instance GetterOne (Dual a) where
  type GetterOneItem (Dual a) = a

  getOne = _Wrapped

-- | >>> view getOne (Down 7)
-- 7
instance GetterOne (Down a) where
  type GetterOneItem (Down a) = a

  getOne = _Wrapped

-- | >>> view getOne (Sum 7)
-- 7
instance GetterOne (Sum a) where
  type GetterOneItem (Sum a) = a

  getOne = _Wrapped

-- | >>> view getOne (Product 7)
-- 7
instance GetterOne (Product a) where
  type GetterOneItem (Product a) = a

  getOne = _Wrapped

-- | >>> view getOne (Min 7)
-- 7
instance GetterOne (Min a) where
  type GetterOneItem (Min a) = a

  getOne = _Wrapped

-- | >>> view getOne (Max 7)
-- 7
instance GetterOne (Max a) where
  type GetterOneItem (Max a) = a

  getOne = _Wrapped

-- | >>> view getOne (Par1 7)
-- 7
instance GetterOne (Par1 a) where
  type GetterOneItem (Par1 a) = a

  getOne = _Wrapped

-- | >>> view getOne (MkSolo 7)
-- 7
instance GetterOne (Solo a) where
  type GetterOneItem (Solo a) = a

  getOne = to (\(MkSolo a) -> a)