module Data.Accessor.Tuple where

import qualified Data.Accessor.Basic as Accessor

{- * Example accessors for the pair type -}

{- | Access to the first value of a pair. -}
first :: Accessor.T (a,b) a
first :: forall a b. T (a, b) a
first = forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\a
x (a
_,b
y) -> (a
x,b
y)) forall a b. (a, b) -> a
fst

{- | Access to the second value of a pair. -}
second :: Accessor.T (a,b) b
second :: forall a b. T (a, b) b
second = forall a r. (a -> r -> r) -> (r -> a) -> T r a
Accessor.fromSetGet (\b
y (a
x,b
_) -> (a
x,b
y)) forall a b. (a, b) -> b
snd


{- | Access to the first value of a triple. -}
first3 :: Accessor.T (a,b,c) a
first3 :: forall a b c. T (a, b, c) a
first3 = forall r a. (r -> (a, a -> r)) -> T r a
Accessor.fromLens forall a b. (a -> b) -> a -> b
$ \(a
xOld,b
y,c
z) -> (a
xOld, \a
xNew -> (a
xNew,b
y,c
z))

{- | Access to the second value of a triple. -}
second3 :: Accessor.T (a,b,c) b
second3 :: forall a b c. T (a, b, c) b
second3 = forall r a. (r -> (a, a -> r)) -> T r a
Accessor.fromLens forall a b. (a -> b) -> a -> b
$ \(a
x,b
yOld,c
z) -> (b
yOld, \b
yNew -> (a
x,b
yNew,c
z))

{- | Access to the third value of a triple. -}
third3 :: Accessor.T (a,b,c) c
third3 :: forall a b c. T (a, b, c) c
third3 = forall r a. (r -> (a, a -> r)) -> T r a
Accessor.fromLens forall a b. (a -> b) -> a -> b
$ \(a
x,b
y,c
zOld) -> (c
zOld, \c
zNew -> (a
x,b
y,c
zNew))