one-0.0.2: src/Control/One/One.hs
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall -Werror #-}
module Control.One.One
( -- * One data type
One (..),
One',
one',
rest',
-- * Type classes
-- ** GetterOne
GetterOne (..),
-- ** HasOne
HasOne (..),
-- ** ReviewOne
ReviewOne (..),
-- ** AsOne
AsOne (..),
-- * Optics
-- ** Identity
identity,
-- ** NonEmpty
nonEmpty,
-- ** List
list,
-- ** Text
text,
lazyText,
shortText,
-- ** Newtypes
first',
last',
dual,
down,
sum',
product',
min',
max',
wrappedMonoid,
par1,
solo,
const',
-- ** Tuple
tuple,
)
where
import Control.Applicative (Const (..))
import Control.Lens (Getter, Iso, Lens, Lens', Prism', Review, iso, lens, prism', review, to, unto, view)
import Control.One.AsOneItem (AsOneItem (AsOneItemElement, matchOneItem))
import Control.One.GetterOneItem (GetterOneItem (GetterOneItemElement, getOneItem))
import Control.One.HasOneItem (HasOneItem (HasOneItemElement, setOneItem))
import Control.One.ReviewOneItem (ReviewOneItem (ReviewOneItemElement, reviewOneItem))
import Data.Biapplicative (Biapplicative (..))
import Data.Bifoldable (Bifoldable (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Bifunctor.Apply (Biapply (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Functor.Apply (Apply (..))
import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Show1 (..), Show2 (..), showsBinaryWith)
import Data.Functor.Identity (Identity (Identity))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Ord (Down (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (Dual (..), First (..), Last (..), Max (..), Min (..), Product (..), Sum (..), WrappedMonoid (..))
import Data.Semigroup.Bifoldable (Bifoldable1 (..))
import Data.Semigroup.Bitraversable (Bitraversable1 (..))
import Data.Semigroup.Foldable (Foldable1 (..))
import Data.Semigroup.Traversable (Traversable1 (..))
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Short as ShortText
import Data.Tuple (Solo (..))
import GHC.Generics (Generic, Par1 (..))
-- $setup
-- >>> import Control.Lens (preview, review, set, view)
-- >>> import Control.One.HasOneItem (oneItem)
-- >>> import Control.One.AsOneItem (_OneItem)
-- >>> import Data.Bifunctor (bimap)
-- >>> import Data.Biapplicative (bipure, (<<*>>))
-- >>> import Data.Bifunctor.Apply ((<<.>>))
-- >>> import Data.Bifoldable (bifoldMap)
-- >>> import Data.Bitraversable (bitraverse)
-- >>> import Data.Semigroup.Bifoldable (bifoldMap1)
-- >>> import Data.Semigroup.Bitraversable (bitraverse1)
-- >>> import Data.Semigroup.Foldable (foldMap1)
-- >>> import Data.Semigroup.Traversable (traverse1)
-- >>> import Data.Functor.Classes (liftEq, liftCompare, liftShowsPrec, liftEq2, liftCompare2, liftShowsPrec2)
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> import Data.List.NonEmpty (NonEmpty(..))
-- >>> import qualified Data.Text as Text
-- >>> import qualified Data.Text.Lazy as LazyText
-- >>> import qualified Data.Text.Short as ShortText
data One f a t = One a (f t)
deriving (Eq, Ord, Show, Generic, Functor, Foldable, Traversable)
-- | >>> :t (One 7 [8, 9] :: One' [] Int)
-- (One 7 [8, 9] :: One' [] Int) :: One' [] Int
type One' f x = One f x x
-- | >>> view one' (One 7 [8, 9])
-- 7
--
-- >>> set one' 99 (One 7 [8, 9])
-- One 99 [8,9]
one' :: Lens (One f a t) (One f a' t) a a'
one' f (One a t) =
(`One` t) <$> f a
-- | >>> view rest' (One 7 [8, 9])
-- [8,9]
--
-- >>> set rest' [10, 11] (One 7 [8, 9])
-- One 7 [10,11]
rest' :: Lens (One f a t) (One f' a t') (f t) (f' t')
rest' f (One a t) =
One a <$> f t
-- | >>> liftEq (==) (One 1 [2, 3]) (One 1 [2, 3])
-- True
--
-- >>> liftEq (==) (One 1 [2]) (One 1 [3])
-- False
instance (Eq1 f, Eq a) => Eq1 (One f a) where
liftEq eq (One a1 fa1) (One a2 fa2) = a1 == a2 && liftEq eq fa1 fa2
-- | >>> liftEq2 (==) (==) (One 1 [2]) (One 1 [2])
-- True
--
-- >>> liftEq2 (==) (==) (One 1 [2]) (One 9 [2])
-- False
instance (Eq1 f) => Eq2 (One f) where
liftEq2 eqa eqa' (One a1 fa1) (One a2 fa2) = eqa a1 a2 && liftEq eqa' fa1 fa2
-- | >>> liftCompare compare (One 1 [2]) (One 1 [3])
-- LT
--
-- >>> liftCompare compare (One 1 [2]) (One 1 [2])
-- EQ
instance (Ord1 f, Ord a) => Ord1 (One f a) where
liftCompare cmp (One a1 fa1) (One a2 fa2) = compare a1 a2 <> liftCompare cmp fa1 fa2
-- | >>> liftCompare2 compare compare (One 1 [2]) (One 1 [3])
-- LT
instance (Ord1 f) => Ord2 (One f) where
liftCompare2 cmpa cmpa' (One a1 fa1) (One a2 fa2) = cmpa a1 a2 <> liftCompare cmpa' fa1 fa2
-- | >>> liftShowsPrec showsPrec showList 0 (One 1 [2, 3]) ""
-- "One 1 [2,3]"
instance (Show1 f, Show a) => Show1 (One f a) where
liftShowsPrec sp sl d (One a fa) =
showsBinaryWith showsPrec (liftShowsPrec sp sl) "One" d a fa
-- | >>> liftShowsPrec2 showsPrec showList showsPrec showList 0 (One 1 [2, 3]) ""
-- "One 1 [2,3]"
instance (Show1 f) => Show2 (One f) where
liftShowsPrec2 spa _ spb slb d (One a fa) =
showsBinaryWith spa (liftShowsPrec spb slb) "One" d a fa
-- | >>> bimap (+1) (*2) (One 3 [4, 5])
-- One 4 [8,10]
instance (Functor f) => Bifunctor (One f) where
bimap g h (One a ft) = One (g a) (fmap h ft)
-- | >>> One (+1) [(*2), (*3)] <<.>> One 10 [4, 5]
-- One 11 [8,10,12,15]
instance (Apply f) => Biapply (One f) where
One g ft <<.>> One a fu = One (g a) (ft <.> fu)
-- | >>> bipure 'a' True :: One [] Char Bool
-- One 'a' [True]
--
-- >>> One (+1) [(*2)] <<*>> One 10 [4, 5]
-- One 11 [8,10]
instance (Applicative f) => Biapplicative (One f) where
bipure a t = One a (pure t)
One g ft <<*>> One a fu = One (g a) (ft <*> fu)
-- | >>> bifoldMap show show (One 1 [2, 3])
-- "123"
instance (Foldable f) => Bifoldable (One f) where
bifoldMap g h (One a ft) = g a <> foldMap h ft
-- | >>> bitraverse Just Just (One 1 [2, 3])
-- Just (One 1 [2,3])
instance (Traversable f) => Bitraversable (One f) where
bitraverse g h (One a ft) = One <$> g a <*> traverse h ft
-- | >>> bifoldMap1 show show (One 1 [2, 3])
-- "123"
--
-- >>> bifoldMap1 show show (One 1 ([] :: [Int]))
-- "1"
instance (Foldable f) => Bifoldable1 (One f) where
bifoldMap1 g h (One a ft) =
case foldMap (Just . h) ft of
Nothing -> g a
Just m -> g a <> m
-- | >>> bitraverse1 Identity Identity (One 1 (2 :| [3]))
-- Identity (One 1 (2 :| [3]))
instance (Traversable1 f) => Bitraversable1 (One f) where
bitraverse1 g h (One a ft) = One <$> g a <.> traverse1 h ft
-- | >>> foldMap1 show (One 'x' (1 :| [2, 3]))
-- "123"
instance (Foldable1 f) => Foldable1 (One f a) where
foldMap1 h (One _ ft) = foldMap1 h ft
-- | >>> traverse1 Identity (One 'x' (1 :| [2, 3]))
-- Identity (One 'x' (1 :| [2,3]))
instance (Traversable1 f) => Traversable1 (One f a) where
traverse1 h (One a ft) = One a <$> traverse1 h ft
class GetterOne x f a t | x -> f a t where
getOne :: Getter x (One f a t)
class (GetterOne x f a t) => HasOne x f a t | x -> f a t where
setOne :: x -> One f a t -> x
one :: Lens' x (One f a t)
default one :: Lens' x (One f a t)
one = lens (view getOne) setOne
rest :: Lens' x (f t)
rest = one . rest'
class ReviewOne x f a t | x -> f a t where
reviewOne :: Review x (One f a t)
class (ReviewOne x f a t) => AsOne x f a t | x -> f a t where
matchOne :: x -> Maybe (One f a t)
_One :: Prism' x (One f a t)
default _One :: Prism' x (One f a t)
_One = prism' (review reviewOne) matchOne
-- | >>> view getOne (One 7 [8, 9]) :: One [] Int Int
-- One 7 [8,9]
instance GetterOne (One f a t) f a t where
getOne = to id
-- | >>> view one (One 7 [8, 9]) :: One [] Int Int
-- One 7 [8,9]
--
-- >>> set one (One 9 [10]) (One 7 [8, 9])
-- One 9 [10]
instance HasOne (One f a t) f a t where
setOne _ x = x
rest = rest'
-- | >>> review reviewOne (One 7 [8]) :: One [] Int Int
-- One 7 [8]
instance ReviewOne (One f a t) f a t where
reviewOne = unto id
-- | >>> preview _One (One 7 [8]) :: Maybe (One [] Int Int)
-- Just (One 7 [8])
--
-- >>> review _One (One 7 [8]) :: One [] Int Int
-- One 7 [8]
instance AsOne (One f a t) f a t where
matchOne = Just
-- GetterOneItem / HasOneItem / ReviewOneItem / AsOneItem instances
-- | >>> view getOneItem (One 7 [8, 9])
-- 7
instance GetterOneItem (One f a t) where
type GetterOneItemElement (One f a t) = a
getOneItem = to (\(One a _) -> a)
-- | >>> view oneItem (One 7 [8, 9])
-- 7
--
-- >>> set oneItem 9 (One 7 [8, 9])
-- One 9 [8,9]
instance HasOneItem (One f a t) where
type HasOneItemElement (One f a t) = a
setOneItem (One _ fa) a = One a fa
-- | >>> review reviewOneItem 7 :: One [] Int Int
-- One 7 []
instance (Monoid (f t)) => ReviewOneItem (One f a t) where
type ReviewOneItemElement (One f a t) = a
reviewOneItem =
unto
(`One` mempty)
-- | >>> preview _OneItem (One 7 ([] :: [Int]))
-- Just 7
--
-- >>> preview _OneItem (One 7 [8])
-- Nothing
--
-- >>> review _OneItem 7 :: One [] Int Int
-- One 7 []
instance (Eq (f t), Monoid (f t)) => AsOneItem (One f a t) where
type AsOneItemElement (One f a t) = a
matchOneItem (One a fa) =
if fa == mempty then Just a else Nothing
-- | >>> view identity (Identity 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review identity (One 7 Proxy) :: Identity Int
-- Identity 7
identity :: Iso (Identity a) (Identity a') (One Proxy a t) (One Proxy a' t)
identity =
iso
(\(Identity h) -> One h Proxy)
(\(One h Proxy) -> Identity h)
-- | >>> view getOne (Identity 7) :: One Proxy Int ()
-- One 7 Proxy
instance GetterOne (Identity a) Proxy a () where
getOne = identity
-- | >>> view one (Identity 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> set one (One 9 Proxy) (Identity 7)
-- Identity 9
instance HasOne (Identity a) Proxy a () where
setOne _ (One a _) = Identity a
one = identity
-- | >>> review reviewOne (One 7 Proxy) :: Identity Int
-- Identity 7
instance ReviewOne (Identity a) Proxy a () where
reviewOne = identity
-- | >>> preview _One (Identity 7) :: Maybe (One Proxy Int ())
-- Just (One 7 Proxy)
--
-- >>> review _One (One 7 Proxy) :: Identity Int
-- Identity 7
instance AsOne (Identity a) Proxy a () where
matchOne (Identity a) = Just (One a Proxy)
_One = identity
-- | >>> view nonEmpty (1 :| [2, 3])
-- One 1 [2,3]
--
-- >>> review nonEmpty (One 1 [2, 3])
-- 1 :| [2,3]
nonEmpty :: Iso (NonEmpty a) (NonEmpty b) (One [] a a) (One [] b b)
nonEmpty =
iso
(\(h :| t) -> One h t)
(\(One h t) -> h :| t)
-- | >>> view getOne (1 :| [2, 3]) :: One [] Int Int
-- One 1 [2,3]
instance GetterOne (NonEmpty a) [] a a where
getOne = nonEmpty
-- | >>> view one (1 :| [2, 3]) :: One [] Int Int
-- One 1 [2,3]
--
-- >>> set one (One 9 [10]) (1 :| [2, 3])
-- 9 :| [10]
instance HasOne (NonEmpty a) [] a a where
setOne _ (One a t) = a :| t
one = nonEmpty
-- | >>> review reviewOne (One 7 [8, 9]) :: NonEmpty Int
-- 7 :| [8,9]
instance ReviewOne (NonEmpty a) [] a a where
reviewOne = nonEmpty
-- | >>> preview _One (1 :| [2, 3]) :: Maybe (One [] Int Int)
-- Just (One 1 [2,3])
--
-- >>> review _One (One 7 [8, 9]) :: NonEmpty Int
-- 7 :| [8,9]
instance AsOne (NonEmpty a) [] a a where
matchOne (h :| t) = Just (One h t)
_One = nonEmpty
-- | >>> preview list ['a', 'b', 'c']
-- Just (One 'a' "bc")
--
-- >>> preview list ([] :: [Int])
-- Nothing
--
-- >>> review list (One 'a' "bc")
-- "abc"
list :: Prism' [a] (One [] a a)
list =
prism'
(\(One h t) -> h : t)
( \case
[] -> Nothing
(h : t) -> Just (One h t)
)
-- | >>> review reviewOne (One 'a' "bc") :: [Char]
-- "abc"
instance ReviewOne [a] [] a a where
reviewOne = list
-- | >>> preview _One "abc" :: Maybe (One [] Char Char)
-- Just (One 'a' "bc")
--
-- >>> preview _One ([] :: [Int]) :: Maybe (One [] Int Int)
-- Nothing
instance AsOne [a] [] a a where
matchOne [] = Nothing
matchOne (h : t) = Just (One h t)
-- | >>> preview text (Text.pack "hello")
-- Just (One 'h' (Const "ello"))
--
-- >>> preview text Text.empty
-- Nothing
--
-- >>> review text (One 'h' (Const (Text.pack "ello")))
-- "hello"
text :: Prism' Text.Text (One (Const Text.Text) Char ())
text =
prism'
(\(One h (Const t)) -> Text.cons h t)
( \x -> case Text.uncons x of
Nothing -> Nothing
Just (h, t) -> Just (One h (Const t))
)
-- | >>> review reviewOne (One 'h' (Const (Text.pack "i"))) :: Text.Text
-- "hi"
instance ReviewOne Text.Text (Const Text.Text) Char () where
reviewOne = text
-- | >>> preview _One (Text.pack "hi") :: Maybe (One (Const Text.Text) Char ())
-- Just (One 'h' (Const "i"))
--
-- >>> preview _One Text.empty :: Maybe (One (Const Text.Text) Char ())
-- Nothing
instance AsOne Text.Text (Const Text.Text) Char () where
matchOne x = case Text.uncons x of
Nothing -> Nothing
Just (h, t) -> Just (One h (Const t))
-- | >>> preview lazyText (LazyText.pack "hello")
-- Just (One 'h' (Const "ello"))
--
-- >>> preview lazyText LazyText.empty
-- Nothing
--
-- >>> review lazyText (One 'h' (Const (LazyText.pack "ello")))
-- "hello"
lazyText :: Prism' LazyText.Text (One (Const LazyText.Text) Char ())
lazyText =
prism'
(\(One h (Const t)) -> LazyText.cons h t)
( \x -> case LazyText.uncons x of
Nothing -> Nothing
Just (h, t) -> Just (One h (Const t))
)
-- | >>> review reviewOne (One 'h' (Const (LazyText.pack "i"))) :: LazyText.Text
-- "hi"
instance ReviewOne LazyText.Text (Const LazyText.Text) Char () where
reviewOne = lazyText
-- | >>> preview _One (LazyText.pack "hi") :: Maybe (One (Const LazyText.Text) Char ())
-- Just (One 'h' (Const "i"))
--
-- >>> preview _One LazyText.empty :: Maybe (One (Const LazyText.Text) Char ())
-- Nothing
instance AsOne LazyText.Text (Const LazyText.Text) Char () where
matchOne x = case LazyText.uncons x of
Nothing -> Nothing
Just (h, t) -> Just (One h (Const t))
-- | >>> preview shortText (ShortText.pack "hello")
-- Just (One 'h' (Const "ello"))
--
-- >>> preview shortText (ShortText.pack "")
-- Nothing
--
-- >>> review shortText (One 'h' (Const (ShortText.pack "ello")))
-- "hello"
shortText :: Prism' ShortText.ShortText (One (Const ShortText.ShortText) Char ())
shortText =
prism'
(\(One h (Const t)) -> ShortText.cons h t)
( \x -> case ShortText.uncons x of
Nothing -> Nothing
Just (h, t) -> Just (One h (Const t))
)
-- | >>> review reviewOne (One 'h' (Const (ShortText.pack "i"))) :: ShortText.ShortText
-- "hi"
instance ReviewOne ShortText.ShortText (Const ShortText.ShortText) Char () where
reviewOne = shortText
-- | >>> preview _One (ShortText.pack "hi") :: Maybe (One (Const ShortText.ShortText) Char ())
-- Just (One 'h' (Const "i"))
--
-- >>> preview _One (ShortText.pack "") :: Maybe (One (Const ShortText.ShortText) Char ())
-- Nothing
instance AsOne ShortText.ShortText (Const ShortText.ShortText) Char () where
matchOne x = case ShortText.uncons x of
Nothing -> Nothing
Just (h, t) -> Just (One h (Const t))
-- | >>> view first' (First 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review first' (One 7 Proxy) :: First Int
-- First {getFirst = 7}
first' :: Iso (First a) (First a') (One Proxy a t) (One Proxy a' t)
first' =
iso
(\(First a) -> One a Proxy)
(\(One a Proxy) -> First a)
instance GetterOne (First a) Proxy a () where
getOne = first'
instance HasOne (First a) Proxy a () where
setOne _ (One a _) = First a
one = first'
instance ReviewOne (First a) Proxy a () where
reviewOne = first'
instance AsOne (First a) Proxy a () where
matchOne (First a) = Just (One a Proxy)
_One = first'
-- | >>> view last' (Last 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review last' (One 7 Proxy) :: Last Int
-- Last {getLast = 7}
last' :: Iso (Last a) (Last a') (One Proxy a t) (One Proxy a' t)
last' =
iso
(\(Last a) -> One a Proxy)
(\(One a Proxy) -> Last a)
instance GetterOne (Last a) Proxy a () where
getOne = last'
instance HasOne (Last a) Proxy a () where
setOne _ (One a _) = Last a
one = last'
instance ReviewOne (Last a) Proxy a () where
reviewOne = last'
instance AsOne (Last a) Proxy a () where
matchOne (Last a) = Just (One a Proxy)
_One = last'
-- | >>> view dual (Dual 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review dual (One 7 Proxy) :: Dual Int
-- Dual {getDual = 7}
dual :: Iso (Dual a) (Dual a') (One Proxy a t) (One Proxy a' t)
dual =
iso
(\(Dual a) -> One a Proxy)
(\(One a Proxy) -> Dual a)
instance GetterOne (Dual a) Proxy a () where
getOne = dual
instance HasOne (Dual a) Proxy a () where
setOne _ (One a _) = Dual a
one = dual
instance ReviewOne (Dual a) Proxy a () where
reviewOne = dual
instance AsOne (Dual a) Proxy a () where
matchOne (Dual a) = Just (One a Proxy)
_One = dual
-- | >>> view down (Down 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review down (One 7 Proxy) :: Down Int
-- Down 7
down :: Iso (Down a) (Down a') (One Proxy a t) (One Proxy a' t)
down =
iso
(\(Down a) -> One a Proxy)
(\(One a Proxy) -> Down a)
instance GetterOne (Down a) Proxy a () where
getOne = down
instance HasOne (Down a) Proxy a () where
setOne _ (One a _) = Down a
one = down
instance ReviewOne (Down a) Proxy a () where
reviewOne = down
instance AsOne (Down a) Proxy a () where
matchOne (Down a) = Just (One a Proxy)
_One = down
-- | >>> view sum' (Sum 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review sum' (One 7 Proxy) :: Sum Int
-- Sum {getSum = 7}
sum' :: Iso (Sum a) (Sum a') (One Proxy a t) (One Proxy a' t)
sum' =
iso
(\(Sum a) -> One a Proxy)
(\(One a Proxy) -> Sum a)
instance GetterOne (Sum a) Proxy a () where
getOne = sum'
instance HasOne (Sum a) Proxy a () where
setOne _ (One a _) = Sum a
one = sum'
instance ReviewOne (Sum a) Proxy a () where
reviewOne = sum'
instance AsOne (Sum a) Proxy a () where
matchOne (Sum a) = Just (One a Proxy)
_One = sum'
-- | >>> view product' (Product 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review product' (One 7 Proxy) :: Product Int
-- Product {getProduct = 7}
product' :: Iso (Product a) (Product a') (One Proxy a t) (One Proxy a' t)
product' =
iso
(\(Product a) -> One a Proxy)
(\(One a Proxy) -> Product a)
instance GetterOne (Product a) Proxy a () where
getOne = product'
instance HasOne (Product a) Proxy a () where
setOne _ (One a _) = Product a
one = product'
instance ReviewOne (Product a) Proxy a () where
reviewOne = product'
instance AsOne (Product a) Proxy a () where
matchOne (Product a) = Just (One a Proxy)
_One = product'
-- | >>> view min' (Min 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review min' (One 7 Proxy) :: Min Int
-- Min {getMin = 7}
min' :: Iso (Min a) (Min a') (One Proxy a t) (One Proxy a' t)
min' =
iso
(\(Min a) -> One a Proxy)
(\(One a Proxy) -> Min a)
instance GetterOne (Min a) Proxy a () where
getOne = min'
instance HasOne (Min a) Proxy a () where
setOne _ (One a _) = Min a
one = min'
instance ReviewOne (Min a) Proxy a () where
reviewOne = min'
instance AsOne (Min a) Proxy a () where
matchOne (Min a) = Just (One a Proxy)
_One = min'
-- | >>> view max' (Max 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review max' (One 7 Proxy) :: Max Int
-- Max {getMax = 7}
max' :: Iso (Max a) (Max a') (One Proxy a t) (One Proxy a' t)
max' =
iso
(\(Max a) -> One a Proxy)
(\(One a Proxy) -> Max a)
instance GetterOne (Max a) Proxy a () where
getOne = max'
instance HasOne (Max a) Proxy a () where
setOne _ (One a _) = Max a
one = max'
instance ReviewOne (Max a) Proxy a () where
reviewOne = max'
instance AsOne (Max a) Proxy a () where
matchOne (Max a) = Just (One a Proxy)
_One = max'
-- | >>> view wrappedMonoid (WrapMonoid 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review wrappedMonoid (One 7 Proxy) :: WrappedMonoid Int
-- WrapMonoid {unwrapMonoid = 7}
wrappedMonoid :: Iso (WrappedMonoid a) (WrappedMonoid a') (One Proxy a t) (One Proxy a' t)
wrappedMonoid =
iso
(\(WrapMonoid a) -> One a Proxy)
(\(One a Proxy) -> WrapMonoid a)
instance GetterOne (WrappedMonoid a) Proxy a () where
getOne = wrappedMonoid
instance HasOne (WrappedMonoid a) Proxy a () where
setOne _ (One a _) = WrapMonoid a
one = wrappedMonoid
instance ReviewOne (WrappedMonoid a) Proxy a () where
reviewOne = wrappedMonoid
instance AsOne (WrappedMonoid a) Proxy a () where
matchOne (WrapMonoid a) = Just (One a Proxy)
_One = wrappedMonoid
-- | >>> view par1 (Par1 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review par1 (One 7 Proxy) :: Par1 Int
-- Par1 {unPar1 = 7}
par1 :: Iso (Par1 a) (Par1 a') (One Proxy a t) (One Proxy a' t)
par1 =
iso
(\(Par1 a) -> One a Proxy)
(\(One a Proxy) -> Par1 a)
instance GetterOne (Par1 a) Proxy a () where
getOne = par1
instance HasOne (Par1 a) Proxy a () where
setOne _ (One a _) = Par1 a
one = par1
instance ReviewOne (Par1 a) Proxy a () where
reviewOne = par1
instance AsOne (Par1 a) Proxy a () where
matchOne (Par1 a) = Just (One a Proxy)
_One = par1
-- | >>> view solo (MkSolo 7) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review solo (One 7 Proxy) :: Solo Int
-- MkSolo 7
solo :: Iso (Solo a) (Solo a') (One Proxy a t) (One Proxy a' t)
solo =
iso
(\(MkSolo a) -> One a Proxy)
(\(One a Proxy) -> MkSolo a)
instance GetterOne (Solo a) Proxy a () where
getOne = solo
instance HasOne (Solo a) Proxy a () where
setOne _ (One a _) = MkSolo a
one = solo
instance ReviewOne (Solo a) Proxy a () where
reviewOne = solo
instance AsOne (Solo a) Proxy a () where
matchOne (MkSolo a) = Just (One a Proxy)
_One = solo
-- | >>> view const' (Const 7 :: Const Int String) :: One Proxy Int ()
-- One 7 Proxy
--
-- >>> review const' (One 7 Proxy) :: Const Int String
-- Const 7
const' :: Iso (Const a b) (Const a' b) (One Proxy a t) (One Proxy a' t)
const' =
iso
(\(Const a) -> One a Proxy)
(\(One a Proxy) -> Const a)
instance GetterOne (Const a b) Proxy a () where
getOne = const'
instance HasOne (Const a b) Proxy a () where
setOne _ (One a _) = Const a
one = const'
instance ReviewOne (Const a b) Proxy a () where
reviewOne = const'
instance AsOne (Const a b) Proxy a () where
matchOne (Const a) = Just (One a Proxy)
_One = const'
-- | >>> view tuple ("hello", 7) :: One (Const String) Int ()
-- One 7 (Const "hello")
--
-- >>> review tuple (One 7 (Const "hello")) :: (String, Int)
-- ("hello",7)
tuple :: Iso (x, a) (x, a') (One (Const x) a t) (One (Const x) a' t)
tuple =
iso
(\(x, a) -> One a (Const x))
(\(One a (Const x)) -> (x, a))
-- | >>> view getOne ("hello", 7) :: One (Const String) Int ()
-- One 7 (Const "hello")
instance GetterOne (x, a) (Const x) a () where
getOne = tuple
-- | >>> view one ("hello", 7) :: One (Const String) Int ()
-- One 7 (Const "hello")
--
-- >>> set one (One 9 (Const "world")) ("hello", 7)
-- ("world",9)
instance HasOne (x, a) (Const x) a () where
setOne _ (One a (Const x)) = (x, a)
one = tuple
-- | >>> review reviewOne (One 7 (Const "hello")) :: (String, Int)
-- ("hello",7)
instance ReviewOne (x, a) (Const x) a () where
reviewOne = tuple
-- | >>> preview _One ("hello", 7) :: Maybe (One (Const String) Int ())
-- Just (One 7 (Const "hello"))
instance AsOne (x, a) (Const x) a () where
matchOne (x, a) = Just (One a (Const x))
_One = tuple