Cardinality 0.1 → 0.2

raw patch · 10 files changed

+1388/−1265 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Cardinality.cabal +9/−2
• Data/Cardinality.hs +6/−522
• Data/Cardinality/Cardinality.hs +537/−0
• Data/Cardinality/CardinalityRange.hs +222/−0
• Data/Cardinality/ContTrans.hs +582/−0
• Data/CardinalityRange.hs +0/−721
• NEWS +14/−0
• examples/CardinalityRangeCompareTest.hs +0/−1
• examples/ContainerTransformsTests.hs +18/−18
• examples/HelloWorld.hs +0/−1

@@ -66,7 +66,11 @@         further first 2 elements. The complexity and power of this package is          that it provides a facility to /lazily/ evaluate amount of content in         the container.-Version: 0.1+        .+        To interface package functions +        .+        @import Data.Cardinality@+Version: 0.2 Copyright: Copyright (c) 2010 Andrejs Sisojevs License: LGPL License-File: COPYRIGHT@@ -81,6 +85,7 @@ Extra-Source-Files:     COPYRIGHT     COPYING+    NEWS     doinst.sh     examples/CardinalityRangeCompareTest.hs     examples/ContainerTransformsTests.hs@@ -89,8 +94,10 @@     Build-Depends:         base >= 4 && < 5, containers, mtl     Exposed-Modules:+        Data.Cardinality.Cardinality+        Data.Cardinality.CardinalityRange+        Data.Cardinality.ContTrans         Data.Cardinality-        Data.CardinalityRange         Data.EmptySet         Data.Intersectable         Data.NeverEmptyList

@@ -10,528 +10,12 @@ --------------------------------------------------------------------------
 --------------------------------------------------------------------------
 
-{-# LANGUAGE BangPatterns, FlexibleInstances  #-}
-
--- | Two main assumptions (and constraints) of this module:
---
--- (1) Cardinality can't be negative.
---
--- (2) For @'refinableC'@ construction it is always refined by growing. F.e.,
--- if @'refinableC' (7, ref_f_1)@ refines to @'refinableC' (x, ref_f_2)@, then
--- @x@ SHOULD NEVER be less then @7@.
--- On this assumption relies heavily functions @'lazyIsZeroLC'@,
--- @'lazyCompare2LCs'@, @'addLCToLC'@ and also almost every refinement routine.
 module Data.Cardinality (
-              -- * Core
-                PreciseCardinality
-              , CurrentNotFinalPreciseCardinality
-              , BoundaryPreciseCardinality
-              , ContinueCounting_DoWe
-              , ContinueRefiningCardinalityUntil
-              , CardinalityRefinementState
-              , LazyCardinality
-              , infiniteC
-              , preciseC
-              , refinableC
-              , lazyIsZeroLC
-              , refinementState
-              , addPCToLC
-              , addLCToLC
-              , sumLCs
-              , refineCRS_Till
-              , refineCRS_TillOneAbove
-              , refineCRS_TillOneBelow
-              , crsRefinementStep
-              , refineCRS_TillEnd
-              , refineTill
-              , refineTillOneAbove
-              , refineTillOneBelow
-              , refinementStep
-              , refineTillEnd
-              , equalize2Refinements
-              , compare2Refinements
-              , almostStrictCompare2LCs
-              , lazyCompare2LCs
-              , showLazy
-              , showStrict
-
-              -- * Application
-              , HasCard(..)
-              , HasCardT(..)
-
-              -- * Instances
-              -- ** Cardinality = 0
-              , cardOf_Unity
-              , cardOf_EmptySet
-              -- ** Cardinality = 1
-              -- , cardOf_Identity0
-              , cardOf_Identity1
-              -- ** Cardinality = 0..1
-              , cardOf_Maybe
-              -- ** Cardinality = 0..Inf
-              , cardOf_List
-              , cardOf_Map
-              -- ** Cardinality = 1..Inf
-              , cardOf_NeverEmptyList
-
-              -- * Helpers
-              , length2
+                module Data.Cardinality.Cardinality
+              , module Data.Cardinality.CardinalityRange
+              , module Data.Cardinality.ContTrans
               ) where
 
-import Data.EmptySet
-import Data.NeverEmptyList
-import qualified Data.Map as M
-import Data.Map (Map, (!))
-import Data.Word
-import Data.Typeable
-import Control.Monad.Identity
-
---------------------------------------------------------------
--- * Core
-
--- | Count of elements in container. It's always positive or zero.
---
--- It would be best here to use @'Word32'@ instead, however, with @Integer@
--- it's easier to catch the error of going down below zero (in case
--- of @'Word32' 0-1==4294967295@ ).
---
--- However it is decided not to allow the direct use of @'PreciseC'@ data
--- constructor, but to wrap it into function @'preciseC'@, which guards from
--- the attemts to conctruct negative cardinality (by throwing an error).
-type PreciseCardinality                = Integer
-type CurrentNotFinalPreciseCardinality = PreciseCardinality
-type BoundaryPreciseCardinality        = CurrentNotFinalPreciseCardinality
-type ContinueCounting_DoWe             = Bool
--- | An example of this is @'length2'@ function.
-type ContinueRefiningCardinalityUntil  = CurrentNotFinalPreciseCardinality -> (CurrentNotFinalPreciseCardinality -> ContinueCounting_DoWe) -> LazyCardinality
-type CardinalityRefinementState        = (CurrentNotFinalPreciseCardinality, ContinueRefiningCardinalityUntil)
-
--- | In other words: count of elements in a container,
--- with an opportunity not to refine the whole content of the container
--- (and the container's structure).
---
--- Constructors:
---
--- * @'infiniteC'@
---
--- * @'preciseC' 'PreciseCardinality'@
---
--- * @'refinableC' 'CardinalityRefinementState'@
-data LazyCardinality =
-          InfiniteC
-        | PreciseC PreciseCardinality
-        | RefinableC CardinalityRefinementState
-      deriving (Typeable)
-
--- | @'LazyCardinality'@ constructor.
---
--- F.e., @[1..]@ list has such cardinality.
-infiniteC :: LazyCardinality
-infiniteC = InfiniteC
-
--- | @'LazyCardinality'@ constructor. If given negative value, raises error.
---
--- F.e., the tuple @(5,6)@ has a precise cardinality 2.
-preciseC :: PreciseCardinality -> LazyCardinality
-preciseC c = case c < 0 of { True -> error ("Can't construct negative cardinality '" ++ show c ++ "' "); False -> PreciseC c }
-
--- | @'LazyCardinality'@ constructor.
---
--- For lists it happens, that we do not want to count all the elements
--- of a container,
--- but want to count them until some lower boundary. For example,
--- I do not want to know the length of the list (which involves taking
--- each element of it, and counting it in) to reason about whether
--- it's content fit into the @(,,)@ data constructor. For this
--- case I only need to count till 3rd element and check, if list is
--- continued. It's actual especially, when dealing with infinite lists
--- or with lists, whose reading may block.
---
--- For @(refinableC (x0, refine_f))@ important rules:
---
--- 1. If @(refine_f x0 (<= 5))@ evaluates to another @refinableC@, then
--- it is not fully refined, but (at least) @5@ is achieved (the precise
--- cardinality is @>= 5@).
---
--- 2. If @x0@ is @10@ and @(refine_f 10 (<= 15))@ returned
--- @(refinableC (17, refine_f_2))@, then it is known, that precise
--- cardinality is already >= @10 + 7@. In sight of @refine_f@ there
--- SHOULD be everything except for what's already counted in @x0@
--- (which is @10@), and in sight of @refine_f_2@ there should be even
--- less by @7@ elements comparing to @refine_f@. So if total cardinality was
--- @25@, then @(refine_f_2 17 (<= 30))@ MUST return @preciseC 25@, to make
--- @10 + 7 + 8 = 25@.
---
--- 3. The theatment of the first argument of refinement function @refine_f@
--- must be relative. For example, given total count of elements @= 25@ ,
--- and @x0 = 20@ - these 20 elements are already counted, and in sight of
--- @refine_f@ there are only 5 last elements.
--- Then @refine_f 20 (<= 26)@ will result in @preciseC 25@, but(!)
--- @refine_f 10 (<= 16)@ MUST result in @preciseC 15@.
---
--- Recomendations:
---
--- 1. If subject has infinite cardinality, it's best to determine
--- it's cardinality as @'infiniteC'@ at early stages and
--- avoid using @refinableC@ for it.
-refinableC :: CardinalityRefinementState -> LazyCardinality
-refinableC = RefinableC
-
-lcIsInfinite :: LazyCardinality -> Bool
-lcIsInfinite InfiniteC = True
-lcIsInfinite         _ = False
-
-preciseOfLC :: LazyCardinality -> Maybe PreciseCardinality
-preciseOfLC (PreciseC c) = Just c
-preciseOfLC            _ = Nothing
-
--- | Returns @Nothing@, ONLY if LC is @'refinableC' (0, _)@
--- (according to 2nd assumption of the module). Returns @Just True@
--- only for @'preciseC' 0@.
-lazyIsZeroLC :: LazyCardinality -> Maybe Bool
-lazyIsZeroLC (PreciseC c)        = Just (c == 0)
-lazyIsZeroLC InfiniteC           = Just False
-lazyIsZeroLC (RefinableC (c, _)) = case c `compare` 0 of { EQ -> Nothing; _ -> Just False }
-
-refinementState :: LazyCardinality -> Maybe CardinalityRefinementState
-refinementState (RefinableC rs) = Just rs
-refinementState               _ = Nothing
-
-infixr 6 `addPCToLC`
--- Throws an error if @'preciseC'@ is attempted to construct with negative
--- resulting cardinality.
-addPCToLC :: PreciseCardinality -> LazyCardinality -> LazyCardinality
-addPCToLC n lc =
-        case lc of
-            InfiniteC -> lc
-            PreciseC m -> preciseC (m + n)
-            RefinableC (c, ref_while) -> refinableC (c + n, ref_while)
-
-infixr 6 `addLCToLC`
--- | For case when adding up 2 refinables, if both of them sooner or later
--- refines to @'infiniteC'@, then one that returns infinity earlier is
--- recommended to put as a first term. Infinity + any LazyCardinality
--- = infinity. Another recommendation would be to put
--- refinable that's easier to compute as a first term.
-addLCToLC :: LazyCardinality -> LazyCardinality -> LazyCardinality
-addLCToLC lc_1 lc_2 =
-        case (lc_1, lc_2) of
-            (InfiniteC, _) -> InfiniteC
-            (_, InfiniteC) -> InfiniteC
-            (PreciseC m, PreciseC n) -> preciseC (m + n)
-            (PreciseC m, RefinableC (c, ref_while)) -> refinableC (c + m, ref_while)
-            (RefinableC (c, ref_while), PreciseC m) -> refinableC (c + m, ref_while)
-            (RefinableC (c, ref_while_1), RefinableC (d, ref_while_2)) -> refinableC (c + d, refWhileSyn ref_while_1 ref_while_2)
-     where
-        refWhileSyn :: ContinueRefiningCardinalityUntil -> ContinueRefiningCardinalityUntil -> ContinueRefiningCardinalityUntil
-        refWhileSyn ref_while_1 ref_while_2 =
-                (\ sofar stop_cond ->
-                        case ref_while_1 sofar stop_cond of
-                            InfiniteC  -> InfiniteC
-                            RefinableC (sofar_2, ref_while_1_2) -> RefinableC (sofar_2, refWhileSyn ref_while_1_2 ref_while_2)
-                            PreciseC c ->
-                                case ref_while_1 (sofar + c) stop_cond of
-                                    InfiniteC  -> InfiniteC
-                                    RefinableC (sofar_3, ref_while_2_2) -> RefinableC (sofar_3, ref_while_2_2)
-                                    PreciseC final_c -> PreciseC final_c
-                )
-
--- | @foldl 'addLCToLC'@
---
--- See recommendations by @'addLCToLC'@.
-sumLCs :: [LazyCardinality] -> LazyCardinality
-sumLCs = foldl addLCToLC (preciseC 0)
-
-refineCRS_Till :: CardinalityRefinementState -> BoundaryPreciseCardinality -> LazyCardinality
-refineCRS_Till crs@(c, ref_while) n =
-                 case c >= n of
-                     True  -> refinableC crs
-                     False -> ref_while c (<= n)
--- [1,2,3,4,5,6,7,8,9,10]
--- refineCRS_Till (refinableC (5, ref_while)) 8
--- ref_while sees [6,7,8,9,10]
--- ref_while (<= 8 - 5) -> ref_while (<= 3) -> refinableC (8, ref_while'))
--- ref_while' sees [9, 10]
-
-refineCRS_TillOneAbove :: CardinalityRefinementState -> BoundaryPreciseCardinality -> LazyCardinality
-refineCRS_TillOneBelow :: CardinalityRefinementState -> BoundaryPreciseCardinality -> LazyCardinality
-refineCRS_TillOneAbove crs n = refineCRS_Till crs (n + 1)
-refineCRS_TillOneBelow crs n = refineCRS_Till crs (n - 1)
-
-crsRefinementStep :: CardinalityRefinementState -> LazyCardinality
-crsRefinementStep crs@(c, ref_while) = ref_while c (<= (c + 1))
-
--- | Don't use it on infinite refinables not measured with 'infiniteC'.
-refineCRS_TillEnd :: CardinalityRefinementState -> LazyCardinality
-refineCRS_TillEnd crs@(c, ref_while) = ref_while c (const True)
-
--- | Wrapper around @'refineCRS_Till'@.
-refineTill :: LazyCardinality -> BoundaryPreciseCardinality -> LazyCardinality
-refineTill lc n =
-         case lc of
-             RefinableC crs -> refineCRS_Till crs n
-             _ -> lc
-
--- | Wrapper around @'refineTillOneAbove'@.
-refineTillOneAbove :: LazyCardinality -> BoundaryPreciseCardinality -> LazyCardinality
--- | Wrapper around @'refineTillOneBelow'@.
-refineTillOneBelow :: LazyCardinality -> BoundaryPreciseCardinality -> LazyCardinality
-refineTillOneAbove lc n = case lc of { RefinableC crs -> refineCRS_Till crs (n + 1); _ -> lc }
-refineTillOneBelow lc n = case lc of { RefinableC crs -> refineCRS_Till crs (n - 1); _ -> lc }
-
--- | Wrapper around @'crsRefinementStep'@.
-refinementStep :: LazyCardinality -> LazyCardinality
-refinementStep lc = case lc of { RefinableC crs -> crsRefinementStep crs ; _ -> lc }
-
--- | Wrapper around @'refineCRS_TillEnd'@.
-refineTillEnd :: LazyCardinality -> LazyCardinality
-refineTillEnd lc = case lc of { RefinableC crs -> refineCRS_TillEnd crs ; _ -> lc }
-
--- | For @equalize2Refinements (m, ref_f_1) (n, ref_f_2)@ finishes when m == n.
--- Else refines them. Another termination condition is when in result of
--- refinement one of cardinalities becomes final (not @'refinableC'@).
-equalize2Refinements :: CardinalityRefinementState -> CardinalityRefinementState -> (LazyCardinality, LazyCardinality)
-equalize2Refinements crs1@(m, ref_f_1) crs2@(n, ref_f_2) =
-        case m `compare` n of
-            LT -> let lc_of_crs1_refined = ref_f_1 m (<= n)
-                   in case refinementState lc_of_crs1_refined of
-                          Nothing -> (lc_of_crs1_refined, refinableC crs2)
-                          Just crs1_refined -> equalize2Refinements crs1_refined crs2
-            EQ -> (refinableC crs1, refinableC crs2)
-            GT -> let lc_of_crs2_refined = ref_f_2 n (<= m)
-                   in case refinementState lc_of_crs2_refined of
-                          Nothing -> (refinableC crs1, lc_of_crs2_refined)
-                          Just crs2_refined -> equalize2Refinements crs1 crs2_refined
-
-compare2Refinements :: CardinalityRefinementState -> CardinalityRefinementState -> (Ordering, LazyCardinality, LazyCardinality)
-compare2Refinements crs1@(m, _) crs2@(n, _) =
-        let cards = equalize2Refinements crs1 crs2
-         in case cards of
-                (lc1_2@(RefinableC crs1_2), lc2_2@(RefinableC crs2_2)) -> -- m == n
-                      let lc1_3 = crsRefinementStep crs1_2
-                       in case lc1_3 of -- I could have made crsRefinementStep for both in tuple here, but let's keep it as lazy as possible
-                              RefinableC crs1_3 ->
-                                  let lc2_3 = crsRefinementStep crs2_2
-                                   in case lc2_3 of
-                                          RefinableC crs2_3 -> compare2Refinements crs1_3 crs2_3
-                                          _ -> almostStrictCompare2LCs lc1_3 lc2_3
-                              _ -> almostStrictCompare2LCs lc1_3 lc2_2
-                _ -> uncurry almostStrictCompare2LCs cards
-
-infixr 9 `almostStrictCompare2LCs`
--- | Used for instance of Ord typeclass.
---
--- Together with @'Ordering'@ returns also probably refined cardinalities
--- for reuse.
---
--- WARNING!!! When comparing @'refinableC'@ with @'infiniteC'@
--- , it results in @'LT'@ (less than)!
--- While comparing @'infiniteC' \`almostStrictCompare2LCs\` 'infiniteC' ==
--- 'EQ'@.
--- That's the reason for an /almost-/ prefix in function name.
--- If there is a probability that refinement of
--- @'refinableC'@ may evaluate to @'infiniteC'@, and it's important to you,
--- that infinities are equal, then before comparing this refinable,
--- use 'refineCRS_TillEnd' on it. That's laziness.
---
--- Trying to compare 2 @'refinableC'@s that are actually infinite, but don't
--- use @'infiniteC'@ will hang
--- the system (the same as if you try to determine length of an infinite
--- list).
-almostStrictCompare2LCs :: LazyCardinality -> LazyCardinality -> (Ordering, LazyCardinality, LazyCardinality)
-almostStrictCompare2LCs a b =
-  let reverseOrdering :: (Ordering, LazyCardinality, LazyCardinality) -> (Ordering, LazyCardinality, LazyCardinality)
-      reverseOrdering (GT, a, b) = (LT, b, a)
-      reverseOrdering (LT, a, b) = (GT, b, a)
-      reverseOrdering (EQ, a, b) = (EQ, b, a)
-   in case (a,b) of
-         (InfiniteC , InfiniteC) -> (EQ, a, b)
-         (InfiniteC , _        ) -> (GT, a, b)
-         (_         , InfiniteC) -> (LT, a, b) -- !!! even though 'refinableC' may return 'infiniteC' !!!
-         (PreciseC m, PreciseC   n) -> (m `compare` n, a, b)
-         ----------------------------
-         (RefinableC crs@(m, _), PreciseC      n) -> case m > n of { True -> (GT, a, b); False -> almostStrictCompare2LCs (refineCRS_TillOneAbove crs n) b }
-         (RefinableC       crs1, RefinableC crs2) -> compare2Refinements crs1 crs2
-         (_                    , RefinableC    _) -> reverseOrdering $ almostStrictCompare2LCs b a
-
-instance Eq LazyCardinality where
-        lc1 == lc2 = (fst3 $ almostStrictCompare2LCs lc1 lc2) == EQ
-
-instance Ord LazyCardinality where
-        lc1 `compare` lc2 = fst3 $ almostStrictCompare2LCs lc1 lc2
-
-infixr 9 `lazyCompare2LCs`
--- | Won't refine refinables. According to 2nd assumption of the module:
---
--- @'refinableC' (m, _) \`lazyCompare2LCs\` 'preciseC' n@
---
--- equals to @Just GT@ if @m > n@ , and @Nothing@ otherwise.
-lazyCompare2LCs :: LazyCardinality -> LazyCardinality -> Maybe Ordering
-lazyCompare2LCs a b =
-  let reverseOrdering :: Maybe Ordering -> Maybe Ordering
-      reverseOrdering (Just GT) = (Just LT)
-      reverseOrdering (Just LT) = (Just GT)
-      reverseOrdering (Just EQ) = (Just EQ)
-      reverseOrdering Nothing = Nothing
-   in case (a,b) of
-         (InfiniteC , InfiniteC) -> Just EQ
-         (InfiniteC , _        ) -> Just GT
-         (_         , InfiniteC) -> Just LT -- !!! even though 'refinableC' may return 'infiniteC' !!!
-         (PreciseC m, PreciseC   n) -> Just (m `compare` n)
-         ----------------------------
-         (RefinableC crs@(m, _), PreciseC      n) -> case m > n of { True -> Just GT; False -> Nothing }
-         (PreciseC      n, RefinableC crs@(m, _)) -> case m > n of { True -> Just LT; False -> Nothing }
-         _ -> Nothing
-
--- | Used for Show typeclass instaniation. Here @'refinableC'@ isn't refined.
-showLazy :: LazyCardinality -> String
-showLazy lc =
-        case lc of
-            InfiniteC -> "infiniteC"
-            PreciseC c -> "preciseC " ++ show c
-            RefinableC (c, _) -> "Refinable (" ++ show c ++ ", refine_f)"
-
--- | Here @ 'refineCRS_TillEnd'@ is applied to @'refinableC'@ argument.
-showStrict :: LazyCardinality -> String
-showStrict lc =
-        case lc of
-            InfiniteC -> "infiniteC"
-            PreciseC c -> "preciseC " ++ show c
-            RefinableC crs -> show $ refineCRS_TillEnd crs
-
-instance Show LazyCardinality where
-        show = showLazy
-
---------------------------------------------------------------
--- * Application
-
--- | @HasCard@ = \"Has cardinality\". In other words, \"it's possible to measure
--- current count of elements for this container\"
-class HasCard a where
-     cardOf :: a -> LazyCardinality
-
--- | @HasCardT@ = \"Has cardinality (for container types of kind @(* -> *)@)\".
--- In other words, \"it's possible to measure
--- current count of elements for this container (for container types of
--- kind @(* -> *)@)\"
-class HasCardT t where
-     cardOfT :: t elem -> LazyCardinality
-
---------------------------------------------------------------
---------------------------------------------------------------
--- * Instances
-
--- ** Cardinality = 0
-
-cardOf_Unity :: () -> LazyCardinality
-cardOf_Unity _ = preciseC 0
-instance HasCard () where
-        cardOf = cardOf_Unity
-
-cardOf_EmptySet :: EmptySet a -> LazyCardinality
-cardOf_EmptySet _ = preciseC 0
-instance HasCard (EmptySet a) where
-        cardOf = cardOf_EmptySet
-instance HasCardT EmptySet where
-        cardOfT = cardOf_EmptySet
-
--- ** Cardinality = 1
-{-
-cardOf_Identity0 :: a -> LazyCardinality
-cardOf_Identity0 _ = preciseC 1
-instance HasCard a where
-        cardOf = cardOf_Identity0
--}
-cardOf_Identity1 :: Identity a -> LazyCardinality
-cardOf_Identity1 _ = preciseC 1
-instance HasCard (Identity a) where
-        cardOf = cardOf_Identity1
-instance HasCardT Identity where
-        cardOfT = cardOf_Identity1
-
--- ** Cardinality = 0..1
-cardOf_Maybe :: Maybe a -> LazyCardinality
-cardOf_Maybe Nothing  = preciseC 0
-cardOf_Maybe (Just _) = preciseC 1
-instance HasCard (Maybe a) where
-        cardOf = cardOf_Maybe
-instance HasCardT Maybe where
-        cardOfT = cardOf_Maybe
-
--- ** Cardinality = 0..N
-
--- | Refinable starting from 0, uses @'length2'@
-cardOf_List :: [a] -> LazyCardinality
-cardOf_List l = refinableC (0, \ sofar refine_while -> length2 l sofar refine_while)
-instance HasCard [a] where
-        cardOf = cardOf_List
-instance HasCardT ([]) where
-        cardOfT = cardOf_List
-
--- | Not refinable, since @'Data.Map.Map'@ is a strict structure.
-cardOf_Map :: Map k e -> LazyCardinality
-cardOf_Map = preciseC . fromIntegral . M.size
-instance HasCard (Map k e) where
-        cardOf = cardOf_Map
-instance HasCardT (Map k) where
-        cardOfT = cardOf_Map
-
--- ** Cardinality = 1..N
-
--- | Refinable starting from 1.
-cardOf_NeverEmptyList :: NeverEmptyList k -> LazyCardinality
-cardOf_NeverEmptyList (NEL _ l) = 1 `addPCToLC` cardOf l
-instance HasCard (NeverEmptyList a) where
-        cardOf = cardOf_NeverEmptyList
-instance HasCardT NeverEmptyList where
-        cardOfT = cardOf_NeverEmptyList
-
--- Other instances
-
-instance HasCardT ((,) key) where { cardOfT _ = preciseC 1 } -- this messes up things, in the context of HasCard (a,a) instance...
-
-instance HasCard (a,a) where { cardOf _ = preciseC 2 }
-instance HasCard (a,a,a) where { cardOf _ = preciseC 3 }
-instance HasCard (a,a,a,a) where { cardOf _ = preciseC 4 }
-instance HasCard (a,a,a,a,a) where { cardOf _ = preciseC 5 }
-instance HasCard (a,a,a,a,a,a) where { cardOf _ = preciseC 6 }
-instance HasCard (a,a,a,a,a,a,a) where { cardOf _ = preciseC 7 }
-instance HasCard (a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 8 }
-instance HasCard (a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 9 }
-instance HasCard (a,a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 10 }
-instance HasCard (a,a,a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 11 }
-instance HasCard (a,a,a,a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 12 }
-
---------------------------------------------------------------
--- * Helpers
-
--- type ContinueRefiningCardinalityUntil  =
---              CurrentNotFinalPreciseCardinality
---           -> (CurrentNotFinalPreciseCardinality -> ContinueCounting_DoWe)
---           -> LazyCardinality
-
-
--- | List length of controlable greediness.
-length2 :: [a] -> ContinueRefiningCardinalityUntil
-length2 l !sofar p =
-        case _length2 l sofar of
-            (i,            Nothing) -> preciseC i
-            (i, Just new_ref_while) -> RefinableC (i, new_ref_while)
-     where
-        _length2 :: [a] -> CurrentNotFinalPreciseCardinality
-                 -> ( BoundaryPreciseCardinality
-                    , Maybe ContinueRefiningCardinalityUntil
-                    )
-        _length2      [] !_sofar = (_sofar, Nothing)
-        _length2 l@(_:t) !_sofar =
-            let next_sofar = _sofar + 1
-             in case p next_sofar of
-                    False -> (_sofar, Just (length2 l))
-                    True  -> _length2 t next_sofar
-
-fst3  :: (a,b,c) -> a
-snd3  :: (a,b,c) -> b
-thrd3 :: (a,b,c) -> c
-fst3  (a,_,_) = a
-snd3  (_,b,_) = b
-thrd3 (_,_,c) = c
+import Data.Cardinality.Cardinality
+import Data.Cardinality.CardinalityRange
+import Data.Cardinality.ContTrans

@@ -0,0 +1,537 @@+{-
+Copyright (C) 2010 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>
+
+All rights reserved.
+
+For license and copyright information, see the file COPYRIGHT
+
+-}
+
+--------------------------------------------------------------------------
+--------------------------------------------------------------------------
+
+{-# LANGUAGE BangPatterns, FlexibleInstances  #-}
+
+-- | Two main assumptions (and constraints) of this module:
+--
+-- (1) Cardinality can't be negative.
+--
+-- (2) For @'refinableC'@ construction it is always refined by growing. F.e.,
+-- if @'refinableC' (7, ref_f_1)@ refines to @'refinableC' (x, ref_f_2)@, then
+-- @x@ SHOULD NEVER be less then @7@.
+-- On this assumption relies heavily functions @'lazyIsZeroLC'@,
+-- @'lazyCompare2LCs'@, @'addLCToLC'@ and also almost every refinement routine.
+module Data.Cardinality.Cardinality (
+              -- * Core
+                PreciseCardinality
+              , CurrentNotFinalPreciseCardinality
+              , BoundaryPreciseCardinality
+              , ContinueCounting_DoWe
+              , ContinueRefiningCardinalityUntil
+              , CardinalityRefinementState
+              , LazyCardinality
+              , infiniteC
+              , preciseC
+              , refinableC
+              , lazyIsZeroLC
+              , refinementState
+              , addPCToLC
+              , addLCToLC
+              , sumLCs
+              , refineCRS_Till
+              , refineCRS_TillOneAbove
+              , refineCRS_TillOneBelow
+              , crsRefinementStep
+              , refineCRS_TillEnd
+              , refineTill
+              , refineTillOneAbove
+              , refineTillOneBelow
+              , refinementStep
+              , refineTillEnd
+              , equalize2Refinements
+              , compare2Refinements
+              , almostStrictCompare2LCs
+              , lazyCompare2LCs
+              , showLazy
+              , showStrict
+
+              -- * Application
+              , HasCard(..)
+              , HasCardT(..)
+
+              -- * Instances
+              -- ** Cardinality = 0
+              , cardOf_Unity
+              , cardOf_EmptySet
+              -- ** Cardinality = 1
+              -- , cardOf_Identity0
+              , cardOf_Identity1
+              -- ** Cardinality = 0..1
+              , cardOf_Maybe
+              -- ** Cardinality = 0..Inf
+              , cardOf_List
+              , cardOf_Map
+              -- ** Cardinality = 1..Inf
+              , cardOf_NeverEmptyList
+
+              -- * Helpers
+              , length2
+              ) where
+
+import Data.EmptySet
+import Data.NeverEmptyList
+import qualified Data.Map as M
+import Data.Map (Map, (!))
+import Data.Word
+import Data.Typeable
+import Control.Monad.Identity
+
+--------------------------------------------------------------
+-- * Core
+
+-- | Count of elements in container. It's always positive or zero.
+--
+-- It would be best here to use @'Word32'@ instead, however, with @Integer@
+-- it's easier to catch the error of going down below zero (in case
+-- of @'Word32' 0-1==4294967295@ ).
+--
+-- However it is decided not to allow the direct use of @'PreciseC'@ data
+-- constructor, but to wrap it into function @'preciseC'@, which guards from
+-- the attemts to conctruct negative cardinality (by throwing an error).
+type PreciseCardinality                = Integer
+type CurrentNotFinalPreciseCardinality = PreciseCardinality
+type BoundaryPreciseCardinality        = CurrentNotFinalPreciseCardinality
+type ContinueCounting_DoWe             = Bool
+-- | An example of this is @'length2'@ function.
+type ContinueRefiningCardinalityUntil  = CurrentNotFinalPreciseCardinality -> (CurrentNotFinalPreciseCardinality -> ContinueCounting_DoWe) -> LazyCardinality
+type CardinalityRefinementState        = (CurrentNotFinalPreciseCardinality, ContinueRefiningCardinalityUntil)
+
+-- | In other words: count of elements in a container,
+-- with an opportunity not to refine the whole content of the container
+-- (and the container's structure).
+--
+-- Constructors:
+--
+-- * @'infiniteC'@
+--
+-- * @'preciseC' 'PreciseCardinality'@
+--
+-- * @'refinableC' 'CardinalityRefinementState'@
+data LazyCardinality =
+          InfiniteC
+        | PreciseC PreciseCardinality
+        | RefinableC CardinalityRefinementState
+      deriving (Typeable)
+
+-- | @'LazyCardinality'@ constructor.
+--
+-- F.e., @[1..]@ list has such cardinality.
+infiniteC :: LazyCardinality
+infiniteC = InfiniteC
+
+-- | @'LazyCardinality'@ constructor. If given negative value, raises error.
+--
+-- F.e., the tuple @(5,6)@ has a precise cardinality 2.
+preciseC :: PreciseCardinality -> LazyCardinality
+preciseC c = case c < 0 of { True -> error ("Can't construct negative cardinality '" ++ show c ++ "' "); False -> PreciseC c }
+
+-- | @'LazyCardinality'@ constructor.
+--
+-- For lists it happens, that we do not want to count all the elements
+-- of a container,
+-- but want to count them until some lower boundary. For example,
+-- I do not want to know the length of the list (which involves taking
+-- each element of it, and counting it in) to reason about whether
+-- it's content fit into the @(,,)@ data constructor. For this
+-- case I only need to count till 3rd element and check, if list is
+-- continued. It's actual especially, when dealing with infinite lists
+-- or with lists, whose reading may block.
+--
+-- For @(refinableC (x0, refine_f))@ important rules:
+--
+-- 1. If @(refine_f x0 (<= 5))@ evaluates to another @refinableC@, then
+-- it is not fully refined, but (at least) @5@ is achieved (the precise
+-- cardinality is @>= 5@).
+--
+-- 2. If @x0@ is @10@ and @(refine_f 10 (<= 15))@ returned
+-- @(refinableC (17, refine_f_2))@, then it is known, that precise
+-- cardinality is already >= @10 + 7@. In sight of @refine_f@ there
+-- SHOULD be everything except for what's already counted in @x0@
+-- (which is @10@), and in sight of @refine_f_2@ there should be even
+-- less by @7@ elements comparing to @refine_f@. So if total cardinality was
+-- @25@, then @(refine_f_2 17 (<= 30))@ MUST return @preciseC 25@, to make
+-- @10 + 7 + 8 = 25@.
+--
+-- 3. The theatment of the first argument of refinement function @refine_f@
+-- must be relative. For example, given total count of elements @= 25@ ,
+-- and @x0 = 20@ - these 20 elements are already counted, and in sight of
+-- @refine_f@ there are only 5 last elements.
+-- Then @refine_f 20 (<= 26)@ will result in @preciseC 25@, but(!)
+-- @refine_f 10 (<= 16)@ MUST result in @preciseC 15@.
+--
+-- Recomendations:
+--
+-- 1. If subject has infinite cardinality, it's best to determine
+-- it's cardinality as @'infiniteC'@ at early stages and
+-- avoid using @refinableC@ for it.
+refinableC :: CardinalityRefinementState -> LazyCardinality
+refinableC = RefinableC
+
+lcIsInfinite :: LazyCardinality -> Bool
+lcIsInfinite InfiniteC = True
+lcIsInfinite         _ = False
+
+preciseOfLC :: LazyCardinality -> Maybe PreciseCardinality
+preciseOfLC (PreciseC c) = Just c
+preciseOfLC            _ = Nothing
+
+-- | Returns @Nothing@, ONLY if LC is @'refinableC' (0, _)@
+-- (according to 2nd assumption of the module). Returns @Just True@
+-- only for @'preciseC' 0@.
+lazyIsZeroLC :: LazyCardinality -> Maybe Bool
+lazyIsZeroLC (PreciseC c)        = Just (c == 0)
+lazyIsZeroLC InfiniteC           = Just False
+lazyIsZeroLC (RefinableC (c, _)) = case c `compare` 0 of { EQ -> Nothing; _ -> Just False }
+
+refinementState :: LazyCardinality -> Maybe CardinalityRefinementState
+refinementState (RefinableC rs) = Just rs
+refinementState               _ = Nothing
+
+infixr 6 `addPCToLC`
+-- Throws an error if @'preciseC'@ is attempted to construct with negative
+-- resulting cardinality.
+addPCToLC :: PreciseCardinality -> LazyCardinality -> LazyCardinality
+addPCToLC n lc =
+        case lc of
+            InfiniteC -> lc
+            PreciseC m -> preciseC (m + n)
+            RefinableC (c, ref_while) -> refinableC (c + n, ref_while)
+
+infixr 6 `addLCToLC`
+-- | For case when adding up 2 refinables, if both of them sooner or later
+-- refines to @'infiniteC'@, then one that returns infinity earlier is
+-- recommended to put as a first term. Infinity + any LazyCardinality
+-- = infinity. Another recommendation would be to put
+-- refinable that's easier to compute as a first term.
+addLCToLC :: LazyCardinality -> LazyCardinality -> LazyCardinality
+addLCToLC lc_1 lc_2 =
+        case (lc_1, lc_2) of
+            (InfiniteC, _) -> InfiniteC
+            (_, InfiniteC) -> InfiniteC
+            (PreciseC m, PreciseC n) -> preciseC (m + n)
+            (PreciseC m, RefinableC (c, ref_while)) -> refinableC (c + m, ref_while)
+            (RefinableC (c, ref_while), PreciseC m) -> refinableC (c + m, ref_while)
+            (RefinableC (c, ref_while_1), RefinableC (d, ref_while_2)) -> refinableC (c + d, refWhileSyn ref_while_1 ref_while_2)
+     where
+        refWhileSyn :: ContinueRefiningCardinalityUntil -> ContinueRefiningCardinalityUntil -> ContinueRefiningCardinalityUntil
+        refWhileSyn ref_while_1 ref_while_2 =
+                (\ sofar stop_cond ->
+                        case ref_while_1 sofar stop_cond of
+                            InfiniteC  -> InfiniteC
+                            RefinableC (sofar_2, ref_while_1_2) -> RefinableC (sofar_2, refWhileSyn ref_while_1_2 ref_while_2)
+                            PreciseC c ->
+                                case ref_while_1 (sofar + c) stop_cond of
+                                    InfiniteC  -> InfiniteC
+                                    RefinableC (sofar_3, ref_while_2_2) -> RefinableC (sofar_3, ref_while_2_2)
+                                    PreciseC final_c -> PreciseC final_c
+                )
+
+-- | @foldl 'addLCToLC'@
+--
+-- See recommendations by @'addLCToLC'@.
+sumLCs :: [LazyCardinality] -> LazyCardinality
+sumLCs = foldl addLCToLC (preciseC 0)
+
+refineCRS_Till :: CardinalityRefinementState -> BoundaryPreciseCardinality -> LazyCardinality
+refineCRS_Till crs@(c, ref_while) n =
+                 case c >= n of
+                     True  -> refinableC crs
+                     False -> ref_while c (<= n)
+-- [1,2,3,4,5,6,7,8,9,10]
+-- refineCRS_Till (refinableC (5, ref_while)) 8
+-- ref_while sees [6,7,8,9,10]
+-- ref_while (<= 8 - 5) -> ref_while (<= 3) -> refinableC (8, ref_while'))
+-- ref_while' sees [9, 10]
+
+refineCRS_TillOneAbove :: CardinalityRefinementState -> BoundaryPreciseCardinality -> LazyCardinality
+refineCRS_TillOneBelow :: CardinalityRefinementState -> BoundaryPreciseCardinality -> LazyCardinality
+refineCRS_TillOneAbove crs n = refineCRS_Till crs (n + 1)
+refineCRS_TillOneBelow crs n = refineCRS_Till crs (n - 1)
+
+crsRefinementStep :: CardinalityRefinementState -> LazyCardinality
+crsRefinementStep crs@(c, ref_while) = ref_while c (<= (c + 1))
+
+-- | Don't use it on infinite refinables not measured with 'infiniteC'.
+refineCRS_TillEnd :: CardinalityRefinementState -> LazyCardinality
+refineCRS_TillEnd crs@(c, ref_while) = ref_while c (const True)
+
+-- | Wrapper around @'refineCRS_Till'@.
+refineTill :: LazyCardinality -> BoundaryPreciseCardinality -> LazyCardinality
+refineTill lc n =
+         case lc of
+             RefinableC crs -> refineCRS_Till crs n
+             _ -> lc
+
+-- | Wrapper around @'refineTillOneAbove'@.
+refineTillOneAbove :: LazyCardinality -> BoundaryPreciseCardinality -> LazyCardinality
+-- | Wrapper around @'refineTillOneBelow'@.
+refineTillOneBelow :: LazyCardinality -> BoundaryPreciseCardinality -> LazyCardinality
+refineTillOneAbove lc n = case lc of { RefinableC crs -> refineCRS_Till crs (n + 1); _ -> lc }
+refineTillOneBelow lc n = case lc of { RefinableC crs -> refineCRS_Till crs (n - 1); _ -> lc }
+
+-- | Wrapper around @'crsRefinementStep'@.
+refinementStep :: LazyCardinality -> LazyCardinality
+refinementStep lc = case lc of { RefinableC crs -> crsRefinementStep crs ; _ -> lc }
+
+-- | Wrapper around @'refineCRS_TillEnd'@.
+refineTillEnd :: LazyCardinality -> LazyCardinality
+refineTillEnd lc = case lc of { RefinableC crs -> refineCRS_TillEnd crs ; _ -> lc }
+
+-- | For @equalize2Refinements (m, ref_f_1) (n, ref_f_2)@ finishes when m == n.
+-- Else refines them. Another termination condition is when in result of
+-- refinement one of cardinalities becomes final (not @'refinableC'@).
+equalize2Refinements :: CardinalityRefinementState -> CardinalityRefinementState -> (LazyCardinality, LazyCardinality)
+equalize2Refinements crs1@(m, ref_f_1) crs2@(n, ref_f_2) =
+        case m `compare` n of
+            LT -> let lc_of_crs1_refined = ref_f_1 m (<= n)
+                   in case refinementState lc_of_crs1_refined of
+                          Nothing -> (lc_of_crs1_refined, refinableC crs2)
+                          Just crs1_refined -> equalize2Refinements crs1_refined crs2
+            EQ -> (refinableC crs1, refinableC crs2)
+            GT -> let lc_of_crs2_refined = ref_f_2 n (<= m)
+                   in case refinementState lc_of_crs2_refined of
+                          Nothing -> (refinableC crs1, lc_of_crs2_refined)
+                          Just crs2_refined -> equalize2Refinements crs1 crs2_refined
+
+compare2Refinements :: CardinalityRefinementState -> CardinalityRefinementState -> (Ordering, LazyCardinality, LazyCardinality)
+compare2Refinements crs1@(m, _) crs2@(n, _) =
+        let cards = equalize2Refinements crs1 crs2
+         in case cards of
+                (lc1_2@(RefinableC crs1_2), lc2_2@(RefinableC crs2_2)) -> -- m == n
+                      let lc1_3 = crsRefinementStep crs1_2
+                       in case lc1_3 of -- I could have made crsRefinementStep for both in tuple here, but let's keep it as lazy as possible
+                              RefinableC crs1_3 ->
+                                  let lc2_3 = crsRefinementStep crs2_2
+                                   in case lc2_3 of
+                                          RefinableC crs2_3 -> compare2Refinements crs1_3 crs2_3
+                                          _ -> almostStrictCompare2LCs lc1_3 lc2_3
+                              _ -> almostStrictCompare2LCs lc1_3 lc2_2
+                _ -> uncurry almostStrictCompare2LCs cards
+
+infixr 9 `almostStrictCompare2LCs`
+-- | Used for instance of Ord typeclass.
+--
+-- Together with @'Ordering'@ returns also probably refined cardinalities
+-- for reuse.
+--
+-- WARNING!!! When comparing @'refinableC'@ with @'infiniteC'@
+-- , it results in @'LT'@ (less than)!
+-- While comparing @'infiniteC' \`almostStrictCompare2LCs\` 'infiniteC' ==
+-- 'EQ'@.
+-- That's the reason for an /almost-/ prefix in function name.
+-- If there is a probability that refinement of
+-- @'refinableC'@ may evaluate to @'infiniteC'@, and it's important to you,
+-- that infinities are equal, then before comparing this refinable,
+-- use 'refineCRS_TillEnd' on it. That's laziness.
+--
+-- Trying to compare 2 @'refinableC'@s that are actually infinite, but don't
+-- use @'infiniteC'@ will hang
+-- the system (the same as if you try to determine length of an infinite
+-- list).
+almostStrictCompare2LCs :: LazyCardinality -> LazyCardinality -> (Ordering, LazyCardinality, LazyCardinality)
+almostStrictCompare2LCs a b =
+  let reverseOrdering :: (Ordering, LazyCardinality, LazyCardinality) -> (Ordering, LazyCardinality, LazyCardinality)
+      reverseOrdering (GT, a, b) = (LT, b, a)
+      reverseOrdering (LT, a, b) = (GT, b, a)
+      reverseOrdering (EQ, a, b) = (EQ, b, a)
+   in case (a,b) of
+         (InfiniteC , InfiniteC) -> (EQ, a, b)
+         (InfiniteC , _        ) -> (GT, a, b)
+         (_         , InfiniteC) -> (LT, a, b) -- !!! even though 'refinableC' may return 'infiniteC' !!!
+         (PreciseC m, PreciseC   n) -> (m `compare` n, a, b)
+         ----------------------------
+         (RefinableC crs@(m, _), PreciseC      n) -> case m > n of { True -> (GT, a, b); False -> almostStrictCompare2LCs (refineCRS_TillOneAbove crs n) b }
+         (RefinableC       crs1, RefinableC crs2) -> compare2Refinements crs1 crs2
+         (_                    , RefinableC    _) -> reverseOrdering $ almostStrictCompare2LCs b a
+
+instance Eq LazyCardinality where
+        lc1 == lc2 = (fst3 $ almostStrictCompare2LCs lc1 lc2) == EQ
+
+instance Ord LazyCardinality where
+        lc1 `compare` lc2 = fst3 $ almostStrictCompare2LCs lc1 lc2
+
+infixr 9 `lazyCompare2LCs`
+-- | Won't refine refinables. According to 2nd assumption of the module:
+--
+-- @'refinableC' (m, _) \`lazyCompare2LCs\` 'preciseC' n@
+--
+-- equals to @Just GT@ if @m > n@ , and @Nothing@ otherwise.
+lazyCompare2LCs :: LazyCardinality -> LazyCardinality -> Maybe Ordering
+lazyCompare2LCs a b =
+  let reverseOrdering :: Maybe Ordering -> Maybe Ordering
+      reverseOrdering (Just GT) = (Just LT)
+      reverseOrdering (Just LT) = (Just GT)
+      reverseOrdering (Just EQ) = (Just EQ)
+      reverseOrdering Nothing = Nothing
+   in case (a,b) of
+         (InfiniteC , InfiniteC) -> Just EQ
+         (InfiniteC , _        ) -> Just GT
+         (_         , InfiniteC) -> Just LT -- !!! even though 'refinableC' may return 'infiniteC' !!!
+         (PreciseC m, PreciseC   n) -> Just (m `compare` n)
+         ----------------------------
+         (RefinableC crs@(m, _), PreciseC      n) -> case m > n of { True -> Just GT; False -> Nothing }
+         (PreciseC      n, RefinableC crs@(m, _)) -> case m > n of { True -> Just LT; False -> Nothing }
+         _ -> Nothing
+
+-- | Used for Show typeclass instaniation. Here @'refinableC'@ isn't refined.
+showLazy :: LazyCardinality -> String
+showLazy lc =
+        case lc of
+            InfiniteC -> "infiniteC"
+            PreciseC c -> "preciseC " ++ show c
+            RefinableC (c, _) -> "Refinable (" ++ show c ++ ", refine_f)"
+
+-- | Here @ 'refineCRS_TillEnd'@ is applied to @'refinableC'@ argument.
+showStrict :: LazyCardinality -> String
+showStrict lc =
+        case lc of
+            InfiniteC -> "infiniteC"
+            PreciseC c -> "preciseC " ++ show c
+            RefinableC crs -> show $ refineCRS_TillEnd crs
+
+instance Show LazyCardinality where
+        show = showLazy
+
+--------------------------------------------------------------
+-- * Application
+
+-- | @HasCard@ = \"Has cardinality\". In other words, \"it's possible to measure
+-- current count of elements for this container\"
+class HasCard a where
+     cardOf :: a -> LazyCardinality
+
+-- | @HasCardT@ = \"Has cardinality (for container types of kind @(* -> *)@)\".
+-- In other words, \"it's possible to measure
+-- current count of elements for this container (for container types of
+-- kind @(* -> *)@)\"
+class HasCardT t where
+     cardOfT :: t elem -> LazyCardinality
+
+--------------------------------------------------------------
+--------------------------------------------------------------
+-- * Instances
+
+-- ** Cardinality = 0
+
+cardOf_Unity :: () -> LazyCardinality
+cardOf_Unity _ = preciseC 0
+instance HasCard () where
+        cardOf = cardOf_Unity
+
+cardOf_EmptySet :: EmptySet a -> LazyCardinality
+cardOf_EmptySet _ = preciseC 0
+instance HasCard (EmptySet a) where
+        cardOf = cardOf_EmptySet
+instance HasCardT EmptySet where
+        cardOfT = cardOf_EmptySet
+
+-- ** Cardinality = 1
+{-
+cardOf_Identity0 :: a -> LazyCardinality
+cardOf_Identity0 _ = preciseC 1
+instance HasCard a where
+        cardOf = cardOf_Identity0
+-}
+cardOf_Identity1 :: Identity a -> LazyCardinality
+cardOf_Identity1 _ = preciseC 1
+instance HasCard (Identity a) where
+        cardOf = cardOf_Identity1
+instance HasCardT Identity where
+        cardOfT = cardOf_Identity1
+
+-- ** Cardinality = 0..1
+cardOf_Maybe :: Maybe a -> LazyCardinality
+cardOf_Maybe Nothing  = preciseC 0
+cardOf_Maybe (Just _) = preciseC 1
+instance HasCard (Maybe a) where
+        cardOf = cardOf_Maybe
+instance HasCardT Maybe where
+        cardOfT = cardOf_Maybe
+
+-- ** Cardinality = 0..N
+
+-- | Refinable starting from 0, uses @'length2'@
+cardOf_List :: [a] -> LazyCardinality
+cardOf_List l = refinableC (0, \ sofar refine_while -> length2 l sofar refine_while)
+instance HasCard [a] where
+        cardOf = cardOf_List
+instance HasCardT ([]) where
+        cardOfT = cardOf_List
+
+-- | Not refinable, since @'Data.Map.Map'@ is a strict structure.
+cardOf_Map :: Map k e -> LazyCardinality
+cardOf_Map = preciseC . fromIntegral . M.size
+instance HasCard (Map k e) where
+        cardOf = cardOf_Map
+instance HasCardT (Map k) where
+        cardOfT = cardOf_Map
+
+-- ** Cardinality = 1..N
+
+-- | Refinable starting from 1.
+cardOf_NeverEmptyList :: NeverEmptyList k -> LazyCardinality
+cardOf_NeverEmptyList (NEL _ l) = 1 `addPCToLC` cardOf l
+instance HasCard (NeverEmptyList a) where
+        cardOf = cardOf_NeverEmptyList
+instance HasCardT NeverEmptyList where
+        cardOfT = cardOf_NeverEmptyList
+
+-- Other instances
+
+instance HasCardT ((,) key) where { cardOfT _ = preciseC 1 } -- this messes up things, in the context of HasCard (a,a) instance...
+
+instance HasCard (a,a) where { cardOf _ = preciseC 2 }
+instance HasCard (a,a,a) where { cardOf _ = preciseC 3 }
+instance HasCard (a,a,a,a) where { cardOf _ = preciseC 4 }
+instance HasCard (a,a,a,a,a) where { cardOf _ = preciseC 5 }
+instance HasCard (a,a,a,a,a,a) where { cardOf _ = preciseC 6 }
+instance HasCard (a,a,a,a,a,a,a) where { cardOf _ = preciseC 7 }
+instance HasCard (a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 8 }
+instance HasCard (a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 9 }
+instance HasCard (a,a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 10 }
+instance HasCard (a,a,a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 11 }
+instance HasCard (a,a,a,a,a,a,a,a,a,a,a,a) where { cardOf _ = preciseC 12 }
+
+--------------------------------------------------------------
+-- * Helpers
+
+-- type ContinueRefiningCardinalityUntil  =
+--              CurrentNotFinalPreciseCardinality
+--           -> (CurrentNotFinalPreciseCardinality -> ContinueCounting_DoWe)
+--           -> LazyCardinality
+
+
+-- | List length of controlable greediness.
+length2 :: [a] -> ContinueRefiningCardinalityUntil
+length2 l !sofar p =
+        case _length2 l sofar of
+            (i,            Nothing) -> preciseC i
+            (i, Just new_ref_while) -> RefinableC (i, new_ref_while)
+     where
+        _length2 :: [a] -> CurrentNotFinalPreciseCardinality
+                 -> ( BoundaryPreciseCardinality
+                    , Maybe ContinueRefiningCardinalityUntil
+                    )
+        _length2      [] !_sofar = (_sofar, Nothing)
+        _length2 l@(_:t) !_sofar =
+            let next_sofar = _sofar + 1
+             in case p next_sofar of
+                    False -> (_sofar, Just (length2 l))
+                    True  -> _length2 t next_sofar
+
+fst3  :: (a,b,c) -> a
+snd3  :: (a,b,c) -> b
+thrd3 :: (a,b,c) -> c
+fst3  (a,_,_) = a
+snd3  (_,b,_) = b
+thrd3 (_,_,c) = c

@@ -0,0 +1,222 @@+{-
+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.CardinalityRange (
+                -- * Core
+                CardinalityRange_From
+              , CardinalityRange_To
+              , CardinalityRange
+              , cardinalityRange
+              , cr2Tuple
+              , lazyVerfyCR
+              , cFitsInCR_Proto
+              , cFitsInCR
+              , fitsInCR
+              , fitsInCR_T
+              , FirstOrSecond(..)
+              , Compare2CRsError(..)
+              , compare2CRs
+              , crFitsInCR
+
+              -- * Popular cardinality ranges constructors
+              , crNoConstraint
+              , cr0
+              , cr1
+              , cr0_1
+              , cr0_Inf
+              , cr1_Inf
+              , crX
+              , crXY
+              ) where
+
+import Data.Cardinality.Cardinality
+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
+
+--------------------------------------------------------------
+-- * Core
+
+type CardinalityRange_From = LazyCardinality
+type CardinalityRange_To   = LazyCardinality
+-- | Constructor: @'cardinalityRange' 'CardinalityRange_From' 'CardinalityRange_To'@
+data CardinalityRange = CardinalityRange CardinalityRange_From CardinalityRange_To deriving (Show)
+
+-- | @CardinalityRange@ data constructor. The range is always including it's
+-- boundaries. F.e., range
+-- @'CardinalityRange' ('preciseC' 1) ('preciseC' 4)@ contains
+-- cardinalities [1,2,3,4].
+-- First cardinality MUST always be less or equal to second one. However,
+-- we do not fully guard from such type of error - we do not refine
+-- @'refinableC'@, if it participates in the constriction.
+cardinalityRange :: CardinalityRange_From -> CardinalityRange_To -> CardinalityRange
+cardinalityRange from to =
+        case lazyVerfyCR from to of
+            Just False -> error $ "Cardinality range can't be constructed with lower boundary higher than lower one (" ++ show from ++ ", "++ show to ++ ")."
+            _ -> CardinalityRange from to
+
+cr2Tuple :: CardinalityRange -> (CardinalityRange_From, CardinalityRange_From)
+cr2Tuple (CardinalityRange from to) = (from, to)
+
+lazyVerfyCR :: CardinalityRange_From -> CardinalityRange_To -> Maybe Bool
+lazyVerfyCR from to = lazyCompare2LCs from to >>= return . (/= GT)
+
+-- | Root prototype for all subsequent \"FitsIn\" functions. Returns probably
+-- refined cardinality and range, which is useful for reuse.
+-- If returns @EQ@ then subject cardinality
+-- is between boundaries (including) of cardinality range.
+--
+-- Uses @'almostStrictCompare2LCs'@ function.
+cFitsInCR_Proto :: LazyCardinality -> CardinalityRange -> (Ordering, LazyCardinality, CardinalityRange)
+cFitsInCR_Proto c (CardinalityRange lo_c hi_c) =
+        let (ord1, c_2, lo_c_2) = c `almostStrictCompare2LCs` lo_c
+         in case ord1 of
+                LT -> (ord1, c_2, cardinalityRange lo_c_2 hi_c)
+                _  -> let (ord2, c_3, hi_c_2) = c_2 `almostStrictCompare2LCs` hi_c
+                          ord3 = case ord2 of { GT -> GT; _ -> EQ }
+                       in (ord3, c_3, cardinalityRange lo_c_2 hi_c_2)
+infixr 9 `cFitsInCR_Proto`
+
+-- | @'LazyCardinality'@ fits in @'CardinalityRange'@?
+cFitsInCR :: LazyCardinality -> CardinalityRange -> Bool
+cFitsInCR c cr = fst3 (c `cFitsInCR_Proto` cr) == EQ
+        where fst3 (a,_,_) = a
+infixr 9 `cFitsInCR`
+
+-- | Wrapper around @'cFitsInCR'@.
+fitsInCR :: HasCard a => a -> CardinalityRange -> Bool
+fitsInCR hasC cr = cardOf hasC `cFitsInCR` cr
+infixr 9 `fitsInCR`
+
+-- | Wrapper around @'cFitsInCR'@.
+fitsInCR_T :: HasCardT c => c a -> CardinalityRange -> Bool
+fitsInCR_T hasC cr = cardOfT hasC `cFitsInCR` cr
+infixr 9 `fitsInCR_T`
+
+-- | Used in @'Compare2CRsError'@
+data FirstOrSecond = First | Second deriving (Show)
+-- | Error, that may occur, when performing @'compare2CRs'@
+data Compare2CRsError = LowerBoundaryAfterHigher FirstOrSecond CardinalityRange
+instance Show Compare2CRsError where
+        show e = "An error occurred when trying to compare 2 cardinality ranges: " ++
+            case e of
+                LowerBoundaryAfterHigher fs cr -> show fs ++ " cardinality range (" ++ show cr ++ ") is ill defined - lower boundary is greater then higher one."
+
+-- | This function is made hard, but fast. It tends to make minimal amount
+-- of comparisons, reusing refinements.
+compare2CRs :: CardinalityRange -> CardinalityRange -> (Either Compare2CRsError (SetsFit CardinalityRange), CardinalityRange, CardinalityRange)
+compare2CRs (CardinalityRange lo_cr1_0 hi_cr1_0) (CardinalityRange lo_cr2_0 hi_cr2_0) =
+        let step1@(order1, hi_cr1_1, lo_cr2_1) = almostStrictCompare2LCs hi_cr1_0 lo_cr2_0 -- 1: 0 1 1 0
+         in case order1 of -- traceShow ("Step 1: ", step1)
+                 LT -> (Right NoIntersection, CardinalityRange lo_cr1_0 hi_cr1_1, CardinalityRange lo_cr2_1 hi_cr2_0)
+                 EQ -> let step2@(order2, lo_cr1_1, hi_cr1_2) = almostStrictCompare2LCs lo_cr1_0 hi_cr1_1 -- 2: 1 2 1 0
+                           cr1_2 = CardinalityRange lo_cr1_1 hi_cr1_2
+                           cr2_2 = CardinalityRange lo_cr2_1 hi_cr2_0
+                           answ_2 err_or_fit = (err_or_fit, cr1_2, cr2_2)
+                        in case order2 of -- traceShow ("Step 2: ", step2)
+                               LT -> let step21@(order21, lo_cr2_2, hi_cr2_1) = almostStrictCompare2LCs lo_cr2_1 hi_cr2_0 -- 21: 1 2 2 1
+                                         cr1_21 = CardinalityRange lo_cr1_1 hi_cr1_2
+                                         cr2_21 = CardinalityRange lo_cr2_2 hi_cr2_1
+                                         answ_21 err_or_fit = (err_or_fit, cr1_21, cr2_21)
+                                      in answ_21 $ case order21 of
+                                             EQ -> Right SecondInFirst
+                                             GT -> Right $ Intersection $ CardinalityRange hi_cr1_2 lo_cr2_2
+                                             LT -> Left $ LowerBoundaryAfterHigher Second cr2_21
+                               GT -> answ_2 $ Left $ LowerBoundaryAfterHigher First cr1_2
+                               EQ -> let step3@(order3, lo_cr2_2, hi_cr2_1) = almostStrictCompare2LCs lo_cr2_1 hi_cr2_0 -- 3: 1 2 2 1
+                                         cr1_3 = CardinalityRange lo_cr1_1 hi_cr1_2
+                                         cr2_3 = CardinalityRange lo_cr2_2 hi_cr2_1
+                                         answ_3 err_or_fit = (err_or_fit, cr1_3, cr2_3)
+                                      in answ_3 $ case order3 of -- traceShow ("Step 3: ", step3)
+                                             LT -> Right FirstInSecond
+                                             EQ -> Right EqualSets
+                                             GT -> Left $ LowerBoundaryAfterHigher First cr1_3
+                 GT -> let step4@(order4, lo_cr1_1, hi_cr2_1) = almostStrictCompare2LCs lo_cr1_0 hi_cr2_0  -- 4: 1 1 1 1
+                        in case order4 of
+                               GT -> (Right NoIntersection, CardinalityRange lo_cr1_1 hi_cr1_1, CardinalityRange lo_cr2_1 hi_cr2_1)
+                               EQ -> let step5@(order5, lo_cr2_2, hi_cr2_2) = almostStrictCompare2LCs lo_cr2_1 hi_cr2_1 -- 5: 1 1 2 2
+                                         cr1_5 = CardinalityRange lo_cr1_1 hi_cr1_1
+                                         cr2_5 = CardinalityRange lo_cr2_2 hi_cr2_2
+                                         answ_5 err_or_fit = (err_or_fit, cr1_5, cr2_5)
+                                      in case order5 of
+                                             LT -> let step51@(order51, lo_cr1_2, hi_cr1_2) = almostStrictCompare2LCs lo_cr1_1 hi_cr1_1 -- 51: 2 2 2 2
+                                                       cr1_51 = CardinalityRange lo_cr1_2 hi_cr1_2
+                                                       cr2_51 = CardinalityRange lo_cr2_2 hi_cr2_2
+                                                       answ_51 err_or_fit = (err_or_fit, cr1_51, cr2_51)
+                                                    in answ_51 $ case order51 of
+                                                             LT -> Left $ LowerBoundaryAfterHigher First cr1_51
+                                                             EQ -> Right FirstInSecond
+                                                             GT -> Right $ Intersection $ CardinalityRange lo_cr1_2 hi_cr2_2
+                                             EQ -> answ_5 $ Right SecondInFirst
+                                             GT -> answ_5 $ Left $ LowerBoundaryAfterHigher Second cr2_5
+                               LT -> let step6@(order6, lo_cr1_2, lo_cr2_2) = almostStrictCompare2LCs lo_cr1_1 lo_cr2_1 -- 6: 2 1 2 1
+                                         step7@(order7, hi_cr1_2, hi_cr2_2) = almostStrictCompare2LCs hi_cr1_1 hi_cr2_1 -- 7: 2 2 2 2
+                                         cr1_67 = CardinalityRange lo_cr1_2 hi_cr1_2
+                                         cr2_67 = CardinalityRange lo_cr2_2 hi_cr2_2
+                                         answ_67 _fit = (Right _fit, cr1_67, cr2_67)
+                                      in answ_67 $ case (order6, order7) of
+                                             (EQ, EQ) -> EqualSets
+                                             (EQ, GT) -> SecondInFirst
+                                             (LT, EQ) -> SecondInFirst
+                                             (LT, GT) -> SecondInFirst
+                                             (EQ, LT) -> FirstInSecond
+                                             (GT, LT) -> FirstInSecond
+                                             (GT, EQ) -> FirstInSecond
+                                             (LT, LT) -> Intersection $ CardinalityRange lo_cr2_2 hi_cr1_2
+                                             (GT, GT) -> Intersection $ CardinalityRange lo_cr1_2 hi_cr2_2
+
+instance Intersectable CardinalityRange where
+     setFits cr1 cr2 = case fst3 $ compare2CRs cr1 cr2 of { Right r -> r; Left e -> error $ show e }
+        where
+           fst3  :: (a,b,c) -> a
+           fst3  (a,_,_) = a
+
+-- | Wrapper around @'setFits'@ of typeclass @'Intersectable'@
+crFitsInCR :: CardinalityRange -> CardinalityRange -> SetsFit CardinalityRange
+crFitsInCR = setFits
+infixr 9 `crFitsInCR`
+
+-- * Popular cardinality ranges constructors.
+
+-- | Same as @'cr0_Inf'@.
+crNoConstraint :: CardinalityRange
+-- | Only zero elements.
+cr0            :: CardinalityRange
+-- | Only one element.
+cr1            :: CardinalityRange
+-- | Zero or one element.
+cr0_1          :: CardinalityRange
+-- | Any count of elements.
+cr0_Inf        :: CardinalityRange
+-- | Any nonzero count of elements.
+cr1_Inf        :: CardinalityRange
+-- | Concrete count of elements.
+crX            :: PreciseCardinality -> CardinalityRange
+-- | A concrete range.
+crXY           :: PreciseCardinality -> PreciseCardinality -> CardinalityRange
+
+crNoConstraint = cr0_Inf
+cr0            = cardinalityRange (preciseC 0) (preciseC 0)
+cr1            = cardinalityRange (preciseC 1) (preciseC 1)
+cr0_1          = cardinalityRange (preciseC 0) (preciseC 1)
+cr0_Inf        = cardinalityRange (preciseC 0) infiniteC
+cr1_Inf        = cardinalityRange (preciseC 1) infiniteC
+crX          x = cardinalityRange (preciseC x) (preciseC x)
+crXY       x y = cardinalityRange (preciseC x) (preciseC y)

@@ -0,0 +1,582 @@+{-
+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:[]) }

@@ -1,721 +0,0 @@-{-
-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.CardinalityRange (
-                -- * Core
-                CardinalityRange_From
-              , CardinalityRange_To
-              , CardinalityRange
-              , cardinalityRange
-              , cr2Tuple
-              , lazyVerfyCR
-              , cFitsInCR_Proto
-              , cFitsInCR
-              , fitsInCR
-              , fitsInCR_T
-              , FirstOrSecond(..)
-              , Compare2CRsError(..)
-              , compare2CRs
-              , crFitsInCR
-
-              -- * Popular cardinality ranges constructors
-              , crNoConstraint
-              , cr0
-              , cr1
-              , cr0_1
-              , cr0_Inf
-              , cr1_Inf
-              , crX
-              , crXY
-
-                -- * Application 1
-              , CardinalityConstraint
-              , cFitsInCC
-              , fitsInCC
-              , fitsInCC_T
-              , HasCardConstr(..)
-              , HasCardConstrT(..)
-              , cFitsIn
-              , cFitsInT
-              , fitsIn
-              , fitsInT
-
-                -- * Application 2
-              , HasCardUCT(..)
-              , HasCardUCT_T(..)
-              , TransformError_FromTypeName
-              , TransformError_ToTypeName
-              , TransformError_Details
-              , uContError
-              , uContErrorT
-              , sContTrans
-              , sContTransT
-                ) where
-
-import Data.Cardinality
-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
-
---------------------------------------------------------------
--- * Core
-
-type CardinalityRange_From = LazyCardinality
-type CardinalityRange_To   = LazyCardinality
--- | Constructor: @'cardinalityRange' 'CardinalityRange_From' 'CardinalityRange_To'@
-data CardinalityRange = CardinalityRange CardinalityRange_From CardinalityRange_To deriving (Show)
-
--- | @CardinalityRange@ data constructor. The range is always including it's
--- boundaries. F.e., range
--- @'CardinalityRange' ('preciseC' 1) ('preciseC' 4)@ contains
--- cardinalities [1,2,3,4].
--- First cardinality MUST always be less or equal to second one. However,
--- we do not fully guard from such type of error - we do not refine
--- @'refinableC'@, if it participates in the constriction.
-cardinalityRange :: CardinalityRange_From -> CardinalityRange_To -> CardinalityRange
-cardinalityRange from to =
-        case lazyVerfyCR from to of
-            Just False -> error $ "Cardinality range can't be constructed with lower boundary higher than lower one (" ++ show from ++ ", "++ show to ++ ")."
-            _ -> CardinalityRange from to
-
-cr2Tuple :: CardinalityRange -> (CardinalityRange_From, CardinalityRange_From)
-cr2Tuple (CardinalityRange from to) = (from, to)
-
-lazyVerfyCR :: CardinalityRange_From -> CardinalityRange_To -> Maybe Bool
-lazyVerfyCR from to = lazyCompare2LCs from to >>= return . (/= GT)
-
--- | Root prototype for all subsequent \"FitsIn\" functions. Returns probably
--- refined cardinality and range, which is useful for reuse.
--- If returns @EQ@ then subject cardinality
--- is between boundaries (including) of cardinality range.
-cFitsInCR_Proto :: LazyCardinality -> CardinalityRange -> (Ordering, LazyCardinality, CardinalityRange)
-cFitsInCR_Proto c (CardinalityRange lo_c hi_c) =
-        let (ord1, c_2, lo_c_2) = c `almostStrictCompare2LCs` lo_c
-         in case ord1 of
-                LT -> (ord1, c_2, cardinalityRange lo_c_2 hi_c)
-                _  -> let (ord2, c_3, hi_c_2) = c_2 `almostStrictCompare2LCs` hi_c
-                          ord3 = case ord2 of { GT -> GT; _ -> EQ }
-                       in (ord3, c_3, cardinalityRange lo_c_2 hi_c_2)
-infixr 9 `cFitsInCR_Proto`
-
--- | @'LazyCardinality'@ fits in @'CardinalityRange'@?
-cFitsInCR :: LazyCardinality -> CardinalityRange -> Bool
-cFitsInCR c cr = fst3 (c `cFitsInCR_Proto` cr) == EQ
-        where fst3 (a,_,_) = a
-infixr 9 `cFitsInCR`
-
--- | Wrapper around @'cFitsInCR'@.
-fitsInCR :: HasCard a => a -> CardinalityRange -> Bool
-fitsInCR hasC cr = cardOf hasC `cFitsInCR` cr
-infixr 9 `fitsInCR`
-
--- | Wrapper around @'cFitsInCR'@.
-fitsInCR_T :: HasCardT c => c a -> CardinalityRange -> Bool
-fitsInCR_T hasC cr = cardOfT hasC `cFitsInCR` cr
-infixr 9 `fitsInCR_T`
-
--- | Used in @'Compare2CRsError'@
-data FirstOrSecond = First | Second deriving (Show)
--- | Error, that may occur, when performing @'compare2CRs'@
-data Compare2CRsError = LowerBoundaryAfterHigher FirstOrSecond CardinalityRange
-instance Show Compare2CRsError where
-        show e = "An error occurred when trying to compare 2 cardinality ranges: " ++
-            case e of
-                LowerBoundaryAfterHigher fs cr -> show fs ++ " cardinality range (" ++ show cr ++ ") is ill defined - lower boundary is greater then higher one."
-
--- | This function is made hard, but fast. It tends to make minimal amount
--- of comparisons, reusing refinements.
-compare2CRs :: CardinalityRange -> CardinalityRange -> (Either Compare2CRsError (SetsFit CardinalityRange), CardinalityRange, CardinalityRange)
-compare2CRs (CardinalityRange lo_cr1_0 hi_cr1_0) (CardinalityRange lo_cr2_0 hi_cr2_0) =
-        let step1@(order1, hi_cr1_1, lo_cr2_1) = almostStrictCompare2LCs hi_cr1_0 lo_cr2_0 -- 1: 0 1 1 0
-         in case order1 of -- traceShow ("Step 1: ", step1)
-                 LT -> (Right NoIntersection, CardinalityRange lo_cr1_0 hi_cr1_1, CardinalityRange lo_cr2_1 hi_cr2_0)
-                 EQ -> let step2@(order2, lo_cr1_1, hi_cr1_2) = almostStrictCompare2LCs lo_cr1_0 hi_cr1_1 -- 2: 1 2 1 0
-                           cr1_2 = CardinalityRange lo_cr1_1 hi_cr1_2
-                           cr2_2 = CardinalityRange lo_cr2_1 hi_cr2_0
-                           answ_2 err_or_fit = (err_or_fit, cr1_2, cr2_2)
-                        in case order2 of -- traceShow ("Step 2: ", step2)
-                               LT -> let step21@(order21, lo_cr2_2, hi_cr2_1) = almostStrictCompare2LCs lo_cr2_1 hi_cr2_0 -- 21: 1 2 2 1
-                                         cr1_21 = CardinalityRange lo_cr1_1 hi_cr1_2
-                                         cr2_21 = CardinalityRange lo_cr2_2 hi_cr2_1
-                                         answ_21 err_or_fit = (err_or_fit, cr1_21, cr2_21)
-                                      in answ_21 $ case order21 of
-                                             EQ -> Right SecondInFirst
-                                             GT -> Right $ Intersection $ CardinalityRange hi_cr1_2 lo_cr2_2
-                                             LT -> Left $ LowerBoundaryAfterHigher Second cr2_21
-                               GT -> answ_2 $ Left $ LowerBoundaryAfterHigher First cr1_2
-                               EQ -> let step3@(order3, lo_cr2_2, hi_cr2_1) = almostStrictCompare2LCs lo_cr2_1 hi_cr2_0 -- 3: 1 2 2 1
-                                         cr1_3 = CardinalityRange lo_cr1_1 hi_cr1_2
-                                         cr2_3 = CardinalityRange lo_cr2_2 hi_cr2_1
-                                         answ_3 err_or_fit = (err_or_fit, cr1_3, cr2_3)
-                                      in answ_3 $ case order3 of -- traceShow ("Step 3: ", step3)
-                                             LT -> Right FirstInSecond
-                                             EQ -> Right EqualSets
-                                             GT -> Left $ LowerBoundaryAfterHigher First cr1_3
-                 GT -> let step4@(order4, lo_cr1_1, hi_cr2_1) = almostStrictCompare2LCs lo_cr1_0 hi_cr2_0  -- 4: 1 1 1 1
-                        in case order4 of
-                               GT -> (Right NoIntersection, CardinalityRange lo_cr1_1 hi_cr1_1, CardinalityRange lo_cr2_1 hi_cr2_1)
-                               EQ -> let step5@(order5, lo_cr2_2, hi_cr2_2) = almostStrictCompare2LCs lo_cr2_1 hi_cr2_1 -- 5: 1 1 2 2
-                                         cr1_5 = CardinalityRange lo_cr1_1 hi_cr1_1
-                                         cr2_5 = CardinalityRange lo_cr2_2 hi_cr2_2
-                                         answ_5 err_or_fit = (err_or_fit, cr1_5, cr2_5)
-                                      in case order5 of
-                                             LT -> let step51@(order51, lo_cr1_2, hi_cr1_2) = almostStrictCompare2LCs lo_cr1_1 hi_cr1_1 -- 51: 2 2 2 2
-                                                       cr1_51 = CardinalityRange lo_cr1_2 hi_cr1_2
-                                                       cr2_51 = CardinalityRange lo_cr2_2 hi_cr2_2
-                                                       answ_51 err_or_fit = (err_or_fit, cr1_51, cr2_51)
-                                                    in answ_51 $ case order51 of
-                                                             LT -> Left $ LowerBoundaryAfterHigher First cr1_51
-                                                             EQ -> Right FirstInSecond
-                                                             GT -> Right $ Intersection $ CardinalityRange lo_cr1_2 hi_cr2_2
-                                             EQ -> answ_5 $ Right SecondInFirst
-                                             GT -> answ_5 $ Left $ LowerBoundaryAfterHigher Second cr2_5
-                               LT -> let step6@(order6, lo_cr1_2, lo_cr2_2) = almostStrictCompare2LCs lo_cr1_1 lo_cr2_1 -- 6: 2 1 2 1
-                                         step7@(order7, hi_cr1_2, hi_cr2_2) = almostStrictCompare2LCs hi_cr1_1 hi_cr2_1 -- 7: 2 2 2 2
-                                         cr1_67 = CardinalityRange lo_cr1_2 hi_cr1_2
-                                         cr2_67 = CardinalityRange lo_cr2_2 hi_cr2_2
-                                         answ_67 _fit = (Right _fit, cr1_67, cr2_67)
-                                      in answ_67 $ case (order6, order7) of
-                                             (EQ, EQ) -> EqualSets
-                                             (EQ, GT) -> SecondInFirst
-                                             (LT, EQ) -> SecondInFirst
-                                             (LT, GT) -> SecondInFirst
-                                             (EQ, LT) -> FirstInSecond
-                                             (GT, LT) -> FirstInSecond
-                                             (GT, EQ) -> FirstInSecond
-                                             (LT, LT) -> Intersection $ CardinalityRange lo_cr2_2 hi_cr1_2
-                                             (GT, GT) -> Intersection $ CardinalityRange lo_cr1_2 hi_cr2_2
-
-instance Intersectable CardinalityRange where
-     setFits cr1 cr2 = case fst3 $ compare2CRs cr1 cr2 of { Right r -> r; Left e -> error $ show e }
-        where
-           fst3  :: (a,b,c) -> a
-           fst3  (a,_,_) = a
-
--- | Wrapper around @'setFits'@ of typeclass @'Intersectable'@
-crFitsInCR :: CardinalityRange -> CardinalityRange -> SetsFit CardinalityRange
-crFitsInCR = setFits
-infixr 9 `crFitsInCR`
-
--- * Popular cardinality ranges constructors.
-
--- | Same as @'cr0_Inf'@.
-crNoConstraint :: CardinalityRange
--- | Only zero elements.
-cr0            :: CardinalityRange
--- | Only one element.
-cr1            :: CardinalityRange
--- | Zero or one element.
-cr0_1          :: CardinalityRange
--- | Any count of elements.
-cr0_Inf        :: CardinalityRange
--- | Any nonzero count of elements.
-cr1_Inf        :: CardinalityRange
--- | Concrete count of elements.
-crX            :: PreciseCardinality -> CardinalityRange
--- | A concrete range.
-crXY           :: PreciseCardinality -> PreciseCardinality -> CardinalityRange
-
-crNoConstraint = cr0_Inf
-cr0            = cardinalityRange (preciseC 0) (preciseC 0)
-cr1            = cardinalityRange (preciseC 1) (preciseC 1)
-cr0_1          = cardinalityRange (preciseC 0) (preciseC 1)
-cr0_Inf        = cardinalityRange (preciseC 0) infiniteC
-cr1_Inf        = cardinalityRange (preciseC 1) infiniteC
-crX          x = cardinalityRange (preciseC x) (preciseC x)
-crXY       x y = cardinalityRange (preciseC x) (preciseC y)
-
---------------------------------------------------------------
--- * Application 0
-
-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`
-
---------------------------------------------------------------
--- * Application 1
-
--- | @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
-
---------------------------------------------------------------
---------------------------------------------------------------
--- 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:[]) }

@@ -0,0 +1,14 @@+Changes from 0.1 to 0.2
+---------------------------
+* Moved CardinalityConstraint and trasformation typeclasses from 
+  Data.CardinalityRange to new dedicated module Data.Cardinality.ContTrans
+* Data.Cardinality      -> Data.Cardinality.Cardinality
+* Data.CardinalityRange -> Data.Cardinality.CardinalityRange
+* Data.Cardinality is now just exporting
+        Data.Cardinality.Cardinality
+        Data.Cardinality.CardinalityRange
+        Data.Cardinality.ContTrans
+* To Data.Cardinality.ContTrans added ContTransError data structure and 
+  functions sContTrans_E and sContTransT_E. With these functions it's now 
+  possible a more informative error then it was Nothing with plain sContTrans.
+

@@ -11,7 +11,6 @@ --------------------------------------------------------------------------
 
 import Data.Cardinality
-import Data.CardinalityRange
 import Data.Intersectable
 import Data.Map
 import Control.Monad

@@ -12,7 +12,7 @@ 
 import Data.EmptySet
 import Data.NeverEmptyList
-import Data.CardinalityRange
+import Data.Cardinality
 import Data.Map
 import Control.Monad
 import Control.Monad.Identity
@@ -23,24 +23,24 @@         show i_a = "Identity " ++ show (runIdentity i_a)
 
 test_set :: [(Int, Bool)]
-test_set =
+test_set = zip [1..]
         [
-          (10, ((sContTransT []) :: Maybe (Maybe Int)) == Just Nothing)
-        , (20, ((sContTrans  ()) :: Maybe (Maybe Int)) == Just Nothing)
-        , (30, ((sContTransT [1]) :: (Maybe (Maybe Int))) == Just (Just 1))
-        , (40, ((sContTransT [1, 2]) :: (Maybe (Maybe Int))) == Nothing)
-        , (50, ((sContTransT $ Just "Hello") :: (Maybe (Identity String))) == Just (Identity "Hello"))
-        , (60, ((sContTransT ["Hello"]) :: Maybe (Identity String)) == Just (Identity "Hello"))
-        , (70, ((sContTransT (EmptySet :: EmptySet String)) :: (Maybe [String])) == Just [])
-        , (80, ((sContTransT "Hello") :: Maybe (EmptySet Char)) == Nothing)
-        , (90, ((sContTransT ("key", "elem")) :: Maybe (Map String String)) == Just (singleton "key" "elem"))
-        , (100, ((sContTrans [("key1", "elem1"), ("key2", "elem2")]) :: Maybe (Map String String)) == Just (fromList [("key1", "elem1"), ("key2", "elem2")]))
-        , (110, ((sContTrans (EmptySet :: EmptySet (String, String))) :: Maybe (Map String String)) == Just empty)
-        , (120, ((sContTrans []) :: Maybe ()) == Just ())
-        , (130, ((sContTrans (NEL 'H' "i!")) :: Maybe String) == Just "Hi!") -- Data.NeverEmptyList
-        , (140, ((sContTrans ()) :: Maybe String) == Just "")
-        , (150, ((sContTrans "") :: Maybe (Identity Char)) == Nothing)
-        , (160, ((sContTrans "Hi!") :: Maybe ()) == Nothing)
+          ((sContTransT []) :: Maybe (Maybe Int)) == Just Nothing
+        , ((sContTrans  ()) :: Maybe (Maybe Int)) == Just Nothing
+        , ((sContTransT [1]) :: (Maybe (Maybe Int))) == Just (Just 1)
+        , ((sContTransT [1, 2]) :: (Maybe (Maybe Int))) == Nothing
+        , ((sContTransT $ Just "Hello") :: (Maybe (Identity String))) == Just (Identity "Hello")
+        , ((sContTransT ["Hello"]) :: Maybe (Identity String)) == Just (Identity "Hello")
+        , ((sContTransT (EmptySet :: EmptySet String)) :: (Maybe [String])) == Just []
+        , ((sContTransT "Hello") :: Maybe (EmptySet Char)) == Nothing
+        , ((sContTransT ("key", "elem")) :: Maybe (Map String String)) == Just (singleton "key" "elem")
+        , ((sContTrans [("key1", "elem1"), ("key2", "elem2")]) :: Maybe (Map String String)) == Just (fromList [("key1", "elem1"), ("key2", "elem2")])
+        , ((sContTrans (EmptySet :: EmptySet (String, String))) :: Maybe (Map String String)) == Just empty
+        , ((sContTrans []) :: Maybe ()) == Just ()
+        , ((sContTrans (NEL 'H' "i!")) :: Maybe String) == Just "Hi!" -- Data.NeverEmptyList
+        , ((sContTrans ()) :: Maybe String) == Just ""
+        , ((sContTrans "") :: Maybe (Identity Char)) == Nothing
+        , ((sContTrans "Hi!") :: Maybe ()) == Nothing
         ]
 
 main = do putStrLn ("INDEX) IS_VALID   |  TEST_CASE\n------------------------------")

@@ -14,7 +14,6 @@ 
 
 import Data.Cardinality
-import Data.CardinalityRange
 import Data.List
 import System.IO