{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

module Lens.Micro.FieldN where

import Lens.Micro.Type

class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  {- |
Gives access to the 1st field of a tuple (up to 5-tuples).

Getting the 1st component:

>>> (1,2,3,4,5) ^. _1
1

Setting the 1st component:

>>> (1,2,3) & _1 .~ 10
(10,2,3)

Note that this lens is lazy, and can set fields even of 'undefined':

>>> set _1 10 undefined :: (Int, Int)
(10,*** Exception: Prelude.undefined

This is done to avoid violating a lens law stating that you can get back what you put:

>>> view _1 . set _1 10 $ (undefined :: (Int, Int))
10

The implementation (for 2-tuples) is:

@
'_1' f t = (,) '<$>' f    ('fst' t)
             '<*>' 'pure' ('snd' t)
@

or, alternatively,

@
'_1' f ~(a,b) = (\\a' -> (a',b)) '<$>' f a
@

(where @~@ means a <https://wiki.haskell.org/Lazy_pattern_match lazy pattern>).

'_2', '_3', '_4', and '_5' are also available (see below).
  -}
  _1 :: Lens s t a b

instance Field1 (a,b) (a',b) a a' where
  _1 :: Lens (a, b) (a', b) a a'
_1 a -> f a'
k ~(a
a,b
b) = (\a'
a' -> (a'
a',b
b)) (a' -> (a', b)) -> f a' -> f (a', b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c) (a',b,c) a a' where
  _1 :: Lens (a, b, c) (a', b, c) a a'
_1 a -> f a'
k ~(a
a,b
b,c
c) = (\a'
a' -> (a'
a',b
b,c
c)) (a' -> (a', b, c)) -> f a' -> f (a', b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d) (a',b,c,d) a a' where
  _1 :: Lens (a, b, c, d) (a', b, c, d) a a'
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d) = (\a'
a' -> (a'
a',b
b,c
c,d
d)) (a' -> (a', b, c, d)) -> f a' -> f (a', b, c, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where
  _1 :: Lens (a, b, c, d, e) (a', b, c, d, e) a a'
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d,e
e) = (\a'
a' -> (a'
a',b
b,c
c,d
d,e
e)) (a' -> (a', b, c, d, e)) -> f a' -> f (a', b, c, d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where
  _1 :: Lens (a, b, c, d, e, f) (a', b, c, d, e, f) a a'
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d,e
e,f
f) = (\a'
a' -> (a'
a',b
b,c
c,d
d,e
e,f
f)) (a' -> (a', b, c, d, e, f)) -> f a' -> f (a', b, c, d, e, f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where
  _1 :: Lens (a, b, c, d, e, f, g) (a', b, c, d, e, f, g) a a'
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (\a'
a' -> (a'
a',b
b,c
c,d
d,e
e,f
f,g
g)) (a' -> (a', b, c, d, e, f, g)) -> f a' -> f (a', b, c, d, e, f, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where
  _1 :: Lens (a, b, c, d, e, f, g, h) (a', b, c, d, e, f, g, h) a a'
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\a'
a' -> (a'
a',b
b,c
c,d
d,e
e,f
f,g
g,h
h)) (a' -> (a', b, c, d, e, f, g, h))
-> f a' -> f (a', b, c, d, e, f, g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where
  _1 :: Lens (a, b, c, d, e, f, g, h, i) (a', b, c, d, e, f, g, h, i) a a'
_1 a -> f a'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\a'
a' -> (a'
a',b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)) (a' -> (a', b, c, d, e, f, g, h, i))
-> f a' -> f (a', b, c, d, e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a'
k a
a
  {-# INLINE _1 #-}

class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _2 :: Lens s t a b

instance Field2 (a,b) (a,b') b b' where
  _2 :: Lens (a, b) (a, b') b b'
_2 b -> f b'
k ~(a
a,b
b) = (\b'
b' -> (a
a,b'
b')) (b' -> (a, b')) -> f b' -> f (a, b')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c) (a,b',c) b b' where
  _2 :: Lens (a, b, c) (a, b', c) b b'
_2 b -> f b'
k ~(a
a,b
b,c
c) = (\b'
b' -> (a
a,b'
b',c
c)) (b' -> (a, b', c)) -> f b' -> f (a, b', c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d) (a,b',c,d) b b' where
  _2 :: Lens (a, b, c, d) (a, b', c, d) b b'
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d) = (\b'
b' -> (a
a,b'
b',c
c,d
d)) (b' -> (a, b', c, d)) -> f b' -> f (a, b', c, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where
  _2 :: Lens (a, b, c, d, e) (a, b', c, d, e) b b'
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d,e
e) = (\b'
b' -> (a
a,b'
b',c
c,d
d,e
e)) (b' -> (a, b', c, d, e)) -> f b' -> f (a, b', c, d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where
  _2 :: Lens (a, b, c, d, e, f) (a, b', c, d, e, f) b b'
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d,e
e,f
f) = (\b'
b' -> (a
a,b'
b',c
c,d
d,e
e,f
f)) (b' -> (a, b', c, d, e, f)) -> f b' -> f (a, b', c, d, e, f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where
  _2 :: Lens (a, b, c, d, e, f, g) (a, b', c, d, e, f, g) b b'
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (\b'
b' -> (a
a,b'
b',c
c,d
d,e
e,f
f,g
g)) (b' -> (a, b', c, d, e, f, g)) -> f b' -> f (a, b', c, d, e, f, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where
  _2 :: Lens (a, b, c, d, e, f, g, h) (a, b', c, d, e, f, g, h) b b'
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\b'
b' -> (a
a,b'
b',c
c,d
d,e
e,f
f,g
g,h
h)) (b' -> (a, b', c, d, e, f, g, h))
-> f b' -> f (a, b', c, d, e, f, g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where
  _2 :: Lens (a, b, c, d, e, f, g, h, i) (a, b', c, d, e, f, g, h, i) b b'
_2 b -> f b'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\b'
b' -> (a
a,b'
b',c
c,d
d,e
e,f
f,g
g,h
h,i
i)) (b' -> (a, b', c, d, e, f, g, h, i))
-> f b' -> f (a, b', c, d, e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f b'
k b
b
  {-# INLINE _2 #-}

class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _3 :: Lens s t a b

instance Field3 (a,b,c) (a,b,c') c c' where
  _3 :: Lens (a, b, c) (a, b, c') c c'
_3 c -> f c'
k ~(a
a,b
b,c
c) = (\c'
c' -> (a
a,b
b,c'
c')) (c' -> (a, b, c')) -> f c' -> f (a, b, c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d) (a,b,c',d) c c' where
  _3 :: Lens (a, b, c, d) (a, b, c', d) c c'
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d) = (\c'
c' -> (a
a,b
b,c'
c',d
d)) (c' -> (a, b, c', d)) -> f c' -> f (a, b, c', d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where
  _3 :: Lens (a, b, c, d, e) (a, b, c', d, e) c c'
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d,e
e) = (\c'
c' -> (a
a,b
b,c'
c',d
d,e
e)) (c' -> (a, b, c', d, e)) -> f c' -> f (a, b, c', d, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where
  _3 :: Lens (a, b, c, d, e, f) (a, b, c', d, e, f) c c'
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d,e
e,f
f) = (\c'
c' -> (a
a,b
b,c'
c',d
d,e
e,f
f)) (c' -> (a, b, c', d, e, f)) -> f c' -> f (a, b, c', d, e, f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where
  _3 :: Lens (a, b, c, d, e, f, g) (a, b, c', d, e, f, g) c c'
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (\c'
c' -> (a
a,b
b,c'
c',d
d,e
e,f
f,g
g)) (c' -> (a, b, c', d, e, f, g)) -> f c' -> f (a, b, c', d, e, f, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where
  _3 :: Lens (a, b, c, d, e, f, g, h) (a, b, c', d, e, f, g, h) c c'
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\c'
c' -> (a
a,b
b,c'
c',d
d,e
e,f
f,g
g,h
h)) (c' -> (a, b, c', d, e, f, g, h))
-> f c' -> f (a, b, c', d, e, f, g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where
  _3 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c', d, e, f, g, h, i) c c'
_3 c -> f c'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\c'
c' -> (a
a,b
b,c'
c',d
d,e
e,f
f,g
g,h
h,i
i)) (c' -> (a, b, c', d, e, f, g, h, i))
-> f c' -> f (a, b, c', d, e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
k c
c
  {-# INLINE _3 #-}

class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _4 :: Lens s t a b

instance Field4 (a,b,c,d) (a,b,c,d') d d' where
  _4 :: Lens (a, b, c, d) (a, b, c, d') d d'
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d) = (\d'
d' -> (a
a,b
b,c
c,d'
d')) (d' -> (a, b, c, d')) -> f d' -> f (a, b, c, d')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where
  _4 :: Lens (a, b, c, d, e) (a, b, c, d', e) d d'
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d,e
e) = (\d'
d' -> (a
a,b
b,c
c,d'
d',e
e)) (d' -> (a, b, c, d', e)) -> f d' -> f (a, b, c, d', e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where
  _4 :: Lens (a, b, c, d, e, f) (a, b, c, d', e, f) d d'
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d,e
e,f
f) = (\d'
d' -> (a
a,b
b,c
c,d'
d',e
e,f
f)) (d' -> (a, b, c, d', e, f)) -> f d' -> f (a, b, c, d', e, f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where
  _4 :: Lens (a, b, c, d, e, f, g) (a, b, c, d', e, f, g) d d'
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (\d'
d' -> (a
a,b
b,c
c,d'
d',e
e,f
f,g
g)) (d' -> (a, b, c, d', e, f, g)) -> f d' -> f (a, b, c, d', e, f, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where
  _4 :: Lens (a, b, c, d, e, f, g, h) (a, b, c, d', e, f, g, h) d d'
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\d'
d' -> (a
a,b
b,c
c,d'
d',e
e,f
f,g
g,h
h)) (d' -> (a, b, c, d', e, f, g, h))
-> f d' -> f (a, b, c, d', e, f, g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where
  _4 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c, d', e, f, g, h, i) d d'
_4 d -> f d'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\d'
d' -> (a
a,b
b,c
c,d'
d',e
e,f
f,g
g,h
h,i
i)) (d' -> (a, b, c, d', e, f, g, h, i))
-> f d' -> f (a, b, c, d', e, f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d -> f d'
k d
d
  {-# INLINE _4 #-}

class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _5 :: Lens s t a b

instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where
  _5 :: Lens (a, b, c, d, e) (a, b, c, d, e') e e'
_5 e -> f e'
k ~(a
a,b
b,c
c,d
d,e
e) = (\e'
e' -> (a
a,b
b,c
c,d
d,e'
e')) (e' -> (a, b, c, d, e')) -> f e' -> f (a, b, c, d, e')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e'
k e
e
  {-# INLINE _5 #-}

instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where
  _5 :: Lens (a, b, c, d, e, f) (a, b, c, d, e', f) e e'
_5 e -> f e'
k ~(a
a,b
b,c
c,d
d,e
e,f
f) = (\e'
e' -> (a
a,b
b,c
c,d
d,e'
e',f
f)) (e' -> (a, b, c, d, e', f)) -> f e' -> f (a, b, c, d, e', f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e'
k e
e
  {-# INLINE _5 #-}

instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where
  _5 :: Lens (a, b, c, d, e, f, g) (a, b, c, d, e', f, g) e e'
_5 e -> f e'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (\e'
e' -> (a
a,b
b,c
c,d
d,e'
e',f
f,g
g)) (e' -> (a, b, c, d, e', f, g)) -> f e' -> f (a, b, c, d, e', f, g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e'
k e
e
  {-# INLINE _5 #-}

instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where
  _5 :: Lens (a, b, c, d, e, f, g, h) (a, b, c, d, e', f, g, h) e e'
_5 e -> f e'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\e'
e' -> (a
a,b
b,c
c,d
d,e'
e',f
f,g
g,h
h)) (e' -> (a, b, c, d, e', f, g, h))
-> f e' -> f (a, b, c, d, e', f, g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e'
k e
e
  {-# INLINE _5 #-}

instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where
  _5 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c, d, e', f, g, h, i) e e'
_5 e -> f e'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\e'
e' -> (a
a,b
b,c
c,d
d,e'
e',f
f,g
g,h
h,i
i)) (e' -> (a, b, c, d, e', f, g, h, i))
-> f e' -> f (a, b, c, d, e', f, g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f e'
k e
e
  {-# INLINE _5 #-}

class Field6 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _6 :: Lens s t a b

instance Field6 (a,b,c,d,e,f) (a,b,c,d,e,f') f f' where
  _6 :: Lens (a, b, c, d, e, f) (a, b, c, d, e, f') f f'
_6 f -> f f'
k ~(a
a,b
b,c
c,d
d,e
e,f
f) = (\f'
f' -> (a
a,b
b,c
c,d
d,e
e,f'
f')) (f' -> (a, b, c, d, e, f')) -> f f' -> f (a, b, c, d, e, f')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f -> f f'
k f
f
  {-# INLINE _6 #-}

instance Field6 (a,b,c,d,e,f,g) (a,b,c,d,e,f',g) f f' where
  _6 :: Lens (a, b, c, d, e, f, g) (a, b, c, d, e, f', g) f f'
_6 f -> f f'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (\f'
f' -> (a
a,b
b,c
c,d
d,e
e,f'
f',g
g)) (f' -> (a, b, c, d, e, f', g)) -> f f' -> f (a, b, c, d, e, f', g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f -> f f'
k f
f
  {-# INLINE _6 #-}

instance Field6 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f',g,h) f f' where
  _6 :: Lens (a, b, c, d, e, f, g, h) (a, b, c, d, e, f', g, h) f f'
_6 f -> f f'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\f'
f' -> (a
a,b
b,c
c,d
d,e
e,f'
f',g
g,h
h)) (f' -> (a, b, c, d, e, f', g, h))
-> f f' -> f (a, b, c, d, e, f', g, h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f -> f f'
k f
f
  {-# INLINE _6 #-}

instance Field6 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f',g,h,i) f f' where
  _6 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f', g, h, i) f f'
_6 f -> f f'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\f'
f' -> (a
a,b
b,c
c,d
d,e
e,f'
f',g
g,h
h,i
i)) (f' -> (a, b, c, d, e, f', g, h, i))
-> f f' -> f (a, b, c, d, e, f', g, h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f -> f f'
k f
f
  {-# INLINE _6 #-}

class Field7 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _7 :: Lens s t a b

instance Field7 (a,b,c,d,e,f,g) (a,b,c,d,e,f,g') g g' where
  _7 :: Lens (a, b, c, d, e, f, g) (a, b, c, d, e, f, g') g g'
_7 g -> f g'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (\g'
g' -> (a
a,b
b,c
c,d
d,e
e,f
f,g'
g')) (g' -> (a, b, c, d, e, f, g')) -> f g' -> f (a, b, c, d, e, f, g')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> f g'
k g
g
  {-# INLINE _7 #-}

instance Field7 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g',h) g g' where
  _7 :: Lens (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g', h) g g'
_7 g -> f g'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\g'
g' -> (a
a,b
b,c
c,d
d,e
e,f
f,g'
g',h
h)) (g' -> (a, b, c, d, e, f, g', h))
-> f g' -> f (a, b, c, d, e, f, g', h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> f g'
k g
g
  {-# INLINE _7 #-}

instance Field7 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g',h,i) g g' where
  _7 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g', h, i) g g'
_7 g -> f g'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\g'
g' -> (a
a,b
b,c
c,d
d,e
e,f
f,g'
g',h
h,i
i)) (g' -> (a, b, c, d, e, f, g', h, i))
-> f g' -> f (a, b, c, d, e, f, g', h, i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> f g'
k g
g
  {-# INLINE _7 #-}

class Field8 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _8 :: Lens s t a b

instance Field8 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g,h') h h' where
  _8 :: Lens (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g, h') h h'
_8 h -> f h'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (\h'
h' -> (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h'
h')) (h' -> (a, b, c, d, e, f, g, h'))
-> f h' -> f (a, b, c, d, e, f, g, h')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f h'
k h
h
  {-# INLINE _8 #-}

instance Field8 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h',i) h h' where
  _8 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h', i) h h'
_8 h -> f h'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\h'
h' -> (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h'
h',i
i)) (h' -> (a, b, c, d, e, f, g, h', i))
-> f h' -> f (a, b, c, d, e, f, g, h', i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h -> f h'
k h
h
  {-# INLINE _8 #-}

class Field9 s t a b | s -> a, t -> b, s b -> t, t a -> s where
  _9 :: Lens s t a b

instance Field9 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h,i') i i' where
  _9 :: Lens (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h, i') i i'
_9 i -> f i'
k ~(a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = (\i'
i' -> (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i'
i')) (i' -> (a, b, c, d, e, f, g, h, i'))
-> f i' -> f (a, b, c, d, e, f, g, h, i')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> f i'
k i
i