module Data.Tuple.Gen(all2s, all3s, all4s, all5s, all6s, all7s, all8s, all9s, all10s,
   all2sFrom, all3sFrom, all4sFrom, all5sFrom, all6sFrom, all7sFrom, all8sFrom, all9sFrom, all10sFrom,
   T2,T3,T4,T5,T6,T7,T8,T9,T10)
where

-- | generate all 2-tuples so that the sum of all digits is monotonic increasing
all2s :: Num a => [(a,a)]
all2s = (0,0) : (all2sFrom (1,0))

-- | generate all 3-tuples so that the sum of all digits is monotonic increasing
all3s :: Num a => [(a,a,a)]
all3s = (0,0,0) : (all3sFrom (1,0,0)) 

-- | generate all 4-tuples so that the sum of all digits is monotonic increasing
all4s :: Num a => [(a,a,a,a)]
all4s = (0,0,0,0) : (all4sFrom (1,0,0,0))

-- | generate all 5-tuples so that the sum of all digits is monotonic increasing
all5s :: Num a => [(a,a,a,a,a)]
all5s = (0,0,0,0,0) : (all5sFrom (1,0,0,0,0))

-- | generate all 6-tuples so that the sum of all digits is monotonic increasing
all6s :: Num a => [(a,a,a,a,a,a)]
all6s = (0,0,0,0,0,0) : (all6sFrom (1,0,0,0,0,0))

-- | generate all 7-tuples so that the sum of all digits is monotonic increasing
all7s :: Num a => [(a,a,a,a,a,a,a)]
all7s = (0,0,0,0,0,0,0) : (all7sFrom (1,0,0,0,0,0,0))

-- | generate all 8-tuples so that the sum of all digits is monotonic increasing
all8s :: Num a => [(a,a,a,a,a,a,a,a)]
all8s = (0,0,0,0,0,0,0,0) : (all8sFrom (1,0,0,0,0,0,0,0))

-- | generate all 9-tuples so that the sum of all digits is monotonic increasing
all9s :: Num a => [(a,a,a,a,a,a,a,a,a)]
all9s = (0,0,0,0,0,0,0,0,0) : (all9sFrom (1,0,0,0,0,0,0,0,0))

-- | generate all 10-tuples so that the sum of all digits is monotonic increasing
all10s :: Num a => [(a,a,a,a,a,a,a,a,a,a)]
all10s = (0,0,0,0,0,0,0,0,0,0) : (all10sFrom (1,0,0,0,0,0,0,0,0,0))


all2sFrom :: Num a => (a,a) -> [(a,a)]
all2sFrom start = s_A [start]
 where
  s_A ((a,b):is)  = (a,b) : (s_B ((a-1,b+1):is))
  s_B ((0,b):is)  = (0,b) : (s_A ((b+1, 0 ):is))
  s_B ((a,b):is)  = (a,b) : (s_B ((a-1,b+1):is))

all3sFrom :: Num a => (a,a,a) -> [(a,a,a)]
all3sFrom start = s_A [start]
 where
  s_A ((a,b,c):is)  = (a,b,c) : (s_B ((a-1,b+1,c):is))
  s_B ((a,b,c):is)  = (a,b,c) : (s_C ((a,b-1,c+1):is))
  s_C ((0,0,c):is)  = (0,0,c) : (s_A ((c+1, 0 ,0):is))
  s_C ((a,0,c):is)  = (a,0,c) : (s_B ((a-1,c+1,0):is))
  s_C ((a,b,c):is)  = (a,b,c) : (s_C ((a,b-1,c+1):is))

all4sFrom :: Num a => (a,a,a,a) -> [(a,a,a,a)]
all4sFrom start = s_A [start]
 where
  s_A ((a,b,c,d):is)  = (a,b,c,d) : (s_B ((a-1,b+1,c,d):is))
  s_B ((a,b,c,d):is)  = (a,b,c,d) : (s_C ((a,b-1,c+1,d):is))
  s_C ((a,b,c,d):is)  = (a,b,c,d) : (s_D ((a,b,c-1,d+1):is))
  s_D ((0,0,0,d):is)  = (0,0,0,d) : (s_A ((d+1, 0 ,0,0):is))
  s_D ((a,0,0,d):is)  = (a,0,0,d) : (s_B ((a-1,d+1,0,0):is))
  s_D ((a,b,0,d):is)  = (a,b,0,d) : (s_C ((a,b-1,d+1,0):is))
  s_D ((a,b,c,d):is)  = (a,b,c,d) : (s_D ((a,b,c-1,d+1):is))

all5sFrom :: Num a => (a,a,a,a,a) -> [(a,a,a,a,a)]
all5sFrom start = s_A [start]
 where
  s_A ((a,b,c,d,e):is)  = (a,b,c,d,e) : (s_B ((a-1,b+1,c,d,e):is))
  s_B ((a,b,c,d,e):is)  = (a,b,c,d,e) : (s_C ((a,b-1,c+1,d,e):is))
  s_C ((a,b,c,d,e):is)  = (a,b,c,d,e) : (s_D ((a,b,c-1,d+1,e):is))
  s_D ((a,b,c,d,e):is)  = (a,b,c,d,e) : (s_E ((a,b,c,d-1,e+1):is))
  s_E ((0,0,0,0,e):is)  = (0,0,0,0,e) : (s_A ((e+1, 0 ,0,0,0):is))
  s_E ((a,0,0,0,e):is)  = (a,0,0,0,e) : (s_B ((a-1,e+1,0,0,0):is))
  s_E ((a,b,0,0,e):is)  = (a,b,0,0,e) : (s_C ((a,b-1,e+1,0,0):is))
  s_E ((a,b,c,0,e):is)  = (a,b,c,0,e) : (s_D ((a,b,c-1,e+1,0):is))
  s_E ((a,b,c,d,e):is)  = (a,b,c,d,e) : (s_E ((a,b,c,d-1,e+1):is))

all6sFrom :: Num a => (a,a,a,a,a,a) -> [(a,a,a,a,a,a)]
all6sFrom start = s_A [start]
 where
  s_A ((a,b,c,d,e,f):is)  = (a,b,c,d,e,f) : (s_B ((a-1,b+1,c,d,e,f):is))
  s_B ((a,b,c,d,e,f):is)  = (a,b,c,d,e,f) : (s_C ((a,b-1,c+1,d,e,f):is))
  s_C ((a,b,c,d,e,f):is)  = (a,b,c,d,e,f) : (s_D ((a,b,c-1,d+1,e,f):is))
  s_D ((a,b,c,d,e,f):is)  = (a,b,c,d,e,f) : (s_E ((a,b,c,d-1,e+1,f):is))
  s_E ((a,b,c,d,e,f):is)  = (a,b,c,d,e,f) : (s_F ((a,b,c,d,e-1,f+1):is))
  s_F ((0,0,0,0,0,f):is)  = (0,0,0,0,0,f) : (s_A ((f+1, 0 ,0,0,0,0):is))
  s_F ((a,0,0,0,0,f):is)  = (a,0,0,0,0,f) : (s_B ((a-1,f+1,0,0,0,0):is))
  s_F ((a,b,0,0,0,f):is)  = (a,b,0,0,0,f) : (s_C ((a,b-1,f+1,0,0,0):is))
  s_F ((a,b,c,0,0,f):is)  = (a,b,c,0,0,f) : (s_D ((a,b,c-1,f+1,0,0):is))
  s_F ((a,b,c,d,0,f):is)  = (a,b,c,d,0,f) : (s_E ((a,b,c,d-1,f+1,0):is))
  s_F ((a,b,c,d,e,f):is)  = (a,b,c,d,e,f) : (s_F ((a,b,c,d,e-1,f+1):is))

all7sFrom :: Num a => (a,a,a,a,a,a,a) -> [(a,a,a,a,a,a,a)]
all7sFrom start = s_A [start]
 where
  s_A ((a,b,c,d,e,f,g):is)  = (a,b,c,d,e,f,g) : (s_B ((a-1,b+1,c,d,e,f,g):is))
  s_B ((a,b,c,d,e,f,g):is)  = (a,b,c,d,e,f,g) : (s_C ((a,b-1,c+1,d,e,f,g):is))
  s_C ((a,b,c,d,e,f,g):is)  = (a,b,c,d,e,f,g) : (s_D ((a,b,c-1,d+1,e,f,g):is))
  s_D ((a,b,c,d,e,f,g):is)  = (a,b,c,d,e,f,g) : (s_E ((a,b,c,d-1,e+1,f,g):is))
  s_E ((a,b,c,d,e,f,g):is)  = (a,b,c,d,e,f,g) : (s_F ((a,b,c,d,e-1,f+1,g):is))
  s_F ((a,b,c,d,e,f,g):is)  = (a,b,c,d,e,f,g) : (s_G ((a,b,c,d,e,f-1,g+1):is))
  s_G ((0,0,0,0,0,0,g):is)  = (0,0,0,0,0,0,g) : (s_A ((g+1, 0 ,0,0,0,0,0):is))
  s_G ((a,0,0,0,0,0,g):is)  = (a,0,0,0,0,0,g) : (s_B ((a-1,g+1,0,0,0,0,0):is))
  s_G ((a,b,0,0,0,0,g):is)  = (a,b,0,0,0,0,g) : (s_C ((a,b-1,g+1,0,0,0,0):is))
  s_G ((a,b,c,0,0,0,g):is)  = (a,b,c,0,0,0,g) : (s_D ((a,b,c-1,g+1,0,0,0):is))
  s_G ((a,b,c,d,0,0,g):is)  = (a,b,c,d,0,0,g) : (s_E ((a,b,c,d-1,g+1,0,0):is))
  s_G ((a,b,c,d,e,0,g):is)  = (a,b,c,d,e,0,g) : (s_F ((a,b,c,d,e-1,g+1,0):is))
  s_G ((a,b,c,d,e,f,g):is)  = (a,b,c,d,e,f,g) : (s_G ((a,b,c,d,e,f-1,g+1):is))

all8sFrom :: Num a => (a,a,a,a,a,a,a,a) -> [(a,a,a,a,a,a,a,a)]
all8sFrom start = s_A [start]
 where
  s_A ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_B ((a-1,b+1,c,d,e,f,g,h):is))
  s_B ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_C ((a,b-1,c+1,d,e,f,g,h):is))
  s_C ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_D ((a,b,c-1,d+1,e,f,g,h):is))
  s_D ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_E ((a,b,c,d-1,e+1,f,g,h):is))
  s_E ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_F ((a,b,c,d,e-1,f+1,g,h):is))
  s_F ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_G ((a,b,c,d,e,f-1,g+1,h):is))
  s_G ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_H ((a,b,c,d,e,f,g-1,h+1):is))
  s_H ((0,0,0,0,0,0,0,h):is)  = (0,0,0,0,0,0,0,h) : (s_A ((h+1, 0 ,0,0,0,0,0,0):is))
  s_H ((a,0,0,0,0,0,0,h):is)  = (a,0,0,0,0,0,0,h) : (s_B ((a-1,h+1,0,0,0,0,0,0):is))
  s_H ((a,b,0,0,0,0,0,h):is)  = (a,b,0,0,0,0,0,h) : (s_C ((a,b-1,h+1,0,0,0,0,0):is))
  s_H ((a,b,c,0,0,0,0,h):is)  = (a,b,c,0,0,0,0,h) : (s_D ((a,b,c-1,h+1,0,0,0,0):is))
  s_H ((a,b,c,d,0,0,0,h):is)  = (a,b,c,d,0,0,0,h) : (s_E ((a,b,c,d-1,h+1,0,0,0):is))
  s_H ((a,b,c,d,e,0,0,h):is)  = (a,b,c,d,e,0,0,h) : (s_F ((a,b,c,d,e-1,h+1,0,0):is))
  s_H ((a,b,c,d,e,f,0,h):is)  = (a,b,c,d,e,f,0,h) : (s_G ((a,b,c,d,e,f-1,h+1,0):is))
  s_H ((a,b,c,d,e,f,g,h):is)  = (a,b,c,d,e,f,g,h) : (s_H ((a,b,c,d,e,f,g-1,h+1):is))

all9sFrom :: Num a => (a,a,a,a,a,a,a,a,a) -> [(a,a,a,a,a,a,a,a,a)]
all9sFrom start = s_A [start]
 where
  s_A ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_B ((a-1,b+1,c,d,e,f,g,h,i):is))
  s_B ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_C ((a,b-1,c+1,d,e,f,g,h,i):is))
  s_C ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_D ((a,b,c-1,d+1,e,f,g,h,i):is))
  s_D ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_E ((a,b,c,d-1,e+1,f,g,h,i):is))
  s_E ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_F ((a,b,c,d,e-1,f+1,g,h,i):is))
  s_F ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_G ((a,b,c,d,e,f-1,g+1,h,i):is))
  s_G ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_H ((a,b,c,d,e,f,g-1,h+1,i):is))
  s_H ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_I ((a,b,c,d,e,f,g,h-1,i+1):is))
  s_I ((0,0,0,0,0,0,0,0,i):is)  = (0,0,0,0,0,0,0,0,i) : (s_A ((i+1, 0 ,0,0,0,0,0,0,0):is))
  s_I ((a,0,0,0,0,0,0,0,i):is)  = (a,0,0,0,0,0,0,0,i) : (s_B ((a-1,i+1,0,0,0,0,0,0,0):is))
  s_I ((a,b,0,0,0,0,0,0,i):is)  = (a,b,0,0,0,0,0,0,i) : (s_C ((a,b-1,i+1,0,0,0,0,0,0):is))
  s_I ((a,b,c,0,0,0,0,0,i):is)  = (a,b,c,0,0,0,0,0,i) : (s_D ((a,b,c-1,i+1,0,0,0,0,0):is))
  s_I ((a,b,c,d,0,0,0,0,i):is)  = (a,b,c,d,0,0,0,0,i) : (s_E ((a,b,c,d-1,i+1,0,0,0,0):is))
  s_I ((a,b,c,d,e,0,0,0,i):is)  = (a,b,c,d,e,0,0,0,i) : (s_F ((a,b,c,d,e-1,i+1,0,0,0):is))
  s_I ((a,b,c,d,e,f,0,0,i):is)  = (a,b,c,d,e,f,0,0,i) : (s_G ((a,b,c,d,e,f-1,i+1,0,0):is))
  s_I ((a,b,c,d,e,f,g,0,i):is)  = (a,b,c,d,e,f,g,0,i) : (s_H ((a,b,c,d,e,f,g-1,i+1,0):is))
  s_I ((a,b,c,d,e,f,g,h,i):is)  = (a,b,c,d,e,f,g,h,i) : (s_I ((a,b,c,d,e,f,g,h-1,i+1):is))

all10sFrom :: Num a => (a,a,a,a,a,a,a,a,a,a) -> [(a,a,a,a,a,a,a,a,a,a)]
all10sFrom start = s_A [start]
 where
  s_A ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_B ((a-1,b+1,c,d,e,f,g,h,i,j):is))
  s_B ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_C ((a,b-1,c+1,d,e,f,g,h,i,j):is))
  s_C ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_D ((a,b,c-1,d+1,e,f,g,h,i,j):is))
  s_D ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_E ((a,b,c,d-1,e+1,f,g,h,i,j):is))
  s_E ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_F ((a,b,c,d,e-1,f+1,g,h,i,j):is))
  s_F ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_G ((a,b,c,d,e,f-1,g+1,h,i,j):is))
  s_G ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_H ((a,b,c,d,e,f,g-1,h+1,i,j):is))
  s_H ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_I ((a,b,c,d,e,f,g,h-1,i+1,j):is))
  s_I ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_J ((a,b,c,d,e,f,g,h,i-1,j+1):is))
  s_J ((0,0,0,0,0,0,0,0,0,j):is)  = (0,0,0,0,0,0,0,0,0,j) : (s_A ((j+1, 0 ,0,0,0,0,0,0,0,0):is))
  s_J ((a,0,0,0,0,0,0,0,0,j):is)  = (a,0,0,0,0,0,0,0,0,j) : (s_B ((a-1,j+1,0,0,0,0,0,0,0,0):is))
  s_J ((a,b,0,0,0,0,0,0,0,j):is)  = (a,b,0,0,0,0,0,0,0,j) : (s_C ((a,b-1,j+1,0,0,0,0,0,0,0):is))
  s_J ((a,b,c,0,0,0,0,0,0,j):is)  = (a,b,c,0,0,0,0,0,0,j) : (s_D ((a,b,c-1,j+1,0,0,0,0,0,0):is))
  s_J ((a,b,c,d,0,0,0,0,0,j):is)  = (a,b,c,d,0,0,0,0,0,j) : (s_E ((a,b,c,d-1,j+1,0,0,0,0,0):is))
  s_J ((a,b,c,d,e,0,0,0,0,j):is)  = (a,b,c,d,e,0,0,0,0,j) : (s_F ((a,b,c,d,e-1,j+1,0,0,0,0):is))
  s_J ((a,b,c,d,e,f,0,0,0,j):is)  = (a,b,c,d,e,f,0,0,0,j) : (s_G ((a,b,c,d,e,f-1,j+1,0,0,0):is))
  s_J ((a,b,c,d,e,f,g,0,0,j):is)  = (a,b,c,d,e,f,g,0,0,j) : (s_H ((a,b,c,d,e,f,g-1,j+1,0,0):is))
  s_J ((a,b,c,d,e,f,g,h,0,j):is)  = (a,b,c,d,e,f,g,h,0,j) : (s_I ((a,b,c,d,e,f,g,h-1,j+1,0):is))
  s_J ((a,b,c,d,e,f,g,h,i,j):is)  = (a,b,c,d,e,f,g,h,i,j) : (s_J ((a,b,c,d,e,f,g,h,i-1,j+1):is))

-- data structures for Eq and Ord instances
-- to make the upper enumeration into an ordering

data T2 a = T2 (a,a) deriving Show
data T3 a = T3 (a,a,a) deriving Show
data T4 a = T4 (a,a,a,a) deriving Show
data T5 a = T5 (a,a,a,a,a) deriving Show
data T6 a = T6 (a,a,a,a,a,a) deriving Show
data T7 a = T7 (a,a,a,a,a,a,a) deriving Show 
data T8 a = T8 (a,a,a,a,a,a,a,a) deriving Show
data T9 a = T9 (a,a,a,a,a,a,a,a,a) deriving Show
data T10 a = T10 (a,a,a,a,a,a,a,a,a,a) deriving Show

instance Eq a => Eq (T2 a) where
  (T2 (x0,x1)) == (T2 (y0,y1)) = x0==y0 && x1==y1

instance Eq a => Eq (T3 a) where
  (T3 (x0,x1,x2)) == (T3 (y0,y1,y2)) = x0==y0 && x1==y1 && x2==y2

instance Eq a => Eq (T4 a) where
  (T4 (x0,x1,x2,x3)) == (T4 (y0,y1,y2,y3)) = x0==y0 && x1==y1 && x2==y2 && x3==y3

instance Eq a => Eq (T5 a) where
  (T5 (x0,x1,x2,x3,x4)) == (T5 (y0,y1,y2,y3,y4)) = x0==y0 && x1==y1 && x2==y2 && x3==y3 && x4==y4

instance Eq a => Eq (T6 a) where
  (T6 (x0,x1,x2,x3,x4,x5)) == (T6 (y0,y1,y2,y3,y4,y5)) = x0==y0 && x1==y1 && x2==y2 && x3==y3 && x4==y4 && x5==y5

instance Eq a => Eq (T7 a) where
  (T7 (x0,x1,x2,x3,x4,x5,x6)) == (T7 (y0,y1,y2,y3,y4,y5,y6)) = x0==y0 && x1==y1 && x2==y2 && x3==y3 && x4==y4 && x5==y5 && x6==y6

instance Eq a => Eq (T8 a) where
  (T8 (x0,x1,x2,x3,x4,x5,x6,x7)) == (T8 (y0,y1,y2,y3,y4,y5,y6,y7)) = x0==y0 && x1==y1 && x2==y2 && x3==y3 && x4==y4 && x5==y5 && x6==y6 && x7==y7

instance Eq a => Eq (T9 a) where
  (T9 (x0,x1,x2,x3,x4,x5,x6,x7,x8)) == (T9 (y0,y1,y2,y3,y4,y5,y6,y7,y8)) = x0==y0 && x1==y1 && x2==y2 && x3==y3 && x4==y4 && x5==y5 && x6==y6 && x7==y7 && x8==y8

instance Eq a => Eq (T10 a) where
  (T10 (x0,x1,x2,x3,x4,x5,x6,x7,x8,x9)) == (T10 (y0,y1,y2,y3,y4,y5,y6,y7,y8,y9)) = x0==y0 && x1==y1 && x2==y2 && x3==y3 && x4==y4 && x5==y5 && x6==y6 && x7==y7 && x8==y8 && x9==y9


instance (Eq a,Ord a,Num a) => Ord (T2 a) where
  (T2 (x0,x1)) <= (T2 (y0,y1)) = (x0+x1) <= (y0+y1) && (x0 > y0 ||
                                             (x0 == y0 && x1 > y1)) 

instance (Eq a,Ord a,Num a) => Ord (T3 a) where
  (T3 (x0,x1,x2)) <= (T3 (y0,y1,y2)) = (x0+x1+x2) <= (y0+y1+y2) &&
                                   (x0 > y0 ||
                                   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2))

instance (Eq a,Ord a,Num a) => Ord (T4 a) where
  (T4 (x0,x1,x2,x3)) <= (T4 (y0,y1,y2,y3)) = (x0+x1+x2+x3) <= (y0+y1+y2+y3) &&
                                   (x0 > y0 ||
								   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 > y3))

instance (Eq a,Ord a,Num a) => Ord (T5 a) where
  (T5 (x0,x1,x2,x3,x4)) <= (T5 (y0,y1,y2,y3,y4)) = (x0+x1+x2+x3+x4) <= (y0+y1+y2+y3+y4) &&
                                   (x0 > y0 ||
                                   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 > y3) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 > y4))

instance (Eq a,Ord a,Num a) => Ord (T6 a) where
  (T6 (x0,x1,x2,x3,x4,x5)) <= (T6 (y0,y1,y2,y3,y4,y5)) = (x0+x1+x2+x3+x4+x5) <= (y0+y1+y2+y3+y4+y5) &&
                                   (x0 > y0 ||
                                   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 > y3) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 > y4) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 > y5))

instance (Eq a,Ord a,Num a) => Ord (T7 a) where
  (T7 (x0,x1,x2,x3,x4,x5,x6)) <= (T7 (y0,y1,y2,y3,y4,y5,y6)) = (x0+x1+x2+x3+x4+x5+x6) <= (y0+y1+y2+y3+y4+y5+y6) &&
                                   (x0 > y0 ||
                                   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 > y3) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 > y4) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 > y5) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 > y6))

instance (Eq a,Ord a,Num a) => Ord (T8 a) where
  (T8 (x0,x1,x2,x3,x4,x5,x6,x7)) <= (T8 (y0,y1,y2,y3,y4,y5,y6,y7)) = (x0+x1+x2+x3+x4+x5+x6+x7) <= (y0+y1+y2+y3+y4+y5+y6+y7) &&
                                   (x0 > y0 ||
                                   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 > y3) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 > y4) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 > y5) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 > y6) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 == y6 && x7 > y7))

instance (Eq a,Ord a,Num a) => Ord (T9 a) where
  (T9 (x0,x1,x2,x3,x4,x5,x6,x7,x8)) <= (T9 (y0,y1,y2,y3,y4,y5,y6,y7,y8)) = (x0+x1+x2+x3+x4+x5+x6+x7+x8) <= (y0+y1+y2+y3+y4+y5+y6+y7+y8) &&
                                   (x0 > y0 ||
                                   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 > y3) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 > y4) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 > y5) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 > y6) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 == y6 && x7 > y7) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 == y6 && x7 == y7 && x8 > y8))

instance (Eq a,Ord a,Num a) => Ord (T10 a) where
  (T10 (x0,x1,x2,x3,x4,x5,x6,x7,x8,x9)) <= (T10 (y0,y1,y2,y3,y4,y5,y6,y7,y8,y9)) = (x0+x1+x2+x3+x4+x5+x6+x7+x8+x9) <= (y0+y1+y2+y3+y4+y5+y6+y7+y8+y9) &&
                                   (x0 > y0 ||
                                   (x0 == y0 && x1 > y1) ||
                                   (x0 == y0 && x1 == y1 && x2 > y2) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 > y3) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 > y4) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 > y5) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 > y6) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 == y6 && x7 > y7) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 == y6 && x7 == y7 && x8 > y8) ||
                                   (x0 == y0 && x1 == y1 && x2 == y2 && x3 == y3 && x4 == y4 && x5 == y5 && x6 == y6 && x7 == y7 && x8 == y8 && x9 > y9))