{-
Copyright (C) 2010 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>

All rights reserved.

For license and copyright information, see the file COPYRIGHT

-}

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

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances  #-}

module Data.Cardinality.ContTrans (
              -- * type CardinalityConstraint = CardinalityRange
                CardinalityConstraint
              , cFitsInCC
              , fitsInCC
              , fitsInCC_T
              , HasCardConstr(..)
              , HasCardConstrT(..)
              , cFitsIn
              , cFitsInT
              , fitsIn
              , fitsInT

                -- * Container transformation
              , HasCardUCT(..)
              , HasCardUCT_T(..)
              , TransformError_FromTypeName
              , TransformError_ToTypeName
              , TransformError_Details
              , uContError
              , uContErrorT
              , sContTrans
              , sContTransT
              , From_LazyCardinality
              , To_CardinalityConstraint
              , ContainerOrder
              , ContTransError(..)
              , sContTrans_E
              , sContTransT_E
              ) where

import Data.Cardinality.Cardinality
import Data.Cardinality.CardinalityRange
import Data.EmptySet
import Data.Intersectable
import Data.NeverEmptyList
import qualified Data.Map as M
import Data.Map (Map, (!))
import Data.Word
import Data.Typeable
-- import Debug.Trace
import Control.Monad.Identity

type CardinalityConstraint = CardinalityRange

-- | @cFitsInCC = 'cFitsInCR'@
--
-- Defined to satisfy abbreviation.
cFitsInCC :: LazyCardinality -> CardinalityConstraint -> Bool
cFitsInCC = cFitsInCR
infixr 9 `cFitsInCC`

-- | @fitsInCC = 'fitsInCR'@
--
-- Defined to satisfy abbreviation.
fitsInCC :: HasCard a => a -> CardinalityConstraint -> Bool
fitsInCC = fitsInCR
infixr 9 `fitsInCC`

-- | @fitsInCC = 'fitsInCR_T'@
--
-- Defined to satisfy abbreviation.
fitsInCC_T :: HasCardT c => c a -> CardinalityConstraint -> Bool
fitsInCC_T = fitsInCR_T
infixr 9 `fitsInCC_T`

-- | @HasCardConstr@ = \"Has cardinality constraint\". In other words, \"there
-- is a capacity constraint for this container\".
class HasCardConstr a where
     cardinalityConstraintOf :: a -> CardinalityConstraint

-- | @HasCardConstrT@ = \"Has cardinality constraint (for container types of
-- kind @(* -> *)@)\".
-- In other words, \"there is a capacity constraint for this container type
-- of kind @(* -> *)@\".
class HasCardConstrT c where
     cardinalityConstraintOfT :: c a -> CardinalityConstraint

-- | Wrapper around @'cFitsInCC'@.
cFitsIn :: HasCardConstr b => LazyCardinality -> b -> Bool
cFitsIn c hasCC = c `cFitsInCC` cardinalityConstraintOf hasCC
infixr 9 `cFitsIn`

-- | Wrapper around @'cFitsInCC'@.
cFitsInT :: HasCardConstrT c => LazyCardinality -> c b -> Bool
cFitsInT c hasCC = c `cFitsInCC` cardinalityConstraintOfT hasCC
infixr 9 `cFitsInT`

-- | Wrapper around @'cFitsInCC'@.
fitsIn :: (HasCard a, HasCardConstr b) => a -> b -> Bool
fitsIn hasC hasCC = cardOf hasC `cFitsInCC` cardinalityConstraintOf hasCC
infixr 9 `fitsIn`

-- | Wrapper around @'cFitsInCC'@.
fitsInT :: (HasCardT c, HasCardConstrT d) => c a -> d b -> Bool
fitsInT hasC hasCC = cardOfT hasC `cFitsInCC` cardinalityConstraintOfT hasCC
infixr 9 `fitsInT`

--------------------------------------------------------------
-- Container transformation

-- | @HasCardUCT@ = \"Has cardinality-unsafe container transform\".
-- Define transform that may thow an error, if contents of @from@ don't fit
-- in @to@ .
class HasCardUCT from to where
     -- | \"u-\" prefix stands for \"unsafe-\"
     uContTrans :: from -> to
-- | @HasCardUCT_T@ = \"Has cardinality-unsafe container
-- transform (for container types of kind @(* -> *)@)\".
-- Same thing as @'HasCardUCT'@, but for containers of kind @(* -> *)@.
class HasCardUCT_T from to where
     -- | \"u-\" prefix stands for \"unsafe-\"
     uContTransT :: from a -> to a

type TransformError_FromTypeName = String
type TransformError_ToTypeName   = String
type TransformError_Details      = String

-- | This error is used by @'HasCardUCT'@
-- typeclass instances in cases when @from@ container's contents
-- don't fit in @to@ container.
uContError :: TransformError_FromTypeName -> TransformError_ToTypeName -> TransformError_Details -> a
uContError from_t_name to_t_name details = error $
             "An error occurred in the instance of HasCardUCT"
          ++ ", when trying to transform from type '" ++ from_t_name ++ "' to type '" ++ to_t_name ++ "'."
          ++ (case details of
                  [] -> ""
                  _  -> "Details: '" ++ details ++ "'."
             )

-- | Same as @'uContError'@, but for use in
-- @'HasCardUCT_T'@ typeclass instances
uContErrorT :: TransformError_FromTypeName -> TransformError_ToTypeName -> TransformError_Details -> a
uContErrorT from_t_name to_t_name details = error $
             "An error occurred in the instance of HasCardUCT_T"
          ++ ", when trying to transform from type '" ++ from_t_name ++ "' to type '" ++ to_t_name ++ "'."
          ++ (case details of
                  [] -> ""
                  _  -> "Details: '" ++ details ++ "'."
             )

-- | A wrapper around @'uContTrans'@. Contrary to it, where \"u-\" prefix stands
-- for \"unsafe-\", here \"s-\" prefix stands for \"safe-\".
-- This is aimed to localize and exclude case, when contents of @from@ don't
-- fit in @to@ If @'HasCardUCT'@ instaniated
-- correctly, then @'sContTrans'@ should never allow
-- @'uContError'@ to be called by subject instance. It should return @Nothing@
-- instead.
sContTrans :: ( HasCard from
              , HasCardConstr to
              , HasCardUCT from to
              ) => from -> Maybe to
sContTrans from =
        let to = uContTrans from
         in case from `fitsIn` to of
                True  -> Just to
                False -> Nothing

-- | A wrapper around @'uContTransT'@. Contrary to it, where \"u-\" prefix stands
-- for \"unsafe-\", here \"s-\" prefix stands for \"safe-\".
-- This is aimed to localize and exclude case, when contents of @(from a)@ don't
-- fit in @(to a)@ . If @'HasCardUCT_T'@ instaniated
-- correctly, then @'sContTransT'@ should never allow
-- @'uContErrorT'@ to be called by subject instance. It should return @Nothing@
-- instead.
sContTransT :: ( HasCardT from
               , HasCardConstrT to
               , HasCardUCT_T from to
               ) => from a -> Maybe (to a)
sContTransT from =
        let to = uContTransT from
         in case from `fitsInT` to of
                True  -> Just to
                False -> Nothing

-- | Used in @'ContTransError'@.
type From_LazyCardinality  = LazyCardinality
-- | Used in @'ContTransError'@.
type To_CardinalityConstraint = CardinalityConstraint
-- | Used in @'ContTransError'@. The kind of container.
data ContainerOrder =
        -- | Describes container of the kind @*@.
          FirstOrderContainer
        -- | Describes container of the kind @(* -> *)@.
        | SecondOrderContainer
        deriving (Eq, Ord, Show)

-- | For container transformation we might use more informative error feedback.
-- The @'Ordering'@ in the middle is a relation between subject
-- @From_LazyCardinality@ and @To_CardinalityConstraint@. It's never EQ (and
-- that's the reason for the error).
data ContTransError = ContTransError From_LazyCardinality Ordering To_CardinalityConstraint ContainerOrder deriving (Show)

-- | Analogue to @'sContTrans'@. Herre, in case of cardinality error, a more
-- informative data structure is returned instead of @Nothing@ (as was
-- in @'sContTrans'@).
sContTrans_E :: ( HasCard from
              , HasCardConstr to
              , HasCardUCT from to
              ) => from -> Either ContTransError to
sContTrans_E from =
        let to = uContTrans from
            from_card     = cardOf from
            to_cardConstr = cardinalityConstraintOf to
            (fit, from_card_2, to_cardConstr_2) = from_card `cFitsInCR_Proto` to_cardConstr
         in case fit of
                EQ -> Right to
                _  -> Left $ ContTransError from_card_2 fit to_cardConstr_2 FirstOrderContainer

-- | Analogue to @'sContTransT'@. Herre, in case of cardinality error, a more
-- informative data structure is returned instead of @Nothing@ (as was
-- in @'sContTransT'@).
sContTransT_E :: ( HasCardT from
               , HasCardConstrT to
               , HasCardUCT_T from to
               ) => from a -> Either ContTransError (to a)
sContTransT_E from =
        let to = uContTransT from
            from_card     = cardOfT from
            to_cardConstr = cardinalityConstraintOfT to
            (fit, from_card_2, to_cardConstr_2) = from_card `cFitsInCR_Proto` to_cardConstr
         in case fit of
                EQ -> Right to
                _  -> Left $ ContTransError from_card_2 fit to_cardConstr_2 SecondOrderContainer


--------------------------------------------------------------
--------------------------------------------------------------
-- Instances 0

instance HasCardConstr () where
        cardinalityConstraintOf _ = cr0
instance HasCardConstr (EmptySet a) where
        cardinalityConstraintOf _ = cr0
instance HasCardConstrT EmptySet where
        cardinalityConstraintOfT _ = cr0

-- instance HasCardConstr a where
--         cardinalityConstraintOf _ = cr1
instance HasCardConstr (Identity a) where
        cardinalityConstraintOf _ = cr1
instance HasCardConstrT Identity where
        cardinalityConstraintOfT _ = cr1

instance HasCardConstr (Maybe a) where
        cardinalityConstraintOf _ = cr0_1
instance HasCardConstrT Maybe where
        cardinalityConstraintOfT _ = cr0_1

instance HasCardConstr [a] where
        cardinalityConstraintOf _ = cr0_Inf
instance HasCardConstrT ([]) where
        cardinalityConstraintOfT _ = cr0_Inf

instance HasCardConstr (NeverEmptyList a) where
        cardinalityConstraintOf _ = cr1_Inf
instance HasCardConstrT NeverEmptyList where
        cardinalityConstraintOfT _ = cr1_Inf

instance HasCardConstr (Map k e) where
        cardinalityConstraintOf _ = cr0_Inf
instance HasCardConstrT (Map k) where
        cardinalityConstraintOfT _ = cr0_Inf
-- Here actually we may want an other look - one that involves the count of possible values key may take...

instance HasCardConstr (a,a) where { cardinalityConstraintOf _ = crX 2 }
instance HasCardConstr (a,a,a) where { cardinalityConstraintOf _ = crX 3 }
instance HasCardConstr (a,a,a,a) where { cardinalityConstraintOf _ = crX 4 }
instance HasCardConstr (a,a,a,a,a) where { cardinalityConstraintOf _ = crX 5 }
instance HasCardConstr (a,a,a,a,a,a) where { cardinalityConstraintOf _ = crX 6 }
instance HasCardConstr (a,a,a,a,a,a,a) where { cardinalityConstraintOf _ = crX 7 }
instance HasCardConstr (a,a,a,a,a,a,a,a) where { cardinalityConstraintOf _ = crX 8 }
instance HasCardConstr (a,a,a,a,a,a,a,a,a) where { cardinalityConstraintOf _ = crX 9 }
instance HasCardConstr (a,a,a,a,a,a,a,a,a,a) where { cardinalityConstraintOf _ = crX 10 }
instance HasCardConstr (a,a,a,a,a,a,a,a,a,a,a) where { cardinalityConstraintOf _ = crX 11 }

--------------------------------------------------------------
-- Instances 1
{-

instance HasCardUCT a a where
        uContTrans = id
instance HasCardUCT_T a a where
        uContTransT = id
-}

--------

instance HasCardUCT (EmptySet a) () where
        uContTrans _ = ()

instance HasCardUCT () (EmptySet a) where
        uContTrans _ = EmptySet

--

instance HasCardUCT (EmptySet a) (Maybe a) where
        uContTrans _ = Nothing
instance HasCardUCT_T EmptySet Maybe where
        uContTransT = uContTrans

instance HasCardUCT (Maybe a) (EmptySet a) where
        uContTrans Nothing = EmptySet
        uContTrans       _ = uContError "Maybe a" "EmptySet a" "something can not be nothing"
instance HasCardUCT_T Maybe EmptySet where
        uContTransT Nothing = EmptySet
        uContTransT       _ = uContErrorT "Maybe" "EmptySet" "something can not be nothing"

--

instance HasCardUCT (EmptySet a) [a] where
        uContTrans _ = []
instance HasCardUCT_T EmptySet ([]) where
        uContTransT = uContTrans

instance HasCardUCT [a] (EmptySet a) where
        uContTrans [] = EmptySet
        uContTrans  _ = uContError "[a]" "EmptySet a" "something can not be nothing"
instance HasCardUCT_T ([]) EmptySet where
        uContTransT [] = EmptySet
        uContTransT  _ = uContErrorT "[]" "EmptySet" "something can not be nothing"

--

instance HasCardUCT (EmptySet (k, e)) (Map k e) where
        uContTrans _ = M.empty
-- Can't see any way to make an instance HasCardUCT here

instance HasCardUCT (Map k e) (EmptySet (k, e)) where
        uContTrans mp =
                case M.null mp of
                    True  -> EmptySet
                    False -> uContError "Map k e" "EmptySet (k, e)" "something can not be nothing"
-- Can't see any way to make an instance HasCardUCT here

--------

{-
instance HasCardUCT a (Identity a) where
        uContTrans = Identity

instance HasCardUCT a (Maybe a) where
        uContTrans = Just

instance HasCardUCT a [a] where
        uContTrans = (: [])

instance HasCardUCT a (NeverEmptyList a) where
        uContTrans = nelSingleton
-}
instance HasCardUCT (k, e) (Map k e) where
        uContTrans = uncurry M.singleton
instance HasCardUCT_T ((,) k) (Map k) where
        uContTransT = uContTrans

--------
{-
instance HasCardUCT (Identity a) a where
        uContTrans = runIdentity

instance HasCardUCT (Maybe a) a where
        uContTrans (Just a) = a
        uContTrans Nothing = uContError "Maybe a" "a" "nothing to identify in Nothing"

instance HasCardUCT [a] a where
        uContTrans       [] = uContError "[a]" "a" "nothing to identify in empty list"
        uContTrans (h : []) = h
        uContTrans (h :  _) = uContError "[a]" "a" "too many identities"

instance HasCardUCT (NeverEmptyList a) a where
        uContTrans (NEL h []) = h
        uContTrans (NEL _  _) = uContError "NeverEmptyList a" "a" "too many identities"
-}
instance HasCardUCT (Map k e) (k, e) where
        uContTrans mp =
                case M.minViewWithKey  mp of
                    Nothing -> uContError "Map k e" "(k, e)" "nothing to identify in empty list"
                    Just (row, rest_mp) ->
                        case M.null rest_mp of
                            True  -> row
                            False -> uContError "Map k e" "(k, e)" "too many identities"
instance HasCardUCT_T (Map k) ((,) k) where
        uContTransT = uContTrans

--------

instance HasCardUCT (Identity a) (Maybe a) where
        uContTrans = Just . runIdentity
instance HasCardUCT_T Identity Maybe where
        uContTransT = uContTrans

instance HasCardUCT (Identity a) [a] where
        uContTrans i = [runIdentity i]
instance HasCardUCT_T Identity ([]) where
        uContTransT = uContTrans

instance HasCardUCT (Identity a) (NeverEmptyList a) where
        uContTrans i = NEL (runIdentity i) []
instance HasCardUCT_T Identity NeverEmptyList where
        uContTransT = uContTrans

instance HasCardUCT (Identity (k, e)) (Map k e) where
        uContTrans = uContTrans . runIdentity
-- Can't see any way to make an instance HasCardUCT here

--------

instance HasCardUCT (Maybe a) (Identity a) where
        uContTrans (Just a) = Identity a
        uContTrans Nothing = uContError "Maybe a" "Identity a" "nothing to identify in Nothing"
instance HasCardUCT_T Maybe Identity where
        uContTransT = uContTrans

instance HasCardUCT [a] (Identity a) where
        uContTrans       [] = uContError "[a]" "Identity a" "nothing to identify in empty list"
        uContTrans (h : []) = Identity h
        uContTrans (h :  _) = uContError "[a]" "Identity a" "too many identities"
instance HasCardUCT_T ([]) Identity where
        uContTransT = uContTrans

instance HasCardUCT (NeverEmptyList a) (Identity a) where
        uContTrans (NEL h []) = Identity h
        uContTrans (NEL _  _) = uContError "NeverEmptyList a" "Identity a" "too many identities"
instance HasCardUCT_T NeverEmptyList Identity where
        uContTransT = uContTrans

instance HasCardUCT (Map k e) (Identity (k, e)) where
        uContTrans mp =
                case M.minViewWithKey mp of
                    Nothing -> uContError "Map k e" "Identity (k, e)" "nothing to identify in empty list"
                    Just (row, rest_mp) ->
                        case M.null rest_mp of
                            True  -> Identity row
                            False -> uContError "Map k e" "Identity (k, e)" "too many identities"
-- Can't see any way to make an instance HasCardUCT_T here

--------

instance HasCardUCT () (Maybe a) where
        uContTrans _ = Nothing

instance HasCardUCT () [a] where
        uContTrans _ = []

instance HasCardUCT () (Map k e) where
        uContTrans _ = M.empty

--------

instance HasCardUCT (Maybe a) () where
        uContTrans Nothing = ()
        uContTrans       _ = uContError "Maybe a" "()" "only Nothing transforms to unity" -- xD ... political, yes

instance HasCardUCT [a] () where
        uContTrans [] = ()
        uContTrans  _ = uContError "[a]" "()" "only empty list transforms to unity"

instance HasCardUCT (Map k e) () where
        uContTrans mp = case M.null mp of { True -> (); False -> uContError "Map a" "()" "only empty map transforms to unity"}

--------

instance HasCardUCT (Maybe a) [a] where
        uContTrans Nothing  = []
        uContTrans (Just a) = [a]
instance HasCardUCT_T Maybe ([]) where
        uContTransT = uContTrans

instance HasCardUCT (Maybe a) (NeverEmptyList a) where
        uContTrans Nothing  = uContError "Maybe a" "NeverEmptyList a" "there must be at least 1 element, Nothing is not the case"
        uContTrans (Just a) = (NEL a [])
instance HasCardUCT_T Maybe NeverEmptyList where
        uContTransT Nothing  = uContErrorT "Maybe" "NeverEmptyList" "there must be at least 1 element, Nothing is not the case"
        uContTransT (Just a) = (NEL a [])

instance HasCardUCT (Maybe (k, e)) (Map k e) where
        uContTrans Nothing  = M.empty
        uContTrans (Just (k, e)) = M.singleton k e
-- Can't see any way to make an instance HasCardUCT_T here

--------

instance HasCardUCT [a] (Maybe a) where
        uContTrans       [] = Nothing
        uContTrans (h : []) = Just h
        uContTrans        _ = uContError "[a]" "Maybe a" "too many elements to fit in Maybe"
instance HasCardUCT_T ([]) Maybe where
        uContTransT       [] = Nothing
        uContTransT (h : []) = Just h
        uContTransT        _ = uContErrorT "[]" "Maybe" "too many elements to fit in Maybe"

instance HasCardUCT (NeverEmptyList a) (Maybe a) where
        uContTrans (NEL a []) = Just a
        uContTrans       _ = uContError "NeverEmptyList a" "Maybe a" "too many elements to fit in Maybe"
instance HasCardUCT_T NeverEmptyList Maybe where
        uContTransT (NEL a []) = Just a
        uContTransT       _ = uContErrorT "NeverEmptyList" "Maybe" "too many elements to fit in Maybe"

instance HasCardUCT (Map k e) (Maybe (k, e)) where
        uContTrans mp =
                case M.minViewWithKey  mp of
                    Nothing -> Nothing
                    Just (row, rest_mp) ->
                        case M.null rest_mp of
                            True  -> Just row
                            False -> uContError "Map k e" "Maybe (k, e)" "too many elements to fit in Maybe"
-- Can't see any way to make an instance HasCardUCT_T here

--------

instance HasCardUCT [a] (NeverEmptyList a) where
        uContTrans []      = uContError "[a]" "NeverEmptyList a" "there must be at least 1 element"
        uContTrans (h : t) = (NEL h t)
instance HasCardUCT_T ([]) NeverEmptyList where
        uContTransT []      = uContErrorT "[a]" "NeverEmptyList a" "there must be at least 1 element"
        uContTransT (h : t) = (NEL h t)

instance Ord k => HasCardUCT [(k, e)] (Map k e) where
        uContTrans = M.fromList
-- Can't see any way to make an instance HasCardUCT_T here

--------

instance HasCardUCT (NeverEmptyList a) [a] where
        uContTrans (NEL h t) = (h:t)
instance HasCardUCT_T NeverEmptyList ([]) where
        uContTransT = uContTrans

instance HasCardUCT (Map k e) [(k, e)] where
        uContTrans = M.toList
-- Can't see any way to make an instance HasCardUCT_T here

--------

instance Ord k => HasCardUCT (NeverEmptyList (k, e)) (Map k e) where
        uContTrans (NEL h t) = M.fromList (h:t)
-- Can't see any way to make an instance HasCardUCT_T here

--------

instance HasCardUCT (Map k e) (NeverEmptyList (k, e)) where
        uContTrans mp = case M.null mp of { False -> let (h:t) = M.toList mp in (NEL h t) ; True -> uContError "Map k e" "NeverEmptyList (k, e)" "there must be at least 1 element" }
-- Can't see any way to make an instance HasCardUCT_T here


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

instance HasCardUCT [a] (a,a)                   where { uContTrans l = case l of { (a:b:[])                   -> (a,b);                   _ -> uContError "[a]" "(a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a)                 where { uContTrans l = case l of { (a:b:c:[])                 -> (a,b,c);                 _ -> uContError "[a]" "(a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a)               where { uContTrans l = case l of { (a:b:c:d:[])               -> (a,b,c,d);               _ -> uContError "[a]" "(a,a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a,a)             where { uContTrans l = case l of { (a:b:c:d:e:[])             -> (a,b,c,d,e);             _ -> uContError "[a]" "(a,a,a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a,a,a)           where { uContTrans l = case l of { (a:b:c:d:e:f:[])           -> (a,b,c,d,e,f);           _ -> uContError "[a]" "(a,a,a,a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a,a,a,a)         where { uContTrans l = case l of { (a:b:c:d:e:f:g:[])         -> (a,b,c,d,e,f,g);         _ -> uContError "[a]" "(a,a,a,a,a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a,a,a,a,a)       where { uContTrans l = case l of { (a:b:c:d:e:f:g:h:[])       -> (a,b,c,d,e,f,g,h);       _ -> uContError "[a]" "(a,a,a,a,a,a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a,a,a,a,a,a)     where { uContTrans l = case l of { (a:b:c:d:e:f:g:h:i:[])     -> (a,b,c,d,e,f,g,h,i);     _ -> uContError "[a]" "(a,a,a,a,a,a,a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a,a,a,a,a,a,a)   where { uContTrans l = case l of { (a:b:c:d:e:f:g:h:i:j:[])   -> (a,b,c,d,e,f,g,h,i,j);   _ -> uContError "[a]" "(a,a,a,a,a,a,a,a,a,a)" "wrong count of elements" } }
instance HasCardUCT [a] (a,a,a,a,a,a,a,a,a,a,a) where { uContTrans l = case l of { (a:b:c:d:e:f:g:h:i:j:k:[]) -> (a,b,c,d,e,f,g,h,i,j,k); _ -> uContError "[a]" "(a,a,a,a,a,a,a,a,a,a,a)" "wrong count of elements" } }

instance HasCardUCT (a,a)                   [a] where { uContTrans (a,b)                   = (a:b:[]) }
instance HasCardUCT (a,a,a)                 [a] where { uContTrans (a,b,c)                 = (a:b:c:[]) }
instance HasCardUCT (a,a,a,a)               [a] where { uContTrans (a,b,c,d)               = (a:b:c:d:[]) }
instance HasCardUCT (a,a,a,a,a)             [a] where { uContTrans (a,b,c,d,e)             = (a:b:c:d:e:[]) }
instance HasCardUCT (a,a,a,a,a,a)           [a] where { uContTrans (a,b,c,d,e,f)           = (a:b:c:d:e:f:[]) }
instance HasCardUCT (a,a,a,a,a,a,a)         [a] where { uContTrans (a,b,c,d,e,f,g)         = (a:b:c:d:e:f:g:[]) }
instance HasCardUCT (a,a,a,a,a,a,a,a)       [a] where { uContTrans (a,b,c,d,e,f,g,h)       = (a:b:c:d:e:f:g:h:[]) }
instance HasCardUCT (a,a,a,a,a,a,a,a,a)     [a] where { uContTrans (a,b,c,d,e,f,g,h,i)     = (a:b:c:d:e:f:g:h:i:[]) }
instance HasCardUCT (a,a,a,a,a,a,a,a,a,a)   [a] where { uContTrans (a,b,c,d,e,f,g,h,i,j)   = (a:b:c:d:e:f:g:h:i:j:[]) }
instance HasCardUCT (a,a,a,a,a,a,a,a,a,a,a) [a] where { uContTrans (a,b,c,d,e,f,g,h,i,j,k) = (a:b:c:d:e:f:g:h:i:j:k:[]) }