{-|
Module:      Acme.Cadre
License:     Public domain
Maintainer:  Jafet <jafet.vixle@gmail.com>
Stability:   experimental

Cadre is a powerful framework for the organization of heterogeneous units.
A live-fire demonstration follows.

Cadre allows any unit to be addressed uniformly:

@
\>>> 'car' (1, 2)
/1/
\>>> car (1, 2, 3)
/1/
\>>> car (1, 2, 3, 4)
/1/
\>>> 'cdr' (1, 2)
/2/
\>>> cdr (1, 2, 3)
/(2, 3)/
\>>> cdr (1, 2, 3, 4)
/(2, 3, 4)/
@

and also reassigned uniformly:

@
\>>> 'setCar' (+ 1) (1, 2)
/(2, 2)/
\>>> 'setCdr' (subtract 1) (1, 2)
/(1, 1)/
@

Of course, these basic functions can be used to carry out combined operations:

@
\>>> 'caddr' (1, 2, 3, 4)
/3/
\>>> caddr (1, 2, (3, 4))
/3/
\>>> caddr (1, (2, 3, 4))
/3/
\>>> 'setCaddr' (+ 1) (1, 2, 3, (4, 5))
/(1, 2, 4, (4, 5))/
\>>> 'cdaar' . 'cdddr' $ (1, (2, 3, ((4, 5), 6), 7))
/5/
@

Observe the simplicity and scalability of our approach.
Cadre can use any type of car, opening up more logistical possibilities:

@
\>>> 'cdddddr' [1 .. 10]
/[6, 7, 8, 9, 10]/
\>>> 'setCddr' reverse (0, [1 .. 4])
/(0, [1, 4, 3, 2])/
@

From time to time you may find dissent among your ranks.
Suppose that your lieutenant insists on

@
capture :: IO (X, Y, (Z, Z))
@

but your right-hand-man demands compliance with

@
dispose :: (X, (Y, [Z])) -> IO ()
@

Cadre helps them look past their differences and find solidarity:

@
capture >>= 'repair4' '<&>' dispose
@

'repair' is straightforward, even in the field.
In fact, its constituent steps are clear from its name:

@
'repair4' = 'reap4' \<&> 'pare4'

\>>> reap4 (1, 2, 3, 4)
/(1, (2, (3, 4)))/
\>>> pare4 (1, (2, (3, 4))) :: (Int, Int, Int, Int)
/(1, 2, 3, 4)/
\>>> pare4 (1, (2, (3, 4))) :: (Int, [Int])
/(1, [2, 3, 4])/
@

By understanding the details of 'repair', we gain more flexibility in field operations:

@
\>>> 'setCddr' (uncurry (++)) (\"a\", \"b\", \"c\", \"d\")
/-- not permitted due to negative assessment of typing protocol/
\>>> pare3 . setCddr (uncurry (++)) . reap4 $ (\"a\", \"b\", \"c\", \"d\") :: (String, String, String)
/("a", "b", "cd")/
@
 
This concludes the live demonstration.
-}

{-# LANGUAGE FlexibleInstances, FlexibleContexts, FunctionalDependencies, UndecidableInstances, NoMonomorphismRestriction #-}

module Acme.Cadre where


-- | @(\<&>) = flip (.)@.
--   Hide this if you are importing @\<&\>@ from <http://hackage.haskell.org/package/lens Control.Lens>.
(<&>) = flip (.)
infixl 9 <&>

class Cadre a car cdr | a -> car cdr where
  cadre :: a -> (car, cdr)

instance Cadre (a1, a2) a1 (a2) where
  cadre (a1, a2) = (a1, (a2))
instance Cadre (a1, a2, a3) a1 (a2, a3) where
  cadre (a1, a2, a3) = (a1, (a2, a3))
instance Cadre (a1, a2, a3, a4) a1 (a2, a3, a4) where
  cadre (a1, a2, a3, a4) = (a1, (a2, a3, a4))
instance Cadre (a1, a2, a3, a4, a5) a1 (a2, a3, a4, a5) where
  cadre (a1, a2, a3, a4, a5) = (a1, (a2, a3, a4, a5))
instance Cadre (a1, a2, a3, a4, a5, a6) a1 (a2, a3, a4, a5, a6) where
  cadre (a1, a2, a3, a4, a5, a6) = (a1, (a2, a3, a4, a5, a6))
instance Cadre (a1, a2, a3, a4, a5, a6, a7) a1 (a2, a3, a4, a5, a6, a7) where
  cadre (a1, a2, a3, a4, a5, a6, a7) = (a1, (a2, a3, a4, a5, a6, a7))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8) a1 (a2, a3, a4, a5, a6, a7, a8) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8) = (a1, (a2, a3, a4, a5, a6, a7, a8))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9) a1 (a2, a3, a4, a5, a6, a7, a8, a9) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9, a10))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15))
instance Cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) where
  cadre (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) = (a1, (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16))

instance Cadre [a] a [a] where
  cadre (a1:a) = (a1, a)
  cadre _ = error "Acme.Cadre.cadre: list size mismatch"

car = fst . cadre
cdr = snd . cadre

caar = car.car
cadr = car.cdr
cdar = cdr.car
cddr = cdr.cdr

caaar = car.caar
caadr = car.cadr
cadar = car.cdar
caddr = car.cddr
cdaar = cdr.caar
cdadr = cdr.cadr
cddar = cdr.cdar
cdddr = cdr.cddr

caaaar = caar.caar
caaadr = caar.cadr
caadar = caar.cdar
caaddr = caar.cddr
cadaar = cadr.caar
cadadr = cadr.cadr
caddar = cadr.cdar
cadddr = cadr.cddr
cdaaar = cdar.caar
cdaadr = cdar.cadr
cdadar = cdar.cdar
cdaddr = cdar.cddr
cddaar = cddr.caar
cddadr = cddr.cadr
cdddar = cddr.cdar
cddddr = cddr.cddr

caddddr = car.cddddr
cdddddr = cdr.cddddr
cadddddr = cadr.cddddr
cddddddr = cddr.cddddr
caddddddr = caddr.cddddr
cdddddddr = cdddr.cddddr
cadddddddr = cadddr.cddddr
cddddddddr = cddddr.cddddr
caddddddddr = car.cddddddddr
cdddddddddr = cdr.cddddddddr
cadddddddddr = cadr.cddddddddr
cddddddddddr = cddr.cddddddddr


class (Cadre a car cdr, Cadre a' car' cdr') =>
        CadreAssign a car cdr a' car' cdr' | a car' cdr' -> a' where
  setCadre :: (car -> car') -> (cdr -> cdr') -> a -> a'

instance CadreAssign (a1, a2) a1 (a2) (b1, b2) b1 (b2) where
  setCadre f1 f2 (a1, a2) = let (b2) = f2 (a2) in (f1 a1, b2)
instance CadreAssign (a1, a2, a3) a1 (a2, a3) (b1, b2, b3) b1 (b2, b3) where
  setCadre f1 f2 (a1, a2, a3) = let (b2, b3) = f2 (a2, a3) in (f1 a1, b2, b3)
instance CadreAssign (a1, a2, a3, a4) a1 (a2, a3, a4) (b1, b2, b3, b4) b1 (b2, b3, b4) where
  setCadre f1 f2 (a1, a2, a3, a4) = let (b2, b3, b4) = f2 (a2, a3, a4) in (f1 a1, b2, b3, b4)
instance CadreAssign (a1, a2, a3, a4, a5) a1 (a2, a3, a4, a5) (b1, b2, b3, b4, b5) b1 (b2, b3, b4, b5) where
  setCadre f1 f2 (a1, a2, a3, a4, a5) = let (b2, b3, b4, b5) = f2 (a2, a3, a4, a5) in (f1 a1, b2, b3, b4, b5)
instance CadreAssign (a1, a2, a3, a4, a5, a6) a1 (a2, a3, a4, a5, a6) (b1, b2, b3, b4, b5, b6) b1 (b2, b3, b4, b5, b6) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6) = let (b2, b3, b4, b5, b6) = f2 (a2, a3, a4, a5, a6) in (f1 a1, b2, b3, b4, b5, b6)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7) a1 (a2, a3, a4, a5, a6, a7) (b1, b2, b3, b4, b5, b6, b7) b1 (b2, b3, b4, b5, b6, b7) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7) = let (b2, b3, b4, b5, b6, b7) = f2 (a2, a3, a4, a5, a6, a7) in (f1 a1, b2, b3, b4, b5, b6, b7)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8) a1 (a2, a3, a4, a5, a6, a7, a8) (b1, b2, b3, b4, b5, b6, b7, b8) b1 (b2, b3, b4, b5, b6, b7, b8) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8) = let (b2, b3, b4, b5, b6, b7, b8) = f2 (a2, a3, a4, a5, a6, a7, a8) in (f1 a1, b2, b3, b4, b5, b6, b7, b8)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9) a1 (a2, a3, a4, a5, a6, a7, a8, a9) (b1, b2, b3, b4, b5, b6, b7, b8, b9) b1 (b2, b3, b4, b5, b6, b7, b8, b9) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9) = let (b2, b3, b4, b5, b6, b7, b8, b9) = f2 (a2, a3, a4, a5, a6, a7, a8, a9) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10) b1 (b2, b3, b4, b5, b6, b7, b8, b9, b10) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = let (b2, b3, b4, b5, b6, b7, b8, b9, b10) = f2 (a2, a3, a4, a5, a6, a7, a8, a9, a10) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9, b10)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11) b1 (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) = let (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11) = f2 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12) b1 (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) = let (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12) = f2 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13) b1 (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) = let (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13) = f2 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14) b1 (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) = let (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14) = f2 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15) b1 (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) = let (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15) = f2 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15)
instance CadreAssign (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) a1 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16) b1 (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16) where
  setCadre f1 f2 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) = let (b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16) = f2 (a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16) in (f1 a1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16)

instance CadreAssign [a] a [a] [a] a [a] where
  setCadre f1 f2 (a1:a) = f1 a1 : f2 a
  setCadre _ _ _ = error "Acme.Cadre.setCadre: list size mismatch"

setCar = (`setCadre` id)
setCdr = setCadre id

setCaar = setCar<&>setCar
setCadr = setCar<&>setCdr
setCdar = setCdr<&>setCar
setCddr = setCdr<&>setCdr

setCaaar = setCar<&>setCaar
setCaadr = setCar<&>setCadr
setCadar = setCar<&>setCdar
setCaddr = setCar<&>setCddr
setCdaar = setCdr<&>setCaar
setCdadr = setCdr<&>setCadr
setCddar = setCdr<&>setCdar
setCdddr = setCdr<&>setCddr

setCaaaar = setCaar<&>setCaar
setCaaadr = setCaar<&>setCadr
setCaadar = setCaar<&>setCdar
setCaaddr = setCaar<&>setCddr
setCadaar = setCadr<&>setCaar
setCadadr = setCadr<&>setCadr
setCaddar = setCadr<&>setCdar
setCadddr = setCadr<&>setCddr
setCdaaar = setCdar<&>setCaar
setCdaadr = setCdar<&>setCadr
setCdadar = setCdar<&>setCdar
setCdaddr = setCdar<&>setCddr
setCddaar = setCddr<&>setCaar
setCddadr = setCddr<&>setCadr
setCdddar = setCddr<&>setCdar
setCddddr = setCddr<&>setCddr

setCaddddr = setCar<&>setCddddr
setCdddddr = setCdr<&>setCddddr
setCadddddr = setCadr<&>setCddddr
setCddddddr = setCddr<&>setCddddr
setCaddddddr = setCaddr<&>setCddddr
setCdddddddr = setCdddr<&>setCddddr
setCadddddddr = setCadddr<&>setCddddr
setCddddddddr = setCddddr<&>setCddddr
setCaddddddddr = setCar<&>setCddddddddr
setCdddddddddr = setCdr<&>setCddddddddr
setCadddddddddr = setCadr<&>setCddddddddr
setCddddddddddr = setCddr<&>setCddddddddr



-- | Things that can be reshaped into cons pairs.

-- FIXME: can we have a generic repairN?
class PearShaped2 a a1 a2 | a -> a1 a2 where
  reap2 :: a -> (a1, a2)
  pare2 :: (a1, a2) -> a

instance PearShaped2 (a1, a2) a1 a2 where
  reap2 p = (car p, cdr p)
  pare2 (a1, a2) = (a1, a2)

instance PearShaped2 [a] a a where
  reap2 [a1, a2] = (a1, a2)
  pare2 (a1, a2) = [a1, a2]

repair2 = reap2 <&> pare2

class PearShaped3 a a1 a2 a3 | a -> a1 a2 a3 where
  reap3 :: a -> (a1, (a2, a3))
  pare3 :: (a1, (a2, a3)) -> a

instance PearShaped2 a a2 a3 => PearShaped3 (a1, a) a1 a2 a3 where
  reap3 p = (car p, reap2 (cdr p))
  pare3 (a1, a) = (a1, pare2 a)
instance PearShaped3 (a1, a2, a3) a1 a2 a3 where
  reap3 p = (car p, reap2 (cdr p))
  pare3 (a1, (a2, a3)) = (a1, a2, a3)

instance PearShaped3 [a] a a a where
  reap3 p = (car p, reap2 (cdr p))
  pare3 (a1, a) = a1 : pare2 a

repair3 = reap3 <&> pare3

class PearShaped4 a a1 a2 a3 a4 | a -> a1 a2 a3 a4 where
  reap4 :: a -> (a1, (a2, (a3, a4)))
  pare4 :: (a1, (a2, (a3, a4))) -> a

instance PearShaped2 a a3 a4 => PearShaped4 (a1, a2, a) a1 a2 a3 a4 where
  reap4 p = (car p, reap3 (cdr p))
  pare4 (a1, (a2, a)) = (a1, a2, pare2 a)
instance PearShaped3 a a2 a3 a4 => PearShaped4 (a1, a) a1 a2 a3 a4 where
  reap4 p = (car p, reap3 (cdr p))
  pare4 (a1, a) = (a1, pare3 a)
instance PearShaped4 (a1, a2, a3, a4) a1 a2 a3 a4 where
  reap4 p = (car p, reap3 (cdr p))
  pare4 (a1, (a2, (a3, a4))) = (a1, a2, a3, a4)

instance PearShaped4 [a] a a a a where
  reap4 p = (car p, reap3 (cdr p))
  pare4 (a1, a) = a1 : pare3 a

repair4 = reap4 <&> pare4

class PearShaped5 a a1 a2 a3 a4 a5 | a -> a1 a2 a3 a4 a5 where
  reap5 :: a -> (a1, (a2, (a3, (a4, a5))))
  pare5 :: (a1, (a2, (a3, (a4, a5)))) -> a

instance PearShaped2 a a4 a5 => PearShaped5 (a1, a2, a3, a) a1 a2 a3 a4 a5 where
  reap5 p = (car p, reap4 (cdr p))
  pare5 (a1, (a2, (a3, a))) = (a1, a2, a3, pare2 a)
instance PearShaped3 a a3 a4 a5 => PearShaped5 (a1, a2, a) a1 a2 a3 a4 a5 where
  reap5 p = (car p, reap4 (cdr p))
  pare5 (a1, (a2, a)) = (a1, a2, pare3 a)
instance PearShaped4 a a2 a3 a4 a5 => PearShaped5 (a1, a) a1 a2 a3 a4 a5 where
  reap5 p = (car p, reap4 (cdr p))
  pare5 (a1, a) = (a1, pare4 a)
instance PearShaped5 (a1, a2, a3, a4, a5) a1 a2 a3 a4 a5 where
  reap5 p = (car p, reap4 (cdr p))
  pare5 (a1, (a2, (a3, (a4, a5)))) = (a1, a2, a3, a4, a5)

instance PearShaped5 [a] a a a a a where
  reap5 p = (car p, reap4 (cdr p))
  pare5 (a1, a) = a1 : pare4 a

repair5 = reap5 <&> pare5

class PearShaped6 a a1 a2 a3 a4 a5 a6 | a -> a1 a2 a3 a4 a5 a6 where
  reap6 :: a -> (a1, (a2, (a3, (a4, (a5, a6)))))
  pare6 :: (a1, (a2, (a3, (a4, (a5, a6))))) -> a

instance PearShaped2 a a5 a6 => PearShaped6 (a1, a2, a3, a4, a) a1 a2 a3 a4 a5 a6 where
  reap6 p = (car p, reap5 (cdr p))
  pare6 (a1, (a2, (a3, (a4, a)))) = (a1, a2, a3, a4, pare2 a)
instance PearShaped3 a a4 a5 a6 => PearShaped6 (a1, a2, a3, a) a1 a2 a3 a4 a5 a6 where
  reap6 p = (car p, reap5 (cdr p))
  pare6 (a1, (a2, (a3, a))) = (a1, a2, a3, pare3 a)
instance PearShaped4 a a3 a4 a5 a6 => PearShaped6 (a1, a2, a) a1 a2 a3 a4 a5 a6 where
  reap6 p = (car p, reap5 (cdr p))
  pare6 (a1, (a2, a)) = (a1, a2, pare4 a)
instance PearShaped5 a a2 a3 a4 a5 a6 => PearShaped6 (a1, a) a1 a2 a3 a4 a5 a6 where
  reap6 p = (car p, reap5 (cdr p))
  pare6 (a1, a) = (a1, pare5 a)
instance PearShaped6 (a1, a2, a3, a4, a5, a6) a1 a2 a3 a4 a5 a6 where
  reap6 p = (car p, reap5 (cdr p))
  pare6 (a1, (a2, (a3, (a4, (a5, a6))))) = (a1, a2, a3, a4, a5, a6)

instance PearShaped6 [a] a a a a a a where
  reap6 p = (car p, reap5 (cdr p))
  pare6 (a1, a) = a1 : pare5 a

repair6 = reap6 <&> pare6

class PearShaped7 a a1 a2 a3 a4 a5 a6 a7 | a -> a1 a2 a3 a4 a5 a6 a7 where
  reap7 :: a -> (a1, (a2, (a3, (a4, (a5, (a6, a7))))))
  pare7 :: (a1, (a2, (a3, (a4, (a5, (a6, a7)))))) -> a

instance PearShaped2 a a6 a7 => PearShaped7 (a1, a2, a3, a4, a5, a) a1 a2 a3 a4 a5 a6 a7 where
  reap7 p = (car p, reap6 (cdr p))
  pare7 (a1, (a2, (a3, (a4, (a5, a))))) = (a1, a2, a3, a4, a5, pare2 a)
instance PearShaped3 a a5 a6 a7 => PearShaped7 (a1, a2, a3, a4, a) a1 a2 a3 a4 a5 a6 a7 where
  reap7 p = (car p, reap6 (cdr p))
  pare7 (a1, (a2, (a3, (a4, a)))) = (a1, a2, a3, a4, pare3 a)
instance PearShaped4 a a4 a5 a6 a7 => PearShaped7 (a1, a2, a3, a) a1 a2 a3 a4 a5 a6 a7 where
  reap7 p = (car p, reap6 (cdr p))
  pare7 (a1, (a2, (a3, a))) = (a1, a2, a3, pare4 a)
instance PearShaped5 a a3 a4 a5 a6 a7 => PearShaped7 (a1, a2, a) a1 a2 a3 a4 a5 a6 a7 where
  reap7 p = (car p, reap6 (cdr p))
  pare7 (a1, (a2, a)) = (a1, a2, pare5 a)
instance PearShaped6 a a2 a3 a4 a5 a6 a7 => PearShaped7 (a1, a) a1 a2 a3 a4 a5 a6 a7 where
  reap7 p = (car p, reap6 (cdr p))
  pare7 (a1, a) = (a1, pare6 a)
instance PearShaped7 (a1, a2, a3, a4, a5, a6, a7) a1 a2 a3 a4 a5 a6 a7 where
  reap7 p = (car p, reap6 (cdr p))
  pare7 (a1, (a2, (a3, (a4, (a5, (a6, a7)))))) = (a1, a2, a3, a4, a5, a6, a7)

instance PearShaped7 [a] a a a a a a a where
  reap7 p = (car p, reap6 (cdr p))
  pare7 (a1, a) = a1 : pare6 a

repair7 = reap7 <&> pare7

class PearShaped8 a a1 a2 a3 a4 a5 a6 a7 a8 | a -> a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 :: a -> (a1, (a2, (a3, (a4, (a5, (a6, (a7, a8)))))))
  pare8 :: (a1, (a2, (a3, (a4, (a5, (a6, (a7, a8))))))) -> a

instance PearShaped2 a a7 a8 => PearShaped8 (a1, a2, a3, a4, a5, a6, a) a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, (a2, (a3, (a4, (a5, (a6, a)))))) = (a1, a2, a3, a4, a5, a6, pare2 a)
instance PearShaped3 a a6 a7 a8 => PearShaped8 (a1, a2, a3, a4, a5, a) a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, (a2, (a3, (a4, (a5, a))))) = (a1, a2, a3, a4, a5, pare3 a)
instance PearShaped4 a a5 a6 a7 a8 => PearShaped8 (a1, a2, a3, a4, a) a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, (a2, (a3, (a4, a)))) = (a1, a2, a3, a4, pare4 a)
instance PearShaped5 a a4 a5 a6 a7 a8 => PearShaped8 (a1, a2, a3, a) a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, (a2, (a3, a))) = (a1, a2, a3, pare5 a)
instance PearShaped6 a a3 a4 a5 a6 a7 a8 => PearShaped8 (a1, a2, a) a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, (a2, a)) = (a1, a2, pare6 a)
instance PearShaped7 a a2 a3 a4 a5 a6 a7 a8 => PearShaped8 (a1, a) a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, a) = (a1, pare7 a)
instance PearShaped8 (a1, a2, a3, a4, a5, a6, a7, a8) a1 a2 a3 a4 a5 a6 a7 a8 where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, (a2, (a3, (a4, (a5, (a6, (a7, a8))))))) = (a1, a2, a3, a4, a5, a6, a7, a8)

instance PearShaped8 [a] a a a a a a a a where
  reap8 p = (car p, reap7 (cdr p))
  pare8 (a1, a) = a1 : pare7 a

repair8 = reap8 <&> pare8

class PearShaped9 a a1 a2 a3 a4 a5 a6 a7 a8 a9 | a -> a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 :: a -> (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, a9))))))))
  pare9 :: (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, a9)))))))) -> a

instance PearShaped2 a a8 a9 => PearShaped9 (a1, a2, a3, a4, a5, a6, a7, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, (a2, (a3, (a4, (a5, (a6, (a7, a))))))) = (a1, a2, a3, a4, a5, a6, a7, pare2 a)
instance PearShaped3 a a7 a8 a9 => PearShaped9 (a1, a2, a3, a4, a5, a6, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, (a2, (a3, (a4, (a5, (a6, a)))))) = (a1, a2, a3, a4, a5, a6, pare3 a)
instance PearShaped4 a a6 a7 a8 a9 => PearShaped9 (a1, a2, a3, a4, a5, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, (a2, (a3, (a4, (a5, a))))) = (a1, a2, a3, a4, a5, pare4 a)
instance PearShaped5 a a5 a6 a7 a8 a9 => PearShaped9 (a1, a2, a3, a4, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, (a2, (a3, (a4, a)))) = (a1, a2, a3, a4, pare5 a)
instance PearShaped6 a a4 a5 a6 a7 a8 a9 => PearShaped9 (a1, a2, a3, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, (a2, (a3, a))) = (a1, a2, a3, pare6 a)
instance PearShaped7 a a3 a4 a5 a6 a7 a8 a9 => PearShaped9 (a1, a2, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, (a2, a)) = (a1, a2, pare7 a)
instance PearShaped8 a a2 a3 a4 a5 a6 a7 a8 a9 => PearShaped9 (a1, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, a) = (a1, pare8 a)
instance PearShaped9 (a1, a2, a3, a4, a5, a6, a7, a8, a9) a1 a2 a3 a4 a5 a6 a7 a8 a9 where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, a9)))))))) = (a1, a2, a3, a4, a5, a6, a7, a8, a9)

instance PearShaped9 [a] a a a a a a a a a where
  reap9 p = (car p, reap8 (cdr p))
  pare9 (a1, a) = a1 : pare8 a

repair9 = reap9 <&> pare9

class PearShaped10 a a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 | a -> a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 :: a -> (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, a10)))))))))
  pare10 :: (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, a10))))))))) -> a

instance PearShaped2 a a9 a10 => PearShaped10 (a1, a2, a3, a4, a5, a6, a7, a8, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, a)))))))) = (a1, a2, a3, a4, a5, a6, a7, a8, pare2 a)
instance PearShaped3 a a8 a9 a10 => PearShaped10 (a1, a2, a3, a4, a5, a6, a7, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, (a3, (a4, (a5, (a6, (a7, a))))))) = (a1, a2, a3, a4, a5, a6, a7, pare3 a)
instance PearShaped4 a a7 a8 a9 a10 => PearShaped10 (a1, a2, a3, a4, a5, a6, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, (a3, (a4, (a5, (a6, a)))))) = (a1, a2, a3, a4, a5, a6, pare4 a)
instance PearShaped5 a a6 a7 a8 a9 a10 => PearShaped10 (a1, a2, a3, a4, a5, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, (a3, (a4, (a5, a))))) = (a1, a2, a3, a4, a5, pare5 a)
instance PearShaped6 a a5 a6 a7 a8 a9 a10 => PearShaped10 (a1, a2, a3, a4, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, (a3, (a4, a)))) = (a1, a2, a3, a4, pare6 a)
instance PearShaped7 a a4 a5 a6 a7 a8 a9 a10 => PearShaped10 (a1, a2, a3, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, (a3, a))) = (a1, a2, a3, pare7 a)
instance PearShaped8 a a3 a4 a5 a6 a7 a8 a9 a10 => PearShaped10 (a1, a2, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, a)) = (a1, a2, pare8 a)
instance PearShaped9 a a2 a3 a4 a5 a6 a7 a8 a9 a10 => PearShaped10 (a1, a) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, a) = (a1, pare9 a)
instance PearShaped10 (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, (a2, (a3, (a4, (a5, (a6, (a7, (a8, (a9, a10))))))))) = (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)

instance PearShaped10 [a] a a a a a a a a a a where
  reap10 p = (car p, reap9 (cdr p))
  pare10 (a1, a) = a1 : pare9 a

repair10 = reap10 <&> pare10