{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeOperators #-}

{-|
Module      : Data.Has
Description : Simple extensible product
Copyright   : (c) Winterland, 2016
License     : BSD
Maintainer  : drkoster@qq.com
Stability   : experimental
Portability : PORTABLE

This module provide 'Has' class which provide simple extensible product.
The use case for this class is illustrated as following:

@
 \{\-\# LANGUAGE FlexibleContexts \#\-\}

 -- in some library code
 ...
 logInAnyReaderHasLogger :: (Has Logger r, MonadReader r m) => LogString -> m ()
 logInAnyReaderHasLogger s = asks getter >>= logWithLogger s

 queryInAnyReaderHasSQL :: (Has SqlBackEnd r, MonadReader r m) => Query -> m a
 queryInAnyReaderHasSQL q = asks getter >>= queryWithSQL q
 ...

 -- now you want to use these effects together
 ...
 logger <- initLogger  ...
 sql <- initSqlBackEnd ...

 (\`runReader\` (logger, sql)) $ do
       ...
       logInAnyReaderHasLogger ...
       ...
       x <- queryInAnyReaderHasSQL ...
       ...
@

If you need multiple elements with same type, you can use <http://hackage.haskell.org/package/tagged tagged>
like:

@
(Has (Tagged \"StdLogger\" Logger) r, Has (Tagged \"FileLogger\" Logger) r, ...) => ...

runYourMonad ... ( stdLogger :: Tagged \"StdLogger\" Logger
                 , fileLogger :: Tagged \"FileLogger\" Logger, ...)
@

Or you can define newtypes(which is less verbose and require no dependency):

@
newtype StdLogger = StdLogger Logger
newtype FileLogger = FileLogger Logger

runYourMonad ... (StdLogger stdLogger, FileLogger fileLogger)
@

Polymorphic values, such as numeric and string literals(with OverloadedString Enabled)
may lead to type inference failure, you simply need type annotations in these cases:

@ ... (3 :: Int, "hello" :: String, ...) @

This module also provide infix type operator and pattern synonym of tuple, i.e. inductive procducts,
which is more convenient to write. An overlapping instance prefer first(left) one is provided:

@
> getter (True :*: "hello" :*: 1) :: Integer
> 1
> getter (1 :*: 2 :*: 3) :: Integer
> 1
@

-}

module Data.Has where

import Data.Functor.Identity ( Identity(Identity, runIdentity) )
import Control.Applicative ( Const(Const, getConst) )

type Lens t a = forall f. Functor f => (a -> f a) -> t -> f t

-- | Infix version of tuple(right associative).
type a :*: b = (a, b)

-- | Infix pattern alias for tuple(right associative).
pattern (:*:) :: a -> b -> (a, b)
pattern a $b:*: :: a -> b -> (a, b)
$m:*: :: forall r a b. (a, b) -> (a -> b -> r) -> (Void# -> r) -> r
:*: b = (a, b)

infixr 1 :*:

-- | A type class for extensible product.
--
-- We provide instances for tuples up to 12 elements by default.
-- You can define your own instance of 'Has', but most of the time tuples will do fine.
--
class Has a t where
    {-# MINIMAL getter, modifier | hasLens #-}
    getter :: t -> a
    getter = Const a t -> a
forall a k (b :: k). Const a b -> a
getConst (Const a t -> a) -> (t -> Const a t) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a a) -> t -> Const a t
forall a t. Has a t => Lens t a
hasLens a -> Const a a
forall k a (b :: k). a -> Const a b
Const

    modifier :: (a -> a) -> t -> t
    modifier a -> a
f t
t = Identity t -> t
forall a. Identity a -> a
runIdentity ((a -> Identity a) -> t -> Identity t
forall a t. Has a t => Lens t a
hasLens (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (a -> a) -> a -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) t
t)

    hasLens :: Lens t a
    hasLens a -> f a
afa t
t = (\a
a -> (a -> a) -> t -> t
forall a t. Has a t => (a -> a) -> t -> t
modifier (a -> a -> a
forall a b. a -> b -> a
const a
a) t
t) (a -> t) -> f a -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
afa (t -> a
forall a t. Has a t => t -> a
getter t
t)

instance Has a a where
    getter :: a -> a
getter = a -> a
forall a. a -> a
id
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> a -> a
modifier = (a -> a) -> a -> a
forall a. a -> a
id
    {-# INLINABLE modifier #-}

instance {-# OVERLAPPING #-} Has a (a, b) where
    getter :: (a, b) -> a
getter (a
a, b
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> (a, b) -> (a, b)
modifier a -> a
f (a
a, b
b) = (a -> a
f a
a, b
b)
    {-# INLINABLE modifier #-}

instance {-# OVERLAPPABLE #-} Has b bs => Has b (a, bs) where
    getter :: (a, bs) -> b
getter (a
_, bs
bs) = bs -> b
forall a t. Has a t => t -> a
getter bs
bs
    {-# INLINABLE getter #-}
    modifier :: (b -> b) -> (a, bs) -> (a, bs)
modifier b -> b
f (a
a, bs
b) = (a
a, (b -> b) -> bs -> bs
forall a t. Has a t => (a -> a) -> t -> t
modifier b -> b
f bs
b)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c) where
    getter :: (a, b, c) -> a
getter (a
a, b
_, c
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> (a, b, c) -> (a, b, c)
modifier a -> a
f (a
a, b
b, c
c) = (a -> a
f a
a, b
b, c
c)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c) where
    getter :: (a, b, c) -> b
getter (a
_, b
b, c
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b) -> (a, b, c) -> (a, b, c)
modifier b -> b
f (a
a, b
b, c
c) = (a
a, b -> b
f b
b, c
c)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c) where
    getter :: (a, b, c) -> c
getter (a
_, b
_, c
c) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c) -> (a, b, c) -> (a, b, c)
modifier c -> c
f (a
a, b
b, c
c) = (a
a, b
b, c -> c
f c
c)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d) where
    getter :: (a, b, c, d) -> a
getter (a
a, b
_, c
_, d
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> (a, b, c, d) -> (a, b, c, d)
modifier a -> a
f (a
a, b
b, c
c, d
d) = (a -> a
f a
a, b
b, c
c, d
d)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d) where
    getter :: (a, b, c, d) -> b
getter (a
_, b
b, c
_, d
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b) -> (a, b, c, d) -> (a, b, c, d)
modifier b -> b
f (a
a, b
b, c
c, d
d) = (a
a, b -> b
f b
b, c
c, d
d)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d) where
    getter :: (a, b, c, d) -> c
getter (a
_, b
_, c
c, d
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c) -> (a, b, c, d) -> (a, b, c, d)
modifier c -> c
f (a
a, b
b, c
c, d
d) = (a
a, b
b, c -> c
f c
c, d
d)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d) where
    getter :: (a, b, c, d) -> d
getter (a
_, b
_, c
_, d
d) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d) -> (a, b, c, d) -> (a, b, c, d)
modifier d -> d
f (a
a, b
b, c
c, d
d) = (a
a, b
b, c
c, d -> d
f d
d)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e) where
    getter :: (a, b, c, d, e) -> a
getter (a
a, b
_, c
_, d
_, e
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> (a, b, c, d, e) -> (a, b, c, d, e)
modifier a -> a
f (a
a, b
b, c
c, d
d, e
e) = (a -> a
f a
a, b
b, c
c, d
d, e
e)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e) where
    getter :: (a, b, c, d, e) -> b
getter (a
_, b
b, c
_, d
_, e
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b) -> (a, b, c, d, e) -> (a, b, c, d, e)
modifier b -> b
f (a
a, b
b, c
c, d
d, e
e) = (a
a, b -> b
f b
b, c
c, d
d, e
e)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e) where
    getter :: (a, b, c, d, e) -> c
getter (a
_, b
_, c
c, d
_, e
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c) -> (a, b, c, d, e) -> (a, b, c, d, e)
modifier c -> c
f (a
a, b
b, c
c, d
d, e
e) = (a
a, b
b, c -> c
f c
c, d
d, e
e)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e) where
    getter :: (a, b, c, d, e) -> d
getter (a
_, b
_, c
_, d
d, e
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d) -> (a, b, c, d, e) -> (a, b, c, d, e)
modifier d -> d
f (a
a, b
b, c
c, d
d, e
e) = (a
a, b
b, c
c, d -> d
f d
d, e
e)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e) where
    getter :: (a, b, c, d, e) -> e
getter (a
_, b
_, c
_, d
_, e
e) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e) -> (a, b, c, d, e) -> (a, b, c, d, e)
modifier e -> e
f (a
a, b
b, c
c, d
d, e
e) = (a
a, b
b, c
c, d
d, e -> e
f e
e)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e, f) where
    getter :: (a, b, c, d, e, f) -> a
getter (a
a, b
_, c
_, d
_, e
_, f
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
modifier a -> a
ff (a
a, b
b, c
c, d
d, e
e, f
f) = (a -> a
ff a
a, b
b, c
c, d
d, e
e, f
f)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e, f) where
    getter :: (a, b, c, d, e, f) -> b
getter (a
_, b
b, c
_, d
_, e
_, f
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
modifier b -> b
ff (a
a, b
b, c
c, d
d, e
e, f
f) = (a
a, b -> b
ff b
b, c
c, d
d, e
e, f
f)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e, f) where
    getter :: (a, b, c, d, e, f) -> c
getter (a
_, b
_, c
c, d
_, e
_, f
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
modifier c -> c
ff (a
a, b
b, c
c, d
d, e
e, f
f) = (a
a, b
b, c -> c
ff c
c, d
d, e
e, f
f)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e, f) where
    getter :: (a, b, c, d, e, f) -> d
getter (a
_, b
_, c
_, d
d, e
_, f
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
modifier d -> d
ff (a
a, b
b, c
c, d
d, e
e, f
f) = (a
a, b
b, c
c, d -> d
ff d
d, e
e, f
f)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e, f) where
    getter :: (a, b, c, d, e, f) -> e
getter (a
_, b
_, c
_, d
_, e
e, f
_) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
modifier e -> e
ff (a
a, b
b, c
c, d
d, e
e, f
f) = (a
a, b
b, c
c, d
d, e -> e
ff e
e, f
f)
    {-# INLINABLE modifier #-}
instance Has f (a, b, c, d, e, f) where
    getter :: (a, b, c, d, e, f) -> f
getter (a
_, b
_, c
_, d
_, e
_, f
f) = f
f
    {-# INLINABLE getter #-}
    modifier :: (f -> f) -> (a, b, c, d, e, f) -> (a, b, c, d, e, f)
modifier f -> f
ff (a
a, b
b, c
c, d
d, e
e, f
f) = (a
a, b
b, c
c, d
d, e
e, f -> f
ff f
f)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e, f, g) where
    getter :: (a, b, c, d, e, f, g) -> a
getter (a
a, b
_, c
_, d
_, e
_, f
_, g
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
modifier a -> a
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = (a -> a
ff a
a, b
b, c
c, d
d, e
e, f
f, g
g)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e, f, g) where
    getter :: (a, b, c, d, e, f, g) -> b
getter (a
_, b
b, c
_, d
_, e
_, f
_, g
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
modifier b -> b
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = (a
a, b -> b
ff b
b, c
c, d
d, e
e, f
f, g
g)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e, f, g) where
    getter :: (a, b, c, d, e, f, g) -> c
getter (a
_, b
_, c
c, d
_, e
_, f
_, g
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
modifier c -> c
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = (a
a, b
b, c -> c
ff c
c, d
d, e
e, f
f, g
g)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e, f, g) where
    getter :: (a, b, c, d, e, f, g) -> d
getter (a
_, b
_, c
_, d
d, e
_, f
_, g
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
modifier d -> d
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = (a
a, b
b, c
c, d -> d
ff d
d, e
e, f
f, g
g)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e, f, g) where
    getter :: (a, b, c, d, e, f, g) -> e
getter (a
_, b
_, c
_, d
_, e
e, f
_, g
_) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
modifier e -> e
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = (a
a, b
b, c
c, d
d, e -> e
ff e
e, f
f, g
g)
    {-# INLINABLE modifier #-}
instance Has f (a, b, c, d, e, f, g) where
    getter :: (a, b, c, d, e, f, g) -> f
getter (a
_, b
_, c
_, d
_, e
_, f
f, g
_) = f
f
    {-# INLINABLE getter #-}
    modifier :: (f -> f) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
modifier f -> f
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = (a
a, b
b, c
c, d
d, e
e, f -> f
ff f
f, g
g)
    {-# INLINABLE modifier #-}
instance Has g (a, b, c, d, e, f, g) where
    getter :: (a, b, c, d, e, f, g) -> g
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
g) = g
g
    {-# INLINABLE getter #-}
    modifier :: (g -> g) -> (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
modifier g -> g
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = (a
a, b
b, c
c, d
d, e
e, f
f, g -> g
ff g
g)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> a
getter (a
a, b
_, c
_, d
_, e
_, f
_, g
_, h
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier a -> a
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a -> a
ff a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> b
getter (a
_, b
b, c
_, d
_, e
_, f
_, g
_, h
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier b -> b
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a
a, b -> b
ff b
b, c
c, d
d, e
e, f
f, g
g, h
h)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> c
getter (a
_, b
_, c
c, d
_, e
_, f
_, g
_, h
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier c -> c
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a
a, b
b, c -> c
ff c
c, d
d, e
e, f
f, g
g, h
h)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> d
getter (a
_, b
_, c
_, d
d, e
_, f
_, g
_, h
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier d -> d
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a
a, b
b, c
c, d -> d
ff d
d, e
e, f
f, g
g, h
h)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> e
getter (a
_, b
_, c
_, d
_, e
e, f
_, g
_, h
_) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier e -> e
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a
a, b
b, c
c, d
d, e -> e
ff e
e, f
f, g
g, h
h)
    {-# INLINABLE modifier #-}
instance Has f (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> f
getter (a
_, b
_, c
_, d
_, e
_, f
f, g
_, h
_) = f
f
    {-# INLINABLE getter #-}
    modifier :: (f -> f) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier f -> f
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a
a, b
b, c
c, d
d, e
e, f -> f
ff f
f, g
g, h
h)
    {-# INLINABLE modifier #-}
instance Has g (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> g
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
g, h
_) = g
g
    {-# INLINABLE getter #-}
    modifier :: (g -> g) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier g -> g
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a
a, b
b, c
c, d
d, e
e, f
f, g -> g
ff g
g, h
h)
    {-# INLINABLE modifier #-}
instance Has h (a, b, c, d, e, f, g, h) where
    getter :: (a, b, c, d, e, f, g, h) -> h
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
h) = h
h
    {-# INLINABLE getter #-}
    modifier :: (h -> h) -> (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
modifier h -> h
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h -> h
ff h
h)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> a
getter (a
a, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier a -> a
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a -> a
ff a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> b
getter (a
_, b
b, c
_, d
_, e
_, f
_, g
_, h
_, i
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier b -> b
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b -> b
ff b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> c
getter (a
_, b
_, c
c, d
_, e
_, f
_, g
_, h
_, i
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier c -> c
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b
b, c -> c
ff c
c, d
d, e
e, f
f, g
g, h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> d
getter (a
_, b
_, c
_, d
d, e
_, f
_, g
_, h
_, i
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier d -> d
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b
b, c
c, d -> d
ff d
d, e
e, f
f, g
g, h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> e
getter (a
_, b
_, c
_, d
_, e
e, f
_, g
_, h
_, i
_) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier e -> e
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b
b, c
c, d
d, e -> e
ff e
e, f
f, g
g, h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has f (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> f
getter (a
_, b
_, c
_, d
_, e
_, f
f, g
_, h
_, i
_) = f
f
    {-# INLINABLE getter #-}
    modifier :: (f -> f)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier f -> f
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b
b, c
c, d
d, e
e, f -> f
ff f
f, g
g, h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has g (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> g
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
g, h
_, i
_) = g
g
    {-# INLINABLE getter #-}
    modifier :: (g -> g)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier g -> g
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b
b, c
c, d
d, e
e, f
f, g -> g
ff g
g, h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has h (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> h
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
h, i
_) = h
h
    {-# INLINABLE getter #-}
    modifier :: (h -> h)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier h -> h
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h -> h
ff h
h, i
i)
    {-# INLINABLE modifier #-}
instance Has i (a, b, c, d, e, f, g, h, i) where
    getter :: (a, b, c, d, e, f, g, h, i) -> i
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
i) = i
i
    {-# INLINABLE getter #-}
    modifier :: (i -> i)
-> (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i)
modifier i -> i
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i -> i
ff i
i)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> a
getter (a
a, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier a -> a
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a -> a
ff a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> b
getter (a
_, b
b, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier b -> b
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b -> b
ff b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> c
getter (a
_, b
_, c
c, d
_, e
_, f
_, g
_, h
_, i
_, j
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier c -> c
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c -> c
ff c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> d
getter (a
_, b
_, c
_, d
d, e
_, f
_, g
_, h
_, i
_, j
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier d -> d
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c
c, d -> d
ff d
d, e
e, f
f, g
g, h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> e
getter (a
_, b
_, c
_, d
_, e
e, f
_, g
_, h
_, i
_, j
_) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier e -> e
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c
c, d
d, e -> e
ff e
e, f
f, g
g, h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has f (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> f
getter (a
_, b
_, c
_, d
_, e
_, f
f, g
_, h
_, i
_, j
_) = f
f
    {-# INLINABLE getter #-}
    modifier :: (f -> f)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier f -> f
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c
c, d
d, e
e, f -> f
ff f
f, g
g, h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has g (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> g
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
g, h
_, i
_, j
_) = g
g
    {-# INLINABLE getter #-}
    modifier :: (g -> g)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier g -> g
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c
c, d
d, e
e, f
f, g -> g
ff g
g, h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has h (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> h
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
h, i
_, j
_) = h
h
    {-# INLINABLE getter #-}
    modifier :: (h -> h)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier h -> h
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h -> h
ff h
h, i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has i (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> i
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
i, j
_) = i
i
    {-# INLINABLE getter #-}
    modifier :: (i -> i)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier i -> i
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i -> i
ff i
i, j
j)
    {-# INLINABLE modifier #-}
instance Has j (a, b, c, d, e, f, g, h, i, j) where
    getter :: (a, b, c, d, e, f, g, h, i, j) -> j
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
j) = j
j
    {-# INLINABLE getter #-}
    modifier :: (j -> j)
-> (a, b, c, d, e, f, g, h, i, j) -> (a, b, c, d, e, f, g, h, i, j)
modifier j -> j
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j -> j
ff j
j)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> a
getter (a
a, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier a -> a
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a -> a
ff a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> b
getter (a
_, b
b, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier b -> b
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b -> b
ff b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> c
getter (a
_, b
_, c
c, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier c -> c
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c -> c
ff c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> d
getter (a
_, b
_, c
_, d
d, e
_, f
_, g
_, h
_, i
_, j
_, k
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier d -> d
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d -> d
ff d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> e
getter (a
_, b
_, c
_, d
_, e
e, f
_, g
_, h
_, i
_, j
_, k
_) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier e -> e
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d
d, e -> e
ff e
e, f
f, g
g, h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has f (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> f
getter (a
_, b
_, c
_, d
_, e
_, f
f, g
_, h
_, i
_, j
_, k
_) = f
f
    {-# INLINABLE getter #-}
    modifier :: (f -> f)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier f -> f
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d
d, e
e, f -> f
ff f
f, g
g, h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has g (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> g
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
g, h
_, i
_, j
_, k
_) = g
g
    {-# INLINABLE getter #-}
    modifier :: (g -> g)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier g -> g
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d
d, e
e, f
f, g -> g
ff g
g, h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has h (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> h
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
h, i
_, j
_, k
_) = h
h
    {-# INLINABLE getter #-}
    modifier :: (h -> h)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier h -> h
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h -> h
ff h
h, i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has i (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> i
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
i, j
_, k
_) = i
i
    {-# INLINABLE getter #-}
    modifier :: (i -> i)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier i -> i
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i -> i
ff i
i, j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has j (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> j
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
j, k
_) = j
j
    {-# INLINABLE getter #-}
    modifier :: (j -> j)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier j -> j
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j -> j
ff j
j, k
k)
    {-# INLINABLE modifier #-}
instance Has k (a, b, c, d, e, f, g, h, i, j, k) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k) -> k
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
k) = k
k
    {-# INLINABLE getter #-}
    modifier :: (k -> k)
-> (a, b, c, d, e, f, g, h, i, j, k)
-> (a, b, c, d, e, f, g, h, i, j, k)
modifier k -> k
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k -> k
ff k
k)
    {-# INLINABLE modifier #-}

--------------------------------------------------------------------------------

instance Has a (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> a
getter (a
a, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
_, l
_) = a
a
    {-# INLINABLE getter #-}
    modifier :: (a -> a)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier a -> a
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a -> a
ff a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has b (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> b
getter (a
_, b
b, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
_, l
_) = b
b
    {-# INLINABLE getter #-}
    modifier :: (b -> b)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier b -> b
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b -> b
ff b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has c (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> c
getter (a
_, b
_, c
c, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
_, l
_) = c
c
    {-# INLINABLE getter #-}
    modifier :: (c -> c)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier c -> c
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c -> c
ff c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has d (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> d
getter (a
_, b
_, c
_, d
d, e
_, f
_, g
_, h
_, i
_, j
_, k
_, l
_) = d
d
    {-# INLINABLE getter #-}
    modifier :: (d -> d)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier d -> d
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d -> d
ff d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has e (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> e
getter (a
_, b
_, c
_, d
_, e
e, f
_, g
_, h
_, i
_, j
_, k
_, l
_) = e
e
    {-# INLINABLE getter #-}
    modifier :: (e -> e)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier e -> e
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e -> e
ff e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has f (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> f
getter (a
_, b
_, c
_, d
_, e
_, f
f, g
_, h
_, i
_, j
_, k
_, l
_) = f
f
    {-# INLINABLE getter #-}
    modifier :: (f -> f)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier f -> f
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e
e, f -> f
ff f
f, g
g, h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has g (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> g
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
g, h
_, i
_, j
_, k
_, l
_) = g
g
    {-# INLINABLE getter #-}
    modifier :: (g -> g)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier g -> g
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e
e, f
f, g -> g
ff g
g, h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has h (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> h
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
h, i
_, j
_, k
_, l
_) = h
h
    {-# INLINABLE getter #-}
    modifier :: (h -> h)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier h -> h
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h -> h
ff h
h, i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has i (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> i
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
i, j
_, k
_, l
_) = i
i
    {-# INLINABLE getter #-}
    modifier :: (i -> i)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier i -> i
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i -> i
ff i
i, j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has j (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> j
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
j, k
_, l
_) = j
j
    {-# INLINABLE getter #-}
    modifier :: (j -> j)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier j -> j
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j -> j
ff j
j, k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has k (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> k
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
k, l
_) = k
k
    {-# INLINABLE getter #-}
    modifier :: (k -> k)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier k -> k
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k -> k
ff k
k, l
l)
    {-# INLINABLE modifier #-}
instance Has l (a, b, c, d, e, f, g, h, i, j, k, l) where
    getter :: (a, b, c, d, e, f, g, h, i, j, k, l) -> l
getter (a
_, b
_, c
_, d
_, e
_, f
_, g
_, h
_, i
_, j
_, k
_, l
l) = l
l
    {-# INLINABLE getter #-}
    modifier :: (l -> l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
-> (a, b, c, d, e, f, g, h, i, j, k, l)
modifier l -> l
ff (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l
l) = (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h, i
i, j
j, k
k, l -> l
ff l
l)
    {-# INLINABLE modifier #-}