GetterOneItem.hs

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

module Control.One.GetterOneItem 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 GetterOneItem x where
  type GetterOneItemElement x

  getOneItem :: Getter x (GetterOneItemElement x)

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

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

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

  getOneItem = to snd

-- | >>> view getOneItem (Identity 7)
-- 7
instance GetterOneItem (Identity a) where
  type GetterOneItemElement (Identity a) = a

  getOneItem = _Wrapped

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

  getOneItem = _Wrapped

-- | >>> view getOneItem (First 7)
-- 7
instance GetterOneItem (First a) where
  type GetterOneItemElement (First a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (Last 7)
-- 7
instance GetterOneItem (Last a) where
  type GetterOneItemElement (Last a) = a

  getOneItem = _Wrapped

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

  getOneItem = _Wrapped

-- | >>> view getOneItem (Dual 7)
-- 7
instance GetterOneItem (Dual a) where
  type GetterOneItemElement (Dual a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (Down 7)
-- 7
instance GetterOneItem (Down a) where
  type GetterOneItemElement (Down a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (Sum 7)
-- 7
instance GetterOneItem (Sum a) where
  type GetterOneItemElement (Sum a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (Product 7)
-- 7
instance GetterOneItem (Product a) where
  type GetterOneItemElement (Product a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (Min 7)
-- 7
instance GetterOneItem (Min a) where
  type GetterOneItemElement (Min a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (Max 7)
-- 7
instance GetterOneItem (Max a) where
  type GetterOneItemElement (Max a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (Par1 7)
-- 7
instance GetterOneItem (Par1 a) where
  type GetterOneItemElement (Par1 a) = a

  getOneItem = _Wrapped

-- | >>> view getOneItem (MkSolo 7)
-- 7
instance GetterOneItem (Solo a) where
  type GetterOneItemElement (Solo a) = a

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