-- Copyright (c) 2014 Eric McCorkle.  All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions
-- are met:
--
-- 1. Redistributions of source code must retain the above copyright
--    notice, this list of conditions and the following disclaimer.
--
-- 2. Redistributions in binary form must reproduce the above copyright
--    notice, this list of conditions and the following disclaimer in the
--    documentation and/or other materials provided with the distribution.
--
-- 3. Neither the name of the author nor the names of any contributors
--    may be used to endorse or promote products derived from this software
--    without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS''
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-- PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS
-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
-- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
-- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-- SUCH DAMAGE.
{-# OPTIONS_GHC -Wall -funbox-strict-fields #-}
{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}

-- | Definition of 'Encoding', and a set of fundamental 'Encoding's
-- and constructions.
--
-- This module contains the basic definitions for 'Encoding's.  It
-- defines the 'Encoding' type, the functions for creating an
-- 'Encoding', and a set of stock constructions.
--
-- The 'Encoding' type is encapsulated; the functions 'mkEncoding'
-- (and the variants thereof) are used to synthetically construct an
-- encoding from the fundamental operations.
--
-- The 'IllegalArgument' exception datatype, as well as the
-- fundamental operations are also defined here.
--
-- In addition to this, a set of basic definitions and constructions
-- are provided.  These definitions should be suitable for defining
-- 'Encoding's for most algebraic datatypes without having to manually
-- write encode/decode implementations.
module Data.ArithEncode.Basic(
       -- * Basic Definitions

       -- ** Constructors
       Encoding,
       mkEncoding,
       mkInfEncoding,

       -- ** Using Encodings
       IllegalArgument(..),
       encode,
       decode,
       size,
       inDomain,

       -- * Building Encodings

       -- ** Basic Encodings
       identity,
       singleton,
       integral,
       interval,
       fromHashableList,
       fromOrdList,

       -- ** Constructions

       -- *** Wrapping
       wrap,

       -- *** Optional
       optional,
       mandatory,

       -- *** Exclusion
       nonzero,
       exclude,

       -- *** Unions
       either,
       union,

       -- *** Products and Powers
       pair,
       triple,
       quad,
       quint,
       sextet,
       septet,
       octet,
       nonet,
       dectet,
       power,

       -- *** Sets
       set,
       hashSet,
--       exactSet,
--       boundedSet,

       -- *** Sequences
       seq,
       boundedSeq,

       -- *** Recursive
       recursive,
       recursive2,
       recursive3,
       recursive4,
       recursive5,
       recursive6,
       recursive7,
       recursive8,
       recursive9,
       recursive10
       ) where

import Control.Exception
import Control.Monad
import Data.Array.IArray(Array)
import Data.Bits
import Data.Hashable
import Data.List hiding (elem, union)
import Data.Maybe
import Data.Set(Set)
import Data.HashSet(HashSet)
import Data.Typeable
import Prelude hiding (elem, either, seq)
import Math.NumberTheory.Powers.Squares
import Math.NumberTheory.Logarithms
import Data.Word
--import Debug.Trace

import qualified Data.Array.IArray as Array
import qualified Data.Either as Either
import qualified Data.HashMap.Lazy as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.Map as Map
import qualified Data.Set as Set

-- | An exception to be thrown if an illegal argument is given to
-- 'encode', 'decode'.
data IllegalArgument = IllegalArgument !String
  deriving Typeable

instance Show IllegalArgument where
  show (IllegalArgument "") = "Illegal argument"
  show (IllegalArgument s) = "Illegal argument: " ++ s

instance Exception IllegalArgument

-- | Type for an encoding.  The structure of this type is deliberately
-- hidden from users.  Use the 'mkEncoding' functions to construct
-- 'Encoding's, and the seven functions to use them.
data Encoding ty =
  Encoding {
    -- | Encode a @ty@ as a positive integer.
    encEncode :: ty -> Integer,
    -- | Decode a positive integer into a @ty@.
    encDecode :: Integer -> ty,
    -- | The size of an encoding, or 'Nothing' if it is infinite.
    encSize :: !(Maybe Integer),
    -- | Indicate whether or not a value is in the domain of the encoding.
    encInDomain :: ty -> Bool
  }

-- | Create an encoding from all the necessary components.
mkEncoding :: (ty -> Integer)
           -- ^ The encoding function.
           -> (Integer -> ty)
           -- ^ The decoding function.  Can assume all inputs are positive.
           -> Maybe Integer
           -- ^ The number of mappings, or 'Nothing' if it is infinite.
           -> (ty -> Bool)
           -- ^ A function indicating whether or not a given value is
           -- in the domain of values.
           -> Encoding ty
mkEncoding encodefunc decodefunc sizeval indomain =
  Encoding { encEncode = encodefunc, encDecode = decodefunc,
             encSize = sizeval, encInDomain = indomain }

-- | Create an infinite-sized encoding.  This variant does not need a
-- size.
mkInfEncoding :: (ty -> Integer)
              -- ^ The encoding function.
              -> (Integer -> ty)
              -- ^ The decoding function.  Can assume all inputs are positive.
              -> (ty -> Bool)
              -- ^ A function indicating whether or not a given value is
              -- in the domain of values.
              -> Encoding ty
mkInfEncoding encodefunc decodefunc indomain =
  mkEncoding encodefunc decodefunc Nothing indomain

-- | Encode a @ty@ as a positive 'Integer' (ie. a natural number).
--
-- If the given @ty@ is not in the domain of the 'Encoding' (meaning,
-- 'inDomain' returns 'False'), the underlying implementation /may/
-- throw 'IllegalArgument'.  However, this is not /strictly/ required;
-- therefore, do not rely on 'IllegalArgument' being thrown.
encode :: Encoding ty
       -- ^ Encoding to use.
       -> ty
       -- ^ Value to encode.
       -> Integer
       -- ^ Encoded value.
encode encoding = encEncode encoding

-- | Decode a @ty@ from a positive 'Integer' (ie. a natural number).
--
-- If the given 'Integer' is out of bounds (ie. it is bigger than
-- 'size'), the underlying implementation /may/ throw
-- 'IllegalArgument'.  However, this not /strictly/ required;
-- therefore, do not rely on 'IllegalArgument' being thrown.
decode :: Encoding ty
       -- ^ Encoding to use.
       -> Integer
       -- ^ Number to decode.
       -> ty
       -- ^ Decoded value.
decode encoding num
  | num < 0 =
    throw (IllegalArgument ("decode argument " ++ show num ++ " is negative"))
  | maybe False (<= num) (size encoding) =
    throw (IllegalArgument ("decode argument " ++ show num ++
                            " is out of bounds"))
  | otherwise = (encDecode encoding) num

-- | Get the size of an 'Encoding', or 'Nothing' if it is infinite.
size :: Encoding ty
     -- ^ Encoding to use.
     -> Maybe Integer
     -- ^ Number of values mapped, or 'Nothing' for infinity.
size = encSize

-- | Indicate whether or not a value is in the domain of the encoding.
inDomain :: Encoding ty
         -- ^ Encoding to use.
         -> ty
         -- ^ Value to query.
         -> Bool
         -- ^ Whether or not the value is in the domain of the encoding.
inDomain encoding = encInDomain encoding

-- | The identity encoding.  Maps every positive 'Integer' to itself.
--
-- Note: only positive integers are in the domain of this encoding.
-- For all an encoding whose domain is all integers, use 'integral'.
identity :: Encoding Integer
identity = mkInfEncoding id id (>= 0)

-- | A singleton encoding.  Maps a singular value to 0.
singleton :: Eq ty => ty -> Encoding ty
singleton val = mkEncoding (const 0) (const val) (Just 1) (val ==)

-- | An encoding of /all/ integers.
--
-- Note: this is /not/ an identity mapping.
integral :: Integral n => Encoding n
integral =
  let
    encodefunc num
      | num < 0 = ((abs (toInteger num) - 1) `shiftL` 1) `setBit` 0
      | otherwise = (toInteger num) `shiftL` 1

    decodefunc num
      | num `testBit` 0 = fromInteger (-((num `shiftR` 1) + 1))
      | otherwise = fromInteger (num `shiftR` 1)
  in
    mkInfEncoding encodefunc decodefunc (const True)

-- | Build an encoding from a finite range of 'Integral's.
--
-- Both the upper and lower bounds are inclusive.  This allows an
-- 'Encoding' to be created for bounded integer datatypes, such as
-- 'Int8'.
interval :: Integral n
         => n
         -- ^ The (inclusive) lower bound on the range.
         -> n
         -- ^ The (inclusive) upper bound on the range.
         -> Encoding n
interval lower upper
  | lower <= upper =
    let
      biglower = toInteger lower
      encodefunc num = (toInteger num) - biglower
      decodefunc num = fromInteger (num + biglower)
      sizeval = Just ((toInteger upper) - (toInteger lower) + 1)
      indomainfunc val = lower <= val && val <= upper
    in
       mkEncoding encodefunc decodefunc sizeval indomainfunc
  | otherwise = error "Lower bound is not less than upper bound"

-- | Build an encoding from a list of items with a 'Hashable' instance.
fromHashableList :: forall ty. (Hashable ty, Ord ty)
                 => [ty]
                 -- ^ A list of items to encode.
                 -> Encoding ty
                 -- ^ An encoding mapping the items in the list to
                 -- natural numbers.
fromHashableList elems =
  let
    len = fromIntegral (length elems)

    revmap :: Array Data.Word.Word ty
    revmap = Array.listArray (0, len) elems

    fwdmap = HashMap.fromList (zip elems [0..len])
    encodefunc = toInteger . (HashMap.!) fwdmap
    decodefunc = (Array.!) revmap . fromInteger
    sizeval = Just (toInteger len)
    indomainfunc = (flip HashMap.member) fwdmap
  in
    mkEncoding encodefunc decodefunc sizeval indomainfunc

-- | Build an encoding from a list of items with an 'Ord' instance.
fromOrdList :: forall ty . Ord ty
            => [ty]
            -- ^ A list of items to encode.
            -> Encoding ty
            -- ^ An encoding mapping the items in the list to natural
            -- numbers.
fromOrdList elems =
  let
    len = fromIntegral (length elems)

    revmap :: Array Word ty
    revmap = Array.listArray (0, len) elems

    fwdmap = Map.fromList (zip elems [0..len])
    encodefunc = toInteger . (Map.!) fwdmap
    decodefunc = (Array.!) revmap . fromInteger
    sizeval = Just (toInteger len)
    indomainfunc = (flip Map.member) fwdmap
  in
    mkEncoding encodefunc decodefunc sizeval indomainfunc

-- | Wrap an encoding using a pair of functions.  These functions must
-- also define an isomorphism.
wrap :: (a -> Maybe b)
     -- ^ The forward encoding function.
     -> (b -> Maybe a)
     -- ^ The reverse encoding function.
     -> Encoding b
     -- ^ The inner encoding.
     -> Encoding a
wrap fwd rev enc @ Encoding { encEncode = encodefunc, encDecode = decodefunc,
                              encInDomain = indomainfunc } =
  let
    safefwd val =
      case fwd val of
        Just val' -> val'
        Nothing -> throw (IllegalArgument "No mapping into underlying domain")

    saferev val =
      case rev val of
        Just val' -> val'
        Nothing -> throw (IllegalArgument "No mapping into external domain")
  in
    enc { encEncode = encodefunc . safefwd,
          encDecode = saferev . decodefunc,
          encInDomain = maybe False indomainfunc . fwd }

-- | Generate an encoding for @Maybe ty@ from an inner encoding for
-- @ty@.
optional :: Encoding ty -> Encoding (Maybe ty)
optional Encoding { encEncode = encodefunc, encDecode = decodefunc,
                    encSize = sizeval, encInDomain = indomainfunc } =
  let
    newsize = sizeval >>= return . (+ 1)
    newindomain = maybe True indomainfunc

    newencode Nothing = 0
    newencode (Just val) = 1 + encodefunc val

    newdecode 0 = Nothing
    newdecode num = Just (decodefunc (num - 1))
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = newsize, encInDomain = newindomain }

-- | The dual of @optional@.  This construction assumes that @Nothing@
-- maps to @0@, and removes it from the input domain.
--
-- Using this construction on encodings for @Maybe ty@ which are not
-- produced by @optional@ may have unexpected results.
mandatory :: Encoding (Maybe ty) -> Encoding ty
mandatory Encoding { encEncode = encodefunc, encDecode = decodefunc,
                     encSize = sizeval, encInDomain = indomainfunc } =
  let
    dec n = n - 1
    newencode = dec . encodefunc . Just
    newdecode = fromJust . decodefunc . (+ 1)
    newsize = sizeval >>= return . dec
    newindomain = indomainfunc . Just
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = newsize, encInDomain = newindomain }

-- | Removes the mapping to @0@ (ie. the first mapping).  This has the
-- same effect as @exclude [x]@, where @x@ is the value that maps to
-- @0@.  It is also similar to @mandatory@, except that it does not
-- change the base type.
nonzero :: Encoding ty -> Encoding ty
nonzero enc @ Encoding { encEncode = encodefunc, encDecode = decodefunc,
                         encSize = sizeval, encInDomain = indomainfunc } =
  let
    dec n = n - 1
    newencode = dec . encodefunc
    newdecode = decodefunc . (+ 1)
    newsize = sizeval >>= return . dec
    newindomain val = indomainfunc val && 0 /= encodefunc val
  in
    enc { encEncode = newencode, encDecode = newdecode,
          encSize = newsize, encInDomain = newindomain }

-- | A simple binary tree structure, for use with exclude.
data BinTree key val =
    Branch key val (BinTree key val) (BinTree key val)
  | Nil
    deriving Show

-- | Find the tree node with the highest index less than the given key
-- and return its data.
closestBelow :: Ord key => key -> BinTree key val -> Maybe (key, val)
closestBelow target =
  let
    closestBelow' out Nil = out
    closestBelow' out (Branch k v left right) =
      case compare k target of
        LT -> closestBelow' (Just (k, v)) right
        _ -> closestBelow' out left
  in
    closestBelow' Nothing

-- | Simple binary tree lookup, for use with exclude.
closestWithin :: Ord key => key -> BinTree key val -> Maybe (key, val)
closestWithin target =
  let
    closestWithin' out Nil = out
    closestWithin' out (Branch k v left right) =
      case compare k target of
        GT -> closestWithin' out left
        _ -> closestWithin' (Just (k, v)) right
  in
    closestWithin' Nothing

-- | Convert a list to a binary tree, for use with excludes.
toBinTree :: [(key, val)] -> BinTree key val
toBinTree vals =
  let
    toBinTree' 0 [] = Nil
    toBinTree' 0 _ = error "Zero size with non-empty list"
    toBinTree' _ [] = error "Empty list with non-zero size"
    toBinTree' len vals' =
      let
        halflo = len `shiftR` 1
        halfhi = len - halflo
        (lows, (k, v) : highs) = splitAt halflo vals'
        left = toBinTree' halflo lows
        right = toBinTree' (halfhi - 1) highs
      in
        Branch k v left right
  in
    toBinTree' (length vals) vals

-- | Removes the mapping to the items in the list.  The resulting
-- @encode@, @decode@, and @highestIndex@ are O(@length excludes@), so
-- this should only be used with a very short excludes list.
exclude :: [ty]
        -- ^ The list of items to exclude.
        -> Encoding ty
        -- ^ The base @Encoding@.
        -> Encoding ty
exclude [] enc = enc
exclude excludes enc @ Encoding { encEncode = encodefunc, encDecode = decodefunc,
                                  encSize = sizeval, encInDomain = indomainfunc } =
  let
    forbidden = HashSet.fromList (map encodefunc excludes)
    sortedlist = sort (map encodefunc excludes)

    fwdoffsets :: [(Integer, Integer)]
    (_, fwdoffsets) = mapAccumL (\offset v -> (offset + 1, (v, offset)))
                                1 sortedlist
    fwdtree = toBinTree fwdoffsets

    revoffsets :: [(Integer, Integer)]
    revoffsets =
      let
        foldfun :: [(Integer, Integer)] -> (Integer, Integer) ->
                   [(Integer, Integer)]
        foldfun accum @ ((v', _) : rest) elem @ (v, _)
          | v == v' = elem : rest
          | otherwise = elem : accum
        foldfun _ _ = error "Should not fold over an empty list"

        (first : adjusted) =
          map (\(v, offset) -> (v - (offset - 1), offset)) fwdoffsets
      in
        reverse (foldl foldfun [first] adjusted)

    revtree = toBinTree revoffsets

    toExcluded n =
      case closestBelow n fwdtree of
        Just (_, offset) -> n - offset
        Nothing -> n

    fromExcluded n =
      case closestWithin n revtree of
        Just (_, offset) -> n + offset
        Nothing -> n

    newEncode = toExcluded . encodefunc
    newDecode = decodefunc . fromExcluded

    newSize =
      do
        n <- sizeval
        return $! (n - (toInteger (length excludes)))

    newInDomain val =
      indomainfunc val && not (HashSet.member (encodefunc val) forbidden)
  in
    enc { encEncode = newEncode, encDecode = newDecode,
          encSize = newSize, encInDomain = newInDomain }

-- | Combine two encodings into a single encoding that returns an
-- @Either@ of the two types.
either :: Encoding ty1
       -- ^ The @Encoding@ that will be represented by @Left@.
       -> Encoding ty2
       -- ^ The @Encoding@ that will be represented by @Right@.
       -> Encoding (Either ty1 ty2)
either Encoding { encEncode = encode1, encDecode = decode1,
                  encInDomain = indomain1, encSize = sizeval1 }
       Encoding { encEncode = encode2, encDecode = decode2,
                  encInDomain = indomain2, encSize = sizeval2 } =
  let
    -- There are three cases here, depending on the size of the two
    -- mappings.  This does replicate code, but it also does a lot of
    -- figuring things when the encoding is created as opposed to
    -- later.
    (isLeft, leftIdxFwd, rightIdxFwd, leftIdxRev, rightIdxRev) =
      case (sizeval1, sizeval2) of
        -- Simplest case: both mappings are infinite.  Map all the
        -- evens to the left, and all the odds to the right.
        (Nothing, Nothing) ->
          (\num -> not (testBit num 0),
           \idx -> idx `shiftL` 1,
           \idx -> setBit (idx `shiftL` 1) 0,
           \idx -> idx `shiftR` 1,
           \idx -> idx `shiftR` 1)
        -- Left is smaller: do the even/odd mapping until we exhaust
        -- the left, then just map directly to the right.
        (Just size1, _) | maybe True (size1 <) sizeval2 ->
          let
            size1shifted = (size1 `shiftL` 1)
            isLeft' num = num < size1shifted && not (testBit num 0)
            leftIdxFwd' idx = idx `shiftL` 1

            rightIdxFwd' idx
              | size1 <= idx = size1shifted + (idx - size1)
              | otherwise = setBit (idx `shiftL` 1) 0

            leftIdxRev' idx = idx `shiftR` 1

            rightIdxRev' idx
              | size1shifted <= idx = size1 + (idx - size1shifted)
              | otherwise = idx `shiftR` 1
          in
            (isLeft', leftIdxFwd', rightIdxFwd', leftIdxRev', rightIdxRev')
        -- Right is smaller: do the even/odd mapping until we exhaust
        -- the right, then just map directly to the left.
        (_, Just size2) ->
          let
            size2shifted = (size2 `shiftL` 1)
            isLeft' num = num > size2shifted || not (testBit num 0)

            leftIdxFwd' idx
              | size2 <= idx = size2shifted + (idx - size2)
              | otherwise = idx `shiftL` 1

            rightIdxFwd' idx = setBit (idx `shiftL` 1) 0

            leftIdxRev' idx
              | size2shifted <= idx = size2 + (idx - size2shifted)
              | otherwise = idx `shiftR` 1

            rightIdxRev' idx = idx `shiftR` 1
          in
            (isLeft', leftIdxFwd', rightIdxFwd', leftIdxRev', rightIdxRev')
        _ -> error "This case should never happen"

    newSize =
      do
        size1 <- sizeval1
        size2 <- sizeval2
        return (size1 + size2)

    eitherIndex lfunc rfunc idx
      | isLeft idx = lfunc (leftIdxRev idx)
      | otherwise = rfunc (rightIdxRev idx)

    newEncode = Either.either (leftIdxFwd . encode1) (rightIdxFwd . encode2)
    newDecode = eitherIndex (Left . decode1) (Right . decode2)

    newInDomain = Either.either indomain1 indomain2
  in
    Encoding { encEncode = newEncode, encDecode = newDecode,
               encSize = newSize, encInDomain = newInDomain }

sortfunc :: Maybe Integer -> Maybe Integer -> Ordering
sortfunc Nothing Nothing = EQ
sortfunc Nothing _ = GT
sortfunc _ Nothing = LT
sortfunc (Just a) (Just b) = compare a b

-- | Combine a set of encodings with the result type into a single
-- encoding which represents the disjoint union of the components.
union :: forall ty.
         [Encoding ty]
      -- ^ The components of the union.
      -> Encoding ty
union [] = error "union encoding with no arguments"
union encodings =
  let
    numelems :: Int
    numelems = length encodings

    sortpair (a, _) (b, _) = sortfunc a b

    (sizes, sortedencodings) =
      unzip (sortBy sortpair (map (\enc -> (size enc, enc)) encodings))
    -- Turn the sorted element encodings into an array for fast access
    encodingarr :: Array.Array Int (Encoding ty)
    encodingarr = Array.listArray (0, numelems - 1) sortedencodings

    (fwdmapnum, revmapnum) =
      let
        -- An ordered list of the sizes of isomorphisms and how far into
        -- the array to start.
        sizeclasses =
          let
            foldfun (ind, accum) elemsize =
              case accum of
                (elemsize', _) : _ | elemsize == elemsize' ->
                  (ind + 1, accum)
                _ -> (ind + 1, (elemsize, ind) : accum)

            (_, out) = foldl foldfun (0, []) sizes
          in
            reverse out

        -- The mapping functions used to encode within a single size
        -- class.
        fwdmapbasic base width num enc =
          let
            adjustedenc = enc - (numelems - width)
          in
            ((num * toInteger width) + (toInteger adjustedenc) + base)
        revmapbasic base width num
          | (fromInteger num) < width =
            let
              adjustedenc = fromInteger num + (numelems - width)
            in
              (base, adjustedenc)
          | otherwise = ((num `quot` toInteger width) + base,
                         fromInteger (num `mod` toInteger width) +
                         (numelems - width))
      in case sizeclasses of
        -- If there is only one size class, then 
        [ _ ] -> (fwdmapbasic 0 numelems, revmapbasic 0 numelems)
        (Just firstsize, _) : rest  ->
          let
            (fwdtree, revtree) =
              let
                foldfun (lastsize, offset, fwds, revs) (Nothing, idx) =
                  let
                    thisnumencs = numelems - idx
                  in
                    (undefined, undefined,
                     (lastsize, (offset, thisnumencs)) : fwds,
                     (offset, (lastsize, thisnumencs)) : revs)
                foldfun (lastsize, offset, fwds, revs) (Just thissize, idx) =
                  let
                    thisnumencs = numelems - idx
                    sizediff = thissize - lastsize
                  in
                    (thissize, offset + (sizediff * toInteger thisnumencs),
                     (lastsize, (offset, thisnumencs)) : fwds,
                     (offset, (lastsize, thisnumencs)) : revs)

                (_, _, fwdvals, revvals) =
                  foldl foldfun
                        (firstsize, (firstsize * toInteger numelems), [], [])
                        rest
              in
                (toBinTree (reverse fwdvals), toBinTree (reverse revvals))

            fwdmap num enc =
              case closestWithin num fwdtree of
                Nothing -> fwdmapbasic 0 numelems num enc
                Just (sizeclass, (base, numencs)) ->
                  fwdmapbasic base numencs (num - sizeclass) enc

            revmap num =
              case closestWithin num revtree of
                Nothing -> revmapbasic 0 numelems num
                Just (offset, (base, numencs)) ->
                  revmapbasic base numencs (num - offset)
          in
            (fwdmap, revmap)
        _ -> error "Internal error"

    encodefunc val =
      case findIndex ((flip inDomain) val) sortedencodings of
        Just encidx ->
          let
            enc = (Array.!) encodingarr encidx
            num = encode enc val
          in
           fwdmapnum num encidx
        Nothing -> throw (IllegalArgument "Value not in domain of any component")

    decodefunc num =
      let
        (encnum, encidx) = revmapnum num
        encoding = (Array.!) encodingarr encidx
      in
        decode encoding encnum

    -- Sum up all the sizes, going to infinity if one of them in
    -- infinite
    sizeval =
      let
        foldfun accum n =
          do
            accumval <- accum
            nval <- n
            return (nval + accumval)
      in
        foldl foldfun (Just 0) sizes

    indomainfunc val = any ((flip inDomain) val) sortedencodings
  in
    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc }

isqrt :: Integer -> Integer
isqrt = integerSquareRoot'

mkPairCore :: Encoding ty1 -> Encoding ty2 ->
              ((ty1, ty2) -> Integer, Integer -> (ty1, ty2), Maybe Integer)
mkPairCore Encoding { encEncode = encode1, encDecode = decode1,
                      encSize = sizeval1 }
           Encoding { encEncode = encode2, encDecode = decode2,
                      encSize = sizeval2 } =
  let
    (convertidx, decodefunc) = case (sizeval1, sizeval2) of
      (Just maxval, _) ->
        let
          convertidx' idx1 idx2 = (idx2 * maxval) + idx1
          newdecode num = (decode1 (num `mod` maxval), decode2 (num `quot` maxval))
        in
          (convertidx', newdecode)
      (_, Just maxval) ->
        let
          convertidx' idx1 idx2 = (idx1 * maxval) + idx2
          newdecode num = (decode1 (num `quot` maxval), decode2 (num `mod` maxval))
        in
          (convertidx', newdecode)
      (Nothing, Nothing) ->
        let
          convertidx' idx1 idx2 =
            let
              sumval = idx1 + idx2
              base = (((sumval + 1) * sumval)) `quot` 2
            in
              base + idx2

          newdecode num =
            let
              sumval = (isqrt ((8 * num) + 1) - 1) `quot` 2
              base = (((sumval + 1) * sumval)) `quot` 2
              num2 = num - base
              num1 = sumval - num2
            in
              (decode1 num1, decode2 num2)
        in
          (convertidx', newdecode)

    encodefunc (val1, val2) = convertidx (encode1 val1) (encode2 val2)

    sizeval =
      do
        size1 <- sizeval1
        size2 <- sizeval2
        return (size1 * size2)
  in
    (encodefunc, decodefunc, sizeval)

-- | Take encodings for two datatypes A and B, and build an encoding
-- for a pair (A, B).
pair :: Encoding ty1 -> Encoding ty2 -> Encoding (ty1, ty2)
pair enc1 @ Encoding { encInDomain = indomain1 }
     enc2 @ Encoding { encInDomain = indomain2 } =
  let
    (encodefunc, decodefunc, sizeval) = mkPairCore enc1 enc2

    indomainfunc (val1, val2) = indomain1 val1 && indomain2 val2
  in
    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc }


-- | Construct an encoding for a 3-tuple from the encodings for the
-- three components.  This is actually just a wrapper around @pair@.
triple :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 ->
          Encoding (ty1, ty2, ty3)
triple enc1 enc2 enc3 =
  let
    fwdshuffle (val1, val2, val3) = ((val1, val2), val3)
    revshuffle ((val1, val2), val3) = (val1, val2, val3)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair enc1 enc2) enc3

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }

-- | Construct an encoding for a 4-tuple from the encodings for the
-- four components.  This is actually just a wrapper around @pair@.
quad :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 -> Encoding ty4 ->
        Encoding (ty1, ty2, ty3, ty4)
quad enc1 enc2 enc3 enc4 =
  let
    fwdshuffle (val1, val2, val3, val4) = ((val1, val2), (val3, val4))
    revshuffle ((val1, val2), (val3, val4)) = (val1, val2, val3, val4)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair enc1 enc2) (pair enc3 enc4)

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }


-- | Construct an encoding for a 5-tuple from the encodings for the
-- five components.  This is actually just a wrapper around @pair@.
quint :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 ->
         Encoding ty4 -> Encoding ty5 ->
         Encoding (ty1, ty2, ty3, ty4, ty5)
quint enc1 enc2 enc3 enc4 enc5 =
  let
    fwdshuffle (val1, val2, val3, val4, val5) = (((val1, val2), val3), (val4, val5))
    revshuffle (((val1, val2), val3), (val4, val5)) = (val1, val2, val3, val4, val5)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair (pair enc1 enc2) enc3) (pair enc4 enc5)

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }

-- | Construct an encoding for a 6-tuple from the encodings for the
-- six components.  This is actually just a wrapper around @pair@.
sextet :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 ->
          Encoding ty4 -> Encoding ty5 -> Encoding ty6 ->
          Encoding (ty1, ty2, ty3, ty4, ty5, ty6)
sextet enc1 enc2 enc3 enc4 enc5 enc6 =
  let
    fwdshuffle (val1, val2, val3, val4, val5, val6) =
      (((val1, val2), val3), ((val4, val5), val6))
    revshuffle (((val1, val2), val3), ((val4, val5), val6)) =
      (val1, val2, val3, val4, val5, val6)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair (pair enc1 enc2) enc3) (pair (pair enc4 enc5) enc6)

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }

-- | Construct an encoding for a 7-tuple from the encodings for the
-- seven components.  This is actually just a wrapper around @pair@.
septet :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 -> Encoding ty4 ->
          Encoding ty5 -> Encoding ty6 -> Encoding ty7 ->
          Encoding (ty1, ty2, ty3, ty4, ty5, ty6, ty7)
septet enc1 enc2 enc3 enc4 enc5 enc6 enc7 =
  let
    fwdshuffle (val1, val2, val3, val4, val5, val6, val7) =
      (((val1, val2), (val3, val4)), ((val5, val6), val7))
    revshuffle (((val1, val2), (val3, val4)), ((val5, val6), val7)) =
      (val1, val2, val3, val4, val5, val6, val7)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair (pair enc1 enc2) (pair enc3 enc4)) (pair (pair enc5 enc6) enc7)

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }

-- | Construct an encoding for an 8-tuple from the encodings for the
-- eight components.  This is actually just a wrapper around @pair@.
octet :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 ->
         Encoding ty4 -> Encoding ty5 -> Encoding ty6 ->
         Encoding ty7 -> Encoding ty8 ->
         Encoding (ty1, ty2, ty3, ty4, ty5, ty6, ty7, ty8)
octet enc1 enc2 enc3 enc4 enc5 enc6 enc7 enc8 =
  let
    fwdshuffle (val1, val2, val3, val4, val5, val6, val7, val8) =
      (((val1, val2), (val3, val4)), ((val5, val6), (val7, val8)))
    revshuffle (((val1, val2), (val3, val4)), ((val5, val6), (val7, val8))) =
      (val1, val2, val3, val4, val5, val6, val7, val8)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair (pair enc1 enc2) (pair enc3 enc4))
           (pair (pair enc5 enc6) (pair enc7 enc8))

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }

-- | Construct an encoding for a 9-tuple from the encodings for the
-- nine components.  This is actually just a wrapper around @pair@.
nonet :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 -> Encoding ty4 ->
         Encoding ty5 -> Encoding ty6 -> Encoding ty7 ->
         Encoding ty8 -> Encoding ty9 ->
         Encoding (ty1, ty2, ty3, ty4, ty5, ty6, ty7, ty8, ty9)
nonet enc1 enc2 enc3 enc4 enc5 enc6 enc7 enc8 enc9 =
  let
    fwdshuffle (val1, val2, val3, val4, val5, val6, val7, val8, val9) =
      ((((val1, val2), val3), (val4, val5)), ((val6, val7), (val8, val9)))
    revshuffle ((((val1, val2), val3), (val4, val5)), ((val6, val7), (val8, val9))) =
      (val1, val2, val3, val4, val5, val6, val7, val8, val9)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair (pair (pair enc1 enc2) enc3) (pair enc4 enc5))
           (pair (pair enc6 enc7) (pair enc8 enc9))

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }

-- | Construct an encoding for a 10-tuple from the encodings for the
-- ten components.  This is actually just a wrapper around @pair@.
dectet :: Encoding ty1 -> Encoding ty2 -> Encoding ty3 -> Encoding ty4 ->
          Encoding ty5 -> Encoding ty6 -> Encoding ty7 ->
          Encoding ty8 -> Encoding ty9 -> Encoding ty10 ->
          Encoding (ty1, ty2, ty3, ty4, ty5, ty6, ty7, ty8, ty9, ty10)
dectet enc1 enc2 enc3 enc4 enc5 enc6 enc7 enc8 enc9 enc10 =
  let
    fwdshuffle (val1, val2, val3, val4, val5, val6, val7, val8, val9, val10) =
      ((((val1, val2), val3), (val4, val5)), (((val6, val7), val8), (val9, val10)))
    revshuffle ((((val1, val2), val3), (val4, val5)),
                (((val6, val7), val8), (val9, val10))) =
      (val1, val2, val3, val4, val5, val6, val7, val8, val9, val10)

    Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
      pair (pair (pair (pair enc1 enc2) enc3) (pair enc4 enc5))
           (pair (pair (pair enc6 enc7) enc8) (pair enc9 enc10))

    newencode = encodefunc . fwdshuffle
    newdecode = revshuffle . decodefunc
    newindomain = indomainfunc . fwdshuffle
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = sizeval, encInDomain = newindomain }

-- | Common idiom in bounded sets and sequences: take an entropy value
-- and generate a list of entropy values of a particular length.
toProdList :: Integer -> Integer -> [Integer]
toProdList =
  let
    productList' accum 1 entropy = reverse (entropy : accum)
    productList' _ 0 _ = []
    productList' accum count entropy =
      let
        sumval = (isqrt ((8 * entropy) + 1) - 1) `quot` 2
        base = (((sumval + 1) * sumval)) `quot` 2
        num2 = entropy - base
        num1 = sumval - num2
      in
        productList' (num1 : accum) (count - 1) num2
  in
    productList' []

fromProdList :: [Integer] -> Integer
fromProdList [] = 0
fromProdList vals =
  let
    (first : rest) = reverse vals
    fromProdList' accum [] = accum
    fromProdList' accum (first' : rest') =
      let
        sumval = accum + first'
        base = (((sumval + 1) * sumval)) `quot` 2
      in
        fromProdList' (base + accum) rest'
  in
    fromProdList' first rest

-- | Take an @Encoding@ for elements and a length and produce an
-- @Encoding@ for lists of exactly that length.
--
-- This differs from 'boundedSeq' in that the resulting list is
-- /exactly/ the given length, as opposed to upper-bounded by it.
power :: Integer
      -- ^ Number of elements in the resulting lists
      -> Encoding ty
      -- ^ @Encoding@ for the elements
      -> Encoding [ty]
power len Encoding { encEncode = encodefunc, encDecode = decodefunc,
                     encSize = sizeval, encInDomain = indomainfunc } =
  let
    (newencode, newdecode, newsize) =
      case sizeval of
        Just finitesize ->
          let
            newencode' accum [] = accum
            newencode' accum (first : rest) =
              newencode' ((accum * finitesize) + encodefunc first) rest

            newdecode' accum 1 entropy = (decodefunc entropy : accum)
            newdecode' _ 0 _ = []
            newdecode' accum count entropy =
              let
                thisentropy = entropy `mod` finitesize
                restentropy = entropy `quot` finitesize
                this = decodefunc thisentropy
              in
                newdecode' (this : accum) (count - 1) restentropy
          in
            (newencode' 0, newdecode' [] len, Just (finitesize ^ len))
        Nothing ->
          let
            newencode' = fromProdList . map encodefunc
            newdecode' = map decodefunc . toProdList len
          in
            (newencode', newdecode', Nothing)

    newindomain vals = length vals == fromInteger len && all indomainfunc vals
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = newsize, encInDomain = newindomain }

-- | Build an encoding for /finite/ sets of values of a given datatype
-- from an encoding for that datatype.
--
-- Note: this encoding and its variants can produce very large numbers
-- for a very small set.
set :: Ord ty => Encoding ty -> Encoding (Set ty)
set Encoding { encEncode = encodefunc, encDecode = decodefunc,
               encSize = sizeval, encInDomain = indomainfunc } =
  let
    newEncode = Set.foldl (\n -> setBit n . fromInteger . encodefunc) 0

    newDecode =
      let
        decode' out _ 0 = out
        decode' out idx n
          | testBit n 0 =
            decode' (Set.insert (decodefunc idx) out) (idx + 1) (n `shiftR` 1)
          | otherwise = decode' out (idx + 1) (n `shiftR` 1)
      in
        decode' Set.empty 0

    newSize =
      do
        elems <- sizeval
        return (2 ^ elems)

    newInDomain = all indomainfunc . Set.toList
  in
    Encoding { encEncode = newEncode, encDecode = newDecode,
               encSize = newSize, encInDomain = newInDomain }

-- | Build an encoding for /finite/ sets of values of a given datatype
-- from an encoding for that datatype.  Similar to @set@, but uses
-- @HashSet@ instead
hashSet :: (Hashable ty, Ord ty) =>
           Encoding ty -> Encoding (HashSet ty)
hashSet Encoding { encEncode = encodefunc, encDecode = decodefunc,
                   encSize = sizeval, encInDomain = indomainfunc } =
  let
    newEncode =
      HashSet.foldr (\elem n -> setBit n (fromInteger (encodefunc elem))) 0

    newDecode =
      let
        decode' out _ 0 = out
        decode' out idx n
          | testBit n 0 =
            decode' (HashSet.insert (decodefunc idx) out)
                    (idx + 1) (n `shiftR` 1)
          | otherwise = decode' out (idx + 1) (n `shiftR` 1)
      in
        decode' HashSet.empty 0

    newSize =
      do
        elems <- sizeval
        return (2 ^ elems)

    newInDomain = all indomainfunc . HashSet.toList
  in
    Encoding { encEncode = newEncode, encDecode = newDecode,
               encSize = newSize, encInDomain = newInDomain }

seqCore :: Encoding ty -> ([ty] -> Integer, Integer -> [ty])
seqCore Encoding { encEncode = encodefunc, encDecode = decodefunc,
                   encSize = sizeval } =
  case sizeval of
    -- For encodings with a maximum size s, a list with n elements
    -- e_i is encoded as e_n + s e_(n-1) + ... s^n e_1
    Just finitesize ->
      let
        newencodefunc =
          let
            foldfun accum = (((accum * finitesize) + 1) +) . encodefunc
          in
           foldl foldfun 0

        newdecodefunc =
          let
            newdecodefunc' accum 0 = accum
            newdecodefunc' accum num =
              let
                decoded = decodefunc ((num - 1) `mod` finitesize)
              in
               newdecodefunc' (decoded : accum) ((num - 1) `quot` finitesize)
          in
           newdecodefunc' []
      in
        (newencodefunc, newdecodefunc)
    -- For encodings with no maximum size, we use a dovetailing approach.
    Nothing ->
      let
        newencodefunc [] = 0
        newencodefunc (first : rest) =
          let
            insertUnary bin val =
              let
                encoded = encodefunc val
                shifted = bin `shiftL` (fromInteger encoded)
              in
               shifted .|. ((2 ^ encoded) - 1)

            foldfun accum val =
              let
                shifted = accum `shiftL` 1
              in
               insertUnary shifted val

            initial = insertUnary 1 first
          in
           foldl foldfun initial rest

        newdecodefunc 0 = []
        newdecodefunc num =
          let
            -- Count leading ones
            leadingOnes :: Integer -> Integer
            leadingOnes =
              let
                leadingOnes' count n
                  | testBit n 0 = leadingOnes' (count + 1) (n `shiftR` 1)
                  | otherwise = count
              in
               leadingOnes' 0

            extractUnary bin =
              let
                unaryLen = leadingOnes bin
                shifted = bin `shiftR` (fromInteger (unaryLen + 1))
                decoded
                  | shifted /= 0 = decodefunc unaryLen
                  | otherwise = decodefunc (unaryLen - 1)
              in
               (decoded, shifted)

            doDecode accum 0 = accum
            doDecode accum bin =
              let
                (val, newbin) = extractUnary bin
              in
               doDecode (val : accum) newbin
          in
           doDecode [] num
      in
        (newencodefunc, newdecodefunc)

-- | Construct an encoding for /finite/ sequences of a type from an
-- encoding for values of that type.
--
-- Note: This encoding can produce very large numbers for short
-- sequences.
seq :: Encoding ty -> Encoding [ty]
seq enc @ Encoding { encInDomain = indomainfunc } =
  let
    (newEncode, newDecode) = seqCore enc
    newInDomain = all indomainfunc
  in
    Encoding { encEncode = newEncode, encDecode = newDecode,
               encSize = Nothing, encInDomain = newInDomain }

-- | Sum of finite geometric series
geometricSum :: Integer -> Integer -> Integer
-- list of unit needs a special case to avoid 0/0
geometricSum len 1 = len + 1
geometricSum len base = (1 - base ^ (len + 1)) `quot` (1 - base)

-- | Integer logarithm (for base b and n, find largest i such that b^i
-- <= n)
ilog :: Integer -> Integer -> Integer
ilog n = toInteger . integerLogBase' n

boundedSeqCore :: Integer -> Encoding ty -> ([ty] -> Integer, Integer -> [ty])
boundedSeqCore len Encoding { encEncode = encodefunc, encDecode = decodefunc,
                              encSize = sizeval } =
  case sizeval of
    Nothing ->
      let
        newencode [] = 0
        newencode vals =
          let
            thislen = toInteger (length vals)
            contentnum = fromProdList (map encodefunc vals)
          in
            (contentnum * len) + thislen

        newdecode 0 = []
        newdecode num =
          let
            adjusted = num - 1
            (remainingEntropy, lengthEntropy) = adjusted `quotRem` len
            thislen = lengthEntropy + 1
          in
            map decodefunc (toProdList thislen remainingEntropy)
      in
        (newencode, newdecode)
    Just 0 -> (\[] -> 0, \0 -> [])
    Just 1 -> (genericLength, flip genericReplicate (decodefunc 0))
    Just finitesize ->
      let
        newencode [] = 0
        newencode vals =
          let
            thislen = toInteger (length vals)
            base = geometricSum (thislen - 1) finitesize

            newencode' accum [] = accum
            newencode' accum (first : rest) =
              newencode' ((accum * finitesize) + encodefunc first) rest
          in
            base + (newencode' 0 (reverse vals))

        newdecode 0 = []
        newdecode num =
          let
            lowlen = ilog finitesize ((num * (finitesize - 1)) + 1) - 1
            thislen = lowlen + 1
            contentnum = num - (geometricSum lowlen finitesize)

            newdecode' accum 1 entropy = (decodefunc entropy : accum)
            newdecode' _ 0 _ = []
            newdecode' accum count entropy =
              let
                thisentropy = entropy `mod` finitesize
                restentropy = entropy `quot` finitesize
                this = decodefunc thisentropy
              in
               newdecode' (this : accum) (count - 1) restentropy
          in
            reverse (newdecode' [] thislen contentnum)
      in
        (newencode, newdecode)

-- | Construct an encoding for sequences whose length is bounded by a
-- given value from an encoding for elements of the sequence.
boundedSeq :: Integer
           -- ^ The maximum length of the sequence
           -> Encoding ty
           -- ^ The @Encoding@ for the sequence elements
           -> Encoding [ty]
boundedSeq len enc @ Encoding { encSize = sizeval, encInDomain = indomainfunc } =
  let
    (newencode, newdecode) = boundedSeqCore len enc
    newsize = case len of
      0 -> Just 1 --even if the list members are infinite
      _ -> fmap (geometricSum len) sizeval
    newindomain vals = length vals <= fromInteger len && all indomainfunc vals
  in
    Encoding { encEncode = newencode, encDecode = newdecode,
               encSize = newsize, encInDomain = newindomain }

-- | Take a function which takes a self-reference and produces a
-- recursive encoding, and produce the fixed-point encoding.
recursive :: (Encoding ty -> Encoding ty)
          -- ^ A function that, given a self-reference,
          -- constructs an encoding.
          -> Encoding ty
recursive genfunc =
  let
    enc = Encoding { encEncode = encode (genfunc enc),
                     encDecode = decode (genfunc enc),
                     encInDomain = inDomain (genfunc enc),
                     encSize = Nothing }
  in
    enc

-- | A recursive construction for two mutually-recursive constructions.
recursive2 :: ((Encoding ty1, Encoding ty2) -> Encoding ty1)
           -- ^ A function that, given self-references to both encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2) -> Encoding ty2)
           -- ^ A function that, given self-references to both encodings,
           -- constructs the second encoding.
           -> (Encoding ty1, Encoding ty2)
recursive2 genfunc1 genfunc2 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for three mutually-recursive constructions.
recursive3 :: ((Encoding ty1, Encoding ty2, Encoding ty3) -> Encoding ty1)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3) -> Encoding ty2)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the second encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3) -> Encoding ty3)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the third encoding.
           -> (Encoding ty1, Encoding ty2, Encoding ty3)
recursive3 genfunc1 genfunc2 genfunc3 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for four mutually-recursive constructions.
recursive4 :: ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4) ->
               Encoding ty1)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4) ->
               Encoding ty2)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the second encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4) ->
               Encoding ty3)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the third encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4) ->
               Encoding ty4)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fourth encoding.
           -> (Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4)
recursive4 genfunc1 genfunc2 genfunc3 genfunc4 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc4 encs),
                  encDecode = decode (genfunc4 encs),
                  encInDomain = inDomain (genfunc4 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for five mutually-recursive constructions.
recursive5 :: ((Encoding ty1, Encoding ty2, Encoding ty3,
                Encoding ty4, Encoding ty5) -> Encoding ty1)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3,
                Encoding ty4, Encoding ty5) -> Encoding ty2)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the second encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3,
                Encoding ty4, Encoding ty5) -> Encoding ty3)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the third encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3,
                Encoding ty4, Encoding ty5) -> Encoding ty4)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fourth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3,
                Encoding ty4, Encoding ty5) -> Encoding ty5)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fifth encoding.
           -> (Encoding ty1, Encoding ty2, Encoding ty3,
               Encoding ty4, Encoding ty5)
recursive5 genfunc1 genfunc2 genfunc3 genfunc4 genfunc5 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc4 encs),
                  encDecode = decode (genfunc4 encs),
                  encInDomain = inDomain (genfunc4 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc5 encs),
                  encDecode = decode (genfunc5 encs),
                  encInDomain = inDomain (genfunc5 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for six mutually-recursive constructions.
recursive6 :: ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6) -> Encoding ty1)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6) -> Encoding ty2)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the second encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6) -> Encoding ty3)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the third encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6) -> Encoding ty4)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fourth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6) -> Encoding ty5)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fifth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6) -> Encoding ty6)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the sixth encoding.
           -> (Encoding ty1, Encoding ty2, Encoding ty3,
               Encoding ty4, Encoding ty5, Encoding ty6)
recursive6 genfunc1 genfunc2 genfunc3 genfunc4 genfunc5 genfunc6 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc4 encs),
                  encDecode = decode (genfunc4 encs),
                  encInDomain = inDomain (genfunc4 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc5 encs),
                  encDecode = decode (genfunc5 encs),
                  encInDomain = inDomain (genfunc5 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc6 encs),
                  encDecode = decode (genfunc6 encs),
                  encInDomain = inDomain (genfunc6 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for seven mutually-recursive constructions.
recursive7 :: ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7) -> Encoding ty1)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7) -> Encoding ty2)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the second encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7) -> Encoding ty3)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the third encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7) -> Encoding ty4)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fourth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7) -> Encoding ty5)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fifth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7) -> Encoding ty6)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the sixth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7) -> Encoding ty7)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the seventh encoding.
           -> (Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
               Encoding ty5, Encoding ty6, Encoding ty7)
recursive7 genfunc1 genfunc2 genfunc3 genfunc4 genfunc5 genfunc6 genfunc7 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc4 encs),
                  encDecode = decode (genfunc4 encs),
                  encInDomain = inDomain (genfunc4 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc5 encs),
                  encDecode = decode (genfunc5 encs),
                  encInDomain = inDomain (genfunc5 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc6 encs),
                  encDecode = decode (genfunc6 encs),
                  encInDomain = inDomain (genfunc6 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc7 encs),
                  encDecode = decode (genfunc7 encs),
                  encInDomain = inDomain (genfunc7 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for eight mutually-recursive constructions.
recursive8 :: ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty1)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty2)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the second encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty3)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the third encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty4)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fourth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty5)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fifth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty6)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the sixth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty7)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the seventh encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8) ->
               Encoding ty8)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the eighth encoding.
           -> (Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
               Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8)
recursive8 genfunc1 genfunc2 genfunc3 genfunc4 genfunc5 genfunc6 genfunc7 genfunc8 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc4 encs),
                  encDecode = decode (genfunc4 encs),
                  encInDomain = inDomain (genfunc4 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc5 encs),
                  encDecode = decode (genfunc5 encs),
                  encInDomain = inDomain (genfunc5 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc6 encs),
                  encDecode = decode (genfunc6 encs),
                  encInDomain = inDomain (genfunc6 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc7 encs),
                  encDecode = decode (genfunc7 encs),
                  encInDomain = inDomain (genfunc7 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc8 encs),
                  encDecode = decode (genfunc8 encs),
                  encInDomain = inDomain (genfunc8 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for nine mutually-recursive constructions.
recursive9 :: ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty1)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the first encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty2)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the second encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty3)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the third encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty4)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fourth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty5)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the fifth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty6)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the sixth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty7)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the seventh encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty8)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the eighth encoding.
           -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7,
                Encoding ty8, Encoding ty9) -> Encoding ty9)
           -- ^ A function that, given self-references to all encodings,
           -- constructs the ninth encoding.
           -> (Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4, Encoding ty5,
               Encoding ty6, Encoding ty7, Encoding ty8, Encoding ty9)
recursive9 genfunc1 genfunc2 genfunc3 genfunc4 genfunc5
           genfunc6 genfunc7 genfunc8 genfunc9 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc4 encs),
                  encDecode = decode (genfunc4 encs),
                  encInDomain = inDomain (genfunc4 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc5 encs),
                  encDecode = decode (genfunc5 encs),
                  encInDomain = inDomain (genfunc5 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc6 encs),
                  encDecode = decode (genfunc6 encs),
                  encInDomain = inDomain (genfunc6 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc7 encs),
                  encDecode = decode (genfunc7 encs),
                  encInDomain = inDomain (genfunc7 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc8 encs),
                  encDecode = decode (genfunc8 encs),
                  encInDomain = inDomain (genfunc8 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc9 encs),
                  encDecode = decode (genfunc9 encs),
                  encInDomain = inDomain (genfunc9 encs),
                  encSize = Nothing })
  in
    encs

-- | A recursive construction for ten mutually-recursive constructions.
recursive10 :: ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty1)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the first encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty2)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the second encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty3)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the third encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty4)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the fourth encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty5)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the fifth encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty6)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the sixth encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty7)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the seventh encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty8)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the eighth encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty9)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the ninth encoding.
            -> ((Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                 Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                 Encoding ty9, Encoding ty10) -> Encoding ty10)
            -- ^ A function that, given self-references to all encodings,
            -- constructs the tenth encoding.
            -> (Encoding ty1, Encoding ty2, Encoding ty3, Encoding ty4,
                Encoding ty5, Encoding ty6, Encoding ty7, Encoding ty8,
                Encoding ty9, Encoding ty10)
recursive10 genfunc1 genfunc2 genfunc3 genfunc4 genfunc5
            genfunc6 genfunc7 genfunc8 genfunc9 genfunc10 =
  let
    encs =
      (Encoding { encEncode = encode (genfunc1 encs),
                  encDecode = decode (genfunc1 encs),
                  encInDomain = inDomain (genfunc1 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc2 encs),
                  encDecode = decode (genfunc2 encs),
                  encInDomain = inDomain (genfunc2 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc3 encs),
                  encDecode = decode (genfunc3 encs),
                  encInDomain = inDomain (genfunc3 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc4 encs),
                  encDecode = decode (genfunc4 encs),
                  encInDomain = inDomain (genfunc4 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc5 encs),
                  encDecode = decode (genfunc5 encs),
                  encInDomain = inDomain (genfunc5 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc6 encs),
                  encDecode = decode (genfunc6 encs),
                  encInDomain = inDomain (genfunc6 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc7 encs),
                  encDecode = decode (genfunc7 encs),
                  encInDomain = inDomain (genfunc7 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc8 encs),
                  encDecode = decode (genfunc8 encs),
                  encInDomain = inDomain (genfunc8 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc9 encs),
                  encDecode = decode (genfunc9 encs),
                  encInDomain = inDomain (genfunc9 encs),
                  encSize = Nothing },
       Encoding { encEncode = encode (genfunc10 encs),
                  encDecode = decode (genfunc10 encs),
                  encInDomain = inDomain (genfunc10 encs),
                  encSize = Nothing })
  in
    encs