HasOneItem.hs

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

module Control.One.HasOneItem where

import Control.Applicative (Const (..))
import Control.Lens (Lens', lens, view)
import Control.One.GetterOneItem (GetterOneItem (GetterOneItemElement, getOneItem))
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 (set)

class (GetterOneItem x) => HasOneItem x where
  type HasOneItemElement x

  setOneItem :: x -> HasOneItemElement x -> x

  oneItem :: Lens' x (HasOneItemElement x)
  default oneItem :: (GetterOneItemElement x ~ HasOneItemElement x) => Lens' x (HasOneItemElement x)
  oneItem = lens (view getOneItem) setOneItem

-- | >>> view oneItem (1 :| [2, 3])
-- 1
--
-- >>> set oneItem 9 (1 :| [2, 3])
-- 9 :| [2,3]
instance HasOneItem (NonEmpty a) where
  type HasOneItemElement (NonEmpty a) = a

  setOneItem (_ :| xs) a = a :| xs

-- | >>> view oneItem ("hello", 42 :: Int)
-- 42
--
-- >>> set oneItem 9 ("hello", 42 :: Int)
-- ("hello",9)
instance HasOneItem (x, a) where
  type HasOneItemElement (x, a) = a

  setOneItem (x, _) a = (x, a)

-- | >>> view oneItem (Identity 7)
-- 7
--
-- >>> set oneItem 9 (Identity 7)
-- Identity 9
instance HasOneItem (Identity a) where
  type HasOneItemElement (Identity a) = a

  setOneItem _ = Identity

-- | >>> view oneItem (Const 7 :: Const Int String)
-- 7
--
-- >>> set oneItem 9 (Const 7 :: Const Int String)
-- Const 9
instance HasOneItem (Const a b) where
  type HasOneItemElement (Const a b) = a

  setOneItem _ = Const

-- | >>> view oneItem (First 7)
-- 7
--
-- >>> set oneItem 9 (First 7)
-- First {getFirst = 9}
instance HasOneItem (First a) where
  type HasOneItemElement (First a) = a

  setOneItem _ = First

-- | >>> view oneItem (Last 7)
-- 7
--
-- >>> set oneItem 9 (Last 7)
-- Last {getLast = 9}
instance HasOneItem (Last a) where
  type HasOneItemElement (Last a) = a

  setOneItem _ = Last

-- | >>> view oneItem (WrapMonoid "hello")
-- "hello"
--
-- >>> set oneItem "world" (WrapMonoid "hello")
-- WrapMonoid {unwrapMonoid = "world"}
instance HasOneItem (WrappedMonoid a) where
  type HasOneItemElement (WrappedMonoid a) = a

  setOneItem _ = WrapMonoid

-- | >>> view oneItem (Dual 7)
-- 7
--
-- >>> set oneItem 9 (Dual 7)
-- Dual {getDual = 9}
instance HasOneItem (Dual a) where
  type HasOneItemElement (Dual a) = a

  setOneItem _ = Dual

-- | >>> view oneItem (Down 7)
-- 7
--
-- >>> set oneItem 9 (Down 7)
-- Down 9
instance HasOneItem (Down a) where
  type HasOneItemElement (Down a) = a

  setOneItem _ = Down

-- | >>> view oneItem (Sum 7)
-- 7
--
-- >>> set oneItem 9 (Sum 7)
-- Sum {getSum = 9}
instance HasOneItem (Sum a) where
  type HasOneItemElement (Sum a) = a

  setOneItem _ = Sum

-- | >>> view oneItem (Product 7)
-- 7
--
-- >>> set oneItem 9 (Product 7)
-- Product {getProduct = 9}
instance HasOneItem (Product a) where
  type HasOneItemElement (Product a) = a

  setOneItem _ = Product

-- | >>> view oneItem (Min 7)
-- 7
--
-- >>> set oneItem 9 (Min 7)
-- Min {getMin = 9}
instance HasOneItem (Min a) where
  type HasOneItemElement (Min a) = a

  setOneItem _ = Min

-- | >>> view oneItem (Max 7)
-- 7
--
-- >>> set oneItem 9 (Max 7)
-- Max {getMax = 9}
instance HasOneItem (Max a) where
  type HasOneItemElement (Max a) = a

  setOneItem _ = Max

-- | >>> view oneItem (Par1 7)
-- 7
--
-- >>> set oneItem 9 (Par1 7)
-- Par1 {unPar1 = 9}
instance HasOneItem (Par1 a) where
  type HasOneItemElement (Par1 a) = a

  setOneItem _ = Par1

-- | >>> view oneItem (MkSolo 7)
-- 7
--
-- >>> set oneItem 9 (MkSolo 7)
-- MkSolo 9
instance HasOneItem (Solo a) where
  type HasOneItemElement (Solo a) = a

  setOneItem _ = MkSolo