-- Copyright (c) 2014 Eric McCorkle. All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions -- are met: -- -- 1. Redistributions of source code must retain the above copyright -- notice, this list of conditions and the following disclaimer. -- -- 2. Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. -- -- 3. Neither the name of the author nor the names of any contributors -- may be used to endorse or promote products derived from this software -- without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' -- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS -- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF -- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT -- OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -- SUCH DAMAGE. {-# LANGUAGE NegativeLiterals #-} module Tests.Data.ArithEncode.Basic(tests) where import Data.ArithEncode import Data.Char import Data.Hashable import Data.Int import Data.List hiding (union) import Data.Maybe import Data.Set(Set) import Data.Tree import Data.Word import Prelude hiding (either, union, seq) import Test.HUnitPlus.Base import Tests.Data.ArithEncode.TestUtils import qualified Data.HashMap.Lazy as HashMap import qualified Data.HashSet as HashSet import qualified Data.Map as Map import qualified Data.Set as Set integralTests = [ "Integer" ~: testInfDimlessEncoding ["integral", "Integer"] integralInteger, "Int64" ~: testInfDimlessEncoding ["integral", "Int64"] integralInt64, "Word64" ~: testInfDimlessEncoding ["integral", "Word64"] integralInt64, "Int8" ~: testInfDimlessEncodingWithLimit ["integral", "Int8"] integralInt8 255, "Word64" ~: testInfDimlessEncodingWithLimit ["integral", "Word8"] integralWord8 255 ] intervalTests = [ "Integer" ~: [ "0_10000" ~: testFiniteEncodingWithVals ["interval", "Integer"] (intervalInteger 0 10000) [0..10000] ([(-10000)..(-1)] ++ [10001..20000]), "2000_10000" ~: testFiniteEncodingWithVals ["interval", "Integer"] (intervalInteger 2000 10000) [2000..10000] ([0..1999] ++ [10001..12000]), "neg2000_2000" ~: testFiniteEncodingWithVals ["interval", "Integer"] (intervalInteger (-2000) 2000) [-2000..2000] ([(-10000)..(-2001)] ++ [2001..0]), "neg10000_neg2000" ~: testFiniteEncodingWithVals ["interval", "Integer"] (intervalInteger (-10000) (-2000)) [-10000..(-2000)] ([-12000..(-10001)] ++ [-1999..0]) ], "Int64" ~: [ "0_10000" ~: testFiniteEncodingWithVals ["interval", "Int64"] (intervalInt64 0 10000) [0..10000] ([(-10000)..(-1)] ++ [10001..20000]), "2000_10000" ~: testFiniteEncodingWithVals ["interval", "Int64"] (intervalInt64 2000 10000) [2000..10000] ([0..1999] ++ [10001..12000]), "neg2000_2000" ~: testFiniteEncodingWithVals ["interval", "Int64"] (intervalInt64 (-2000) 2000) [-2000..2000] ([(-10000)..(-2001)] ++ [2001..10000]), "neg10000_neg2000" ~: testFiniteEncodingWithVals ["interval", "Int64"] (intervalInt64 (-10000) (-2000)) [-10000..(-2000)] ([-12000..(-10001)] ++ [-1999..0]) ], "Word64" ~: [ "0_10000" ~: testFiniteEncodingWithVals ["interval", "Word64"] (intervalWord64 0 10000) [0..10000] [10001..12000], "2000_10000" ~: testFiniteEncodingWithVals ["interval", "Word64"] (intervalWord64 2000 10000) [2000..10000] ([0..1999] ++ [10001..12000]) ], "Int8" ~: [ "0_100" ~: testFiniteEncodingWithVals ["interval", "Int8"] (intervalInt8 0 100) [0..100] ([-100..(-1)] ++ [101..120]), "20_100" ~: testFiniteEncodingWithVals ["interval", "Int8"] (intervalInt8 20 100) [20..100] ([0..19] ++ [101..120]), "neg20_20" ~: testFiniteEncodingWithVals ["interval", "Int8"] (intervalInt8 (-20) 20) [-20..20] ([-100..(-21)] ++ [21..100]), "neg100_neg20" ~: testFiniteEncodingWithVals ["interval", "Int8"] (intervalInt8 (-100) (-20)) [-100..(-20)] ([-120..(-101)] ++ [-19..0]), "neg128_128" ~: testFiniteEncodingWithVals ["interval", "Int8"] (intervalInt8 (-128) 127) [-128..127] [] ], "Word8" ~: [ "0_100" ~: testFiniteEncodingWithVals ["interval", "Word8"] (intervalWord8 0 100) [0..100] [101..120], "20_100" ~: testFiniteEncodingWithVals ["interval", "Word8"] (intervalWord8 20 100) [20..100] ([0..19] ++ [101..120]), "0_255" ~: testFiniteEncodingWithVals ["interval", "Word8"] (intervalWord8 0 255) [0..255] [] ] ] optionalEncodingTests = [ testNameTags "isomorphism" ["isomorphism", "optional", "fromHashableList"] (testEncodingVals optionalEncoding [Nothing, Just 'A', Just 'B', Just 'C', Just 'D']), testNameTags "decode_zero" ["isomorphism", "optional"] (decode optionalEncoding 0 @?= Nothing), testNameTags "size" ["size", "optional"] (size optionalEncoding @?= Just 5), testNameTags "inDomain" ["inDomain", "optional"] (testInDomain optionalEncoding [Nothing, Just 'A', Just 'B', Just 'C', Just 'D']), testNameTags "not_inDomain" ["inDomain", "optional"] (testNotInDomain optionalEncoding [Just 'E', Just 'F']), testNameTags "bounds_low" ["bounds", "optional"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode optionalEncoding (-1))), testNameTags "bounds_high" ["bounds", "optional"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode optionalEncoding 5)) ] makeExcludeTest (vals, excludes) = let name = excludes in name ~: testExclude ["fromHashableList", "exclude"] (exclude excludes (fromHashableList vals)) vals ['F', 'G'] excludes excludeTests = let testdata = [ (['A', 'B', 'C', 'D', 'E'], ['A']), (['A', 'B', 'C', 'D', 'E'], ['B']), (['A', 'B', 'C', 'D', 'E'], ['E']), (['A', 'B', 'C', 'D', 'E'], ['A', 'B']), (['A', 'B', 'C', 'D', 'E'], ['B', 'A']), (['A', 'B', 'C', 'D', 'E'], ['A', 'C']), (['A', 'B', 'C', 'D', 'E'], ['C', 'A']), (['A', 'B', 'C', 'D', 'E'], ['B', 'C']), (['A', 'B', 'C', 'D', 'E'], ['C', 'B']), (['A', 'B', 'C', 'D', 'E'], ['A', 'E']), (['A', 'B', 'C', 'D', 'E'], ['E', 'A']), (['A', 'B', 'C', 'D', 'E'], ['B', 'E']), (['A', 'B', 'C', 'D', 'E'], ['E', 'B']), (['A', 'B', 'C', 'D', 'E'], ['A', 'B', 'C']), (['A', 'B', 'C', 'D', 'E'], ['A', 'B', 'D']), (['A', 'B', 'C', 'D', 'E'], ['A', 'C', 'E']), (['A', 'B', 'C', 'D', 'E'], ['B', 'C', 'D']), (['A', 'B', 'C', 'D', 'E'], ['B', 'D', 'E']), (['A', 'B', 'C', 'D', 'E'], ['C', 'D', 'E']), (['A', 'B', 'C', 'D', 'E'], ['A', 'B', 'C', 'D']), (['A', 'B', 'C', 'D', 'E'], ['A', 'B', 'C', 'E']), (['A', 'B', 'C', 'D', 'E'], ['B', 'C', 'D', 'E']) ] in ("exclude_empty" ~: testFiniteEncodingWithVals ["fromHashableList", "exclude"] (exclude [] (fromHashableList ['A', 'B', 'C', 'D', 'E'])) ['A', 'B', 'C', 'D', 'E'] ['F', 'G']) : map makeExcludeTest testdata testInfEither tags iso limit = [ testNameTags "isomorphism" ("isomorphism" : tags) (testIsomorphism iso limit), testNameTags "bounds_low" ("bounds" : tags) (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ("size" : tags) (size iso @?= Nothing), testNameTags "inDomain" ("inDomain" : tags) (testInDomain iso (map (decode iso) [0..limit])) ] testInfFinEither tags iso finvals limit nonvals = let leftvals = map Left [0..limit] rightvals = map Right finvals vals = leftvals ++ rightvals lastFinite = maximum (map (encode iso) rightvals) in [ testNameTags "isomorphism" ("isomorphism" : tags) (testIsomorphism iso limit), testNameTags "isomorphism_vals" ("isomorphism" : tags) (testEncodingVals iso vals), testNameTags "bounds_low" ("bounds" : tags) (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "inDomain" ("inDomain" : tags) (testInDomain iso vals), testNameTags "not_inDomain" ["inDomain", "hashSet"] (testNotInDomain iso nonvals), testNameTags "size" ("size" : tags) (size iso @?= Nothing) ] testFinInfEither tags iso finvals limit nonvals = let leftvals = map Left finvals rightvals = map Right [0..limit] vals = leftvals ++ rightvals lastFinite = maximum (map (encode iso) leftvals) in [ testNameTags "isomorphism" ("isomorphism" : tags) (testIsomorphism iso limit), testNameTags "isomorphism_vals" ("isomorphism" : tags) (testEncodingVals iso leftvals), testNameTags "bounds_low" ("bounds" : tags) (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "inDomain" ("inDomain" : tags) (testInDomain iso vals), testNameTags "not_inDomain" ["inDomain", "hashSet"] (testNotInDomain iso nonvals), testNameTags "size" ("size" : tags) (size iso @?= Nothing) ] testFinEither tags iso leftvals rightvals nonvals = let vals = map Left leftvals ++ map Right rightvals isosize = toInteger (length vals) in [ testNameTags "isomorphism" ("isomorphism" : tags) (testEncodingVals iso vals), testNameTags "size" ("size" : tags) (size iso @?= Just isosize), testNameTags "inDomain" ("inDomain" : tags) (testInDomain iso vals), testNameTags "not_inDomain" ["inDomain", "hashSet"] (testNotInDomain iso nonvals), testNameTags "bounds_low" ("bounds" : tags) (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "bounds_high" ("bounds" : tags) (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (fromJust (size iso)))) ] eitherTests = let infiniteEncoding = integralInteger bigvals = ['A', 'B', 'C', 'D', 'E', 'F'] smallvals = ['G', 'H', 'I'] nonvals = ['J', 'K', 'L'] biggerEncoding = fromHashableList bigvals smallerEncoding = fromHashableList smallvals finiteEncoding = biggerEncoding in [ "infinite_infinite" ~: testInfEither ["integral", "Integer", "either"] (either infiniteEncoding infiniteEncoding) 10000, "infinite_finite" ~: testInfFinEither ["integral", "Integer", "fromHashableList", "either"] (either infiniteEncoding finiteEncoding) bigvals 100 (map Right nonvals), "finite_infinite" ~: testFinInfEither ["integral", "Integer", "fromHashableList", "either"] (either finiteEncoding infiniteEncoding) bigvals 100 (map Left nonvals), "finite_finite" ~: testFinEither ["fromHashableList", "either"] (either finiteEncoding finiteEncoding) bigvals bigvals (map Left nonvals ++ map Right nonvals), "big_small" ~: testFinEither ["fromHashableList", "either"] (either biggerEncoding smallerEncoding) bigvals smallvals (map Right bigvals ++ map Left smallvals ++ map Left nonvals ++ map Right nonvals), "small_big" ~: testFinEither ["fromHashableList", "either"] (either smallerEncoding biggerEncoding) smallvals bigvals (map Right smallvals ++ map Left bigvals ++ map Left nonvals ++ map Right nonvals) ] finitePairTests = let iso = pair (fromHashableList ['A', 'B', 'C']) (fromHashableList ['D', 'E', 'F', 'G']) vals = [('A', 'D'), ('A', 'E'), ('A', 'F'), ('A', 'G'), ('B', 'D'), ('B', 'E'), ('B', 'F'), ('B', 'G'), ('C', 'D'), ('C', 'E'), ('C', 'F'), ('C', 'G')] nonvals = [('F', 'D'), ('A', 'A'), ('H', 'D'), ('A', 'H'), ('H', 'I')] isosize = toInteger (length vals) in [ testNameTags "isomorphism" ["isomorphism", "pair"] (testEncodingVals iso vals), testNameTags "size" ["size", "pair"] (size iso @?= Just isosize), testNameTags "bounds_low" ["bounds", "pair"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "bounds_high" ["bounds", "pair"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso 12)), testNameTags "inDomain" ["inDomain", "pair"] (testInDomain iso vals), testNameTags "not_inDomain" ["inDomain", "pair"] (testNotInDomain iso nonvals) ] infinitePairTests iso1 iso2 limit = let iso = pair iso1 iso2 in [ testNameTags "isomorphism" ["isomorphism", "pair"] (testIsomorphism iso limit), testNameTags "bounds_low" ["bounds", "pair"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "pair"] (size iso @?= Nothing), testNameTags "inDomain" ["inDomain", "pair"] (testInDomain iso (map (decode iso) [0..limit])) ] pairTests = let finite = fromHashableList ['D', 'E', 'F', 'G'] in [ "infinite_infinite" ~: infinitePairTests integralInteger integralInteger 100, "finite_infinite" ~: infinitePairTests finite integralInteger 100, "infinite_finite" ~: infinitePairTests integralInteger finite 100, "finite_finite" ~: finitePairTests ] finitePowerTest = let iso = power 3 (fromHashableList ['A', 'B']) vals = [['A', 'A', 'A'], ['B', 'A', 'A'], ['A', 'B', 'A'], ['B', 'B', 'A'], ['A', 'A', 'B'], ['B', 'A', 'B'], ['A', 'B', 'B'], ['B', 'B', 'B']] nonvals = [['A', 'C', 'A'], ['A', 'A', 'A', 'A'], ['A', 'A']] isosize = toInteger (length vals) in [ testNameTags "isomorphism" ["isomorphism", "power"] (testEncodingVals iso vals), testNameTags "size" ["size", "power"] (size iso @?= Just isosize), testNameTags "bounds_low" ["bounds", "power"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "bounds_high" ["bounds", "power"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso 8)), testNameTags "inDomain" ["inDomain", "power"] (testInDomain iso vals), testNameTags "not_inDomain" ["inDomain", "power"] (testNotInDomain iso nonvals) ] infinitePowerTests len elemiso limit = let iso = power len elemiso in [ testNameTags "isomorphism" ["isomorphism", "power"] (testIsomorphism iso limit), testNameTags "bounds_low" ["bounds", "power"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "power"] (size iso @?= Nothing), testNameTags "inDomain" ["inDomain", "power"] (testInDomain iso (map (decode iso) [0..limit])) ] powerTests = [ "finite" ~: finitePowerTest, "infinite_2" ~: infinitePowerTests 2 integralInteger 100, "infinite_3" ~: infinitePowerTests 3 integralInteger 1000, "infinite_4" ~: infinitePowerTests 4 integralInteger 10000 ] data Variant a b c d = First a | Second b | Third c | Fourth d deriving (Show, Eq, Ord) instance (Hashable a, Hashable b, Hashable c, Hashable d) => Hashable (Variant a b c d) where hashWithSalt s (First x) = s `hashWithSalt` (1 :: Int) `hashWithSalt` x hashWithSalt s (Second x) = s `hashWithSalt` (2 :: Int) `hashWithSalt` x hashWithSalt s (Third x) = s `hashWithSalt` (3 :: Int) `hashWithSalt` x hashWithSalt s (Fourth x) = s `hashWithSalt` (4 :: Int) `hashWithSalt` x unionTests = let oneEnc = (fromHashableList ['A'], ['A'], ['B'], "one") twoEnc = (fromHashableList ['A', 'B'], ['A', 'B'], ['C', 'D'], "two") threeEnc = (fromHashableList ['A', 'B', 'C'], ['A', 'B', 'C'], ['D', 'E', 'F'], "three") fiveEnc = (fromHashableList ['A', 'B', 'C', 'D', 'E'], ['A', 'B', 'C', 'D', 'E'], ['F', 'G', 'H', 'I', 'J'], "five") infEnc = (integralInteger, [-10..10], [], "infinite") makeUnionTest finite (firstenc, firstvals, firstnonvals, firstname) (secondenc, secondvals, secondnonvals, secondname) (thirdenc, thirdvals, thirdnonvals, thirdname) (fourthenc, fourthvals, fourthnonvals, fourthname) = let fromFirst (First x) = Just x fromFirst _ = Nothing fromSecond (Second x) = Just x fromSecond _ = Nothing fromThird (Third x) = Just x fromThird _ = Nothing fromFourth (Fourth x) = Just x fromFourth _ = Nothing wrapFirst = wrap fromFirst (Just . First) firstenc wrapSecond = wrap fromSecond (Just . Second) secondenc wrapThird = wrap fromThird (Just . Third) thirdenc wrapFourth = wrap fromFourth (Just . Fourth) fourthenc iso = union [ wrapFirst, wrapSecond, wrapThird, wrapFourth ] wrapFirstVals = map First firstvals wrapSecondVals = map Second secondvals wrapThirdVals = map Third thirdvals wrapFourthVals = map Fourth fourthvals vals = wrapFirstVals ++ wrapSecondVals ++ wrapThirdVals ++ wrapFourthVals wrapFirstNonVals = map First firstnonvals wrapSecondNonVals = map Second secondnonvals wrapThirdNonVals = map Third thirdnonvals wrapFourthNonVals = map Fourth fourthnonvals nonvals = wrapFirstNonVals ++ wrapSecondNonVals ++ wrapThirdNonVals ++ wrapFourthNonVals name = firstname ++ "_" ++ secondname ++ "_" ++ thirdname ++ "_" ++ fourthname valssize = toInteger (length vals) isosize = if finite then Just valssize else Nothing isolimit = do size <- isosize return (size - 1) sortfunc Nothing Nothing = EQ sortfunc Nothing _ = GT sortfunc _ Nothing = LT sortfunc (Just a) (Just b) = compare a b in name ~: [ testNameTags "isomorphism" ["isomorphism", "union"] (testEncodingVals iso vals), testNameTags "size" ["size", "union"] (size iso @?= isosize), testNameTags "bounds_low" ["bounds", "union"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "inDomain" ["inDomain", "union"] (testInDomain iso vals), testNameTags "not_inDomain" ["inDomain", "union"] (testNotInDomain iso nonvals) ] ++ if finite then [ testNameTags "bounds_high" ["bounds", "union"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (fromJust (size iso)))) ] else [] in [ makeUnionTest True oneEnc twoEnc threeEnc fiveEnc, makeUnionTest True fiveEnc threeEnc twoEnc oneEnc, makeUnionTest True oneEnc threeEnc fiveEnc fiveEnc, makeUnionTest True oneEnc threeEnc threeEnc fiveEnc, makeUnionTest True oneEnc oneEnc threeEnc fiveEnc, makeUnionTest True oneEnc oneEnc oneEnc oneEnc, makeUnionTest True twoEnc twoEnc twoEnc twoEnc, makeUnionTest False oneEnc threeEnc fiveEnc infEnc, makeUnionTest False twoEnc fiveEnc infEnc infEnc, makeUnionTest False infEnc infEnc twoEnc fiveEnc, makeUnionTest False infEnc fiveEnc infEnc twoEnc, makeUnionTest False twoEnc fiveEnc fiveEnc infEnc, makeUnionTest False fiveEnc fiveEnc infEnc infEnc, makeUnionTest False fiveEnc infEnc infEnc infEnc, makeUnionTest False infEnc infEnc infEnc infEnc ] testInfSet iso limit = [ testNameTags "isomorphism" ["isomorphism", "set"] (testIsomorphism iso limit), testNameTags "bounds_low" ["bounds", "set"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "set"] (size iso @?= Nothing) ] testFinSet iso vals nonval = let numvals = length vals setvals = map Set.fromList (subsequences vals) nonvals = map (Set.insert nonval) setvals isosize = toInteger (2 ^ numvals) in [ testNameTags "isomorphism" ["isomorphism", "set"] (testEncodingVals iso setvals), testNameTags "size" ["size", "set"] (size iso @?= Just isosize), testNameTags "bounds_low" ["bounds", "set"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "bounds_high" ["bounds", "set"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (fromJust (size iso)))), testNameTags "inDomain" ["inDomain", "set"] (testInDomain iso setvals), testNameTags "not_inDomain" ["inDomain", "hashSet"] (testNotInDomain iso nonvals) ] testInfHashSet iso limit = [ testNameTags "isomorphism" ["isomorphism", "hashSet"] (testIsomorphism iso limit), testNameTags "bounds_low" ["bounds", "hashSet"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "hashSet"] (size iso @?= Nothing) ] testFinHashSet iso vals nonval = let numvals = length vals setvals = map HashSet.fromList (subsequences vals) nonvals = map (HashSet.insert nonval) setvals isosize = toInteger (2 ^ numvals) in [ testNameTags "isomorphism" ["isomorphism", "hashSet"] (testEncodingVals iso setvals), testNameTags "size" ["size", "hashSet"] (size iso @?= Just isosize), testNameTags "bounds_low" ["bounds", "hashSet"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "bounds_high" ["bounds", "hashSet"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (fromJust (size iso)))), testNameTags "inDomain" ["inDomain", "hashSet"] (testInDomain iso setvals), testNameTags "not_inDomain" ["inDomain", "hashSet"] (testNotInDomain iso nonvals) ] setTests = [ "infinite" ~: testInfSet (set integralInteger) 10000, "finite" ~: testFinSet (set (fromHashableList ['A', 'B', 'C', 'D', 'E'])) ['A', 'B', 'C', 'D', 'E'] 'F' ] hashSetTests = [ "infinite" ~: testInfHashSet (hashSet integralInteger) 10000, "finite" ~: testFinHashSet (hashSet (fromHashableList ['A', 'B', 'C', 'D', 'E'])) ['A', 'B', 'C', 'D', 'E'] 'F' ] finiteSeqTests = let inner = fromHashableList ['A', 'B', 'C'] vals = [[], ['A'], ['B'], ['C'], ['A', 'A'], ['A', 'B'], ['A', 'C'], ['B', 'A'], ['B', 'B'], ['B', 'C'], ['C', 'A'], ['C', 'B'], ['C', 'C'], ['A', 'A', 'A'], ['A', 'A', 'B'], ['A', 'A', 'C'], ['A', 'B', 'A'], ['A', 'B', 'B'], ['A', 'B', 'C'], ['A', 'C', 'A'], ['A', 'C', 'B'], ['A', 'C', 'C'], ['B', 'A', 'A'], ['B', 'A', 'B'], ['B', 'A', 'C'], ['B', 'B', 'A'], ['B', 'B', 'B'], ['B', 'B', 'C'], ['B', 'C', 'A'], ['B', 'C', 'B'], ['B', 'C', 'C'], ['C', 'A', 'A'], ['C', 'A', 'B'], ['C', 'A', 'C'], ['C', 'B', 'A'], ['C', 'B', 'B'], ['C', 'B', 'C'], ['C', 'C', 'A'], ['C', 'C', 'B'], ['C', 'C', 'C']] nonvals = [['D'], ['D', 'A'], ['A', 'D'], ['A', 'A', 'D'], ['A', 'D', 'A']] iso = seq inner in [ testNameTags "isomorphism" ["isomorphism", "seq"] (testEncodingVals iso vals), testNameTags "bounds_low" ["bounds", "seq"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "seq"] (size iso @?= Nothing), testNameTags "inDomain" ["inDomain", "seq"] (testInDomain iso vals), testNameTags "notInDomain" ["inDomain", "seq"] (testNotInDomain iso nonvals) ] infiniteSeqTests = let inner = integralInteger iso = seq inner limit = 10000 in [ testNameTags "isomorphism" ["isomorphism", "seq"] (testIsomorphism iso limit), testNameTags "bounds_low" ["bounds", "seq"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "seq"] (size iso @?= Nothing), testNameTags "inDomain" ["inDomain", "seq"] (testInDomain iso (map (decode iso) [0..limit])) ] seqTests = [ "finite" ~: finiteSeqTests, "infinite" ~: infiniteSeqTests ] finiteBoundedSeqTest = let iso = boundedSeq 3 (fromHashableList ['A', 'B', 'C']) vals = [[], ['A'], ['B'], ['C'], ['A', 'A'], ['B', 'A'], ['C', 'A'], ['A', 'B'], ['B', 'B'], ['C', 'B'], ['A', 'C'], ['B', 'C'], ['C', 'C'], ['A', 'A', 'A'], ['B', 'A', 'A'], ['C', 'A', 'A'], ['A', 'B', 'A'], ['B', 'B', 'A'], ['C', 'B', 'A'], ['A', 'C', 'A'], ['B', 'C', 'A'], ['C', 'C', 'A'], ['A', 'A', 'B'], ['B', 'A', 'B'], ['C', 'A', 'B'], ['A', 'B', 'B'], ['B', 'B', 'B'], ['C', 'B', 'B'], ['A', 'C', 'B'], ['B', 'C', 'B'], ['C', 'C', 'B'], ['A', 'A', 'C'], ['B', 'A', 'C'], ['C', 'A', 'C'], ['A', 'B', 'C'], ['B', 'B', 'C'], ['C', 'B', 'C'], ['A', 'C', 'C'], ['B', 'C', 'C'], ['C', 'C', 'C']] nonvals = [['A', 'D', 'A'], ['A', 'A', 'A', 'A']] isosize = toInteger (length vals) in [ testNameTags "isomorphism" ["isomorphism", "boundedSeq"] (testEncodingVals iso vals), testNameTags "size" ["size", "boundedSeq"] (size iso @?= Just isosize), testNameTags "bounds_low" ["bounds", "boundedSeq"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "bounds_high" ["bounds", "boundedSeq"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso 40)), testNameTags "inDomain" ["inDomain", "boundedSeq"] (testInDomain iso vals), testNameTags "not_inDomain" ["inDomain", "boundedSeq"] (testNotInDomain iso nonvals) ] infiniteBoundedSeqTests len elemiso limit = let iso = boundedSeq len elemiso in [ testNameTags "isomorphism" ["isomorphism", "boundedSeq"] (testIsomorphism iso limit), testNameTags "boundslow" ["bounds", "boundedSeq"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "boundedSeq"] (size iso @?= Nothing), testNameTags "inDomain" ["inDomain", "boundedSeq"] (testInDomain iso (map (decode iso) [0..limit])) ] boundedSeqTests = [ "finite" ~: finiteBoundedSeqTest, "infinite_2" ~: infiniteBoundedSeqTests 2 integralInteger 100, "infinite_3" ~: infiniteBoundedSeqTests 3 integralInteger 1000, "infinite_4" ~: infiniteBoundedSeqTests 4 integralInteger 10000 ] instance Hashable ty => Hashable (Tree ty) where hashWithSalt s Node { rootLabel = label, subForest = children } = s `hashWithSalt` label `hashWithSalt` children instance Ord ty => Ord (Tree ty) where compare Node { rootLabel = label1, subForest = children1 } Node { rootLabel = label2, subForest = children2 } = case compare label1 label2 of EQ -> compare children1 children2 out -> out treeEncoding = let makeNode (label, children) = Just Node { rootLabel = label, subForest = children } unmakeNode Node { rootLabel = label, subForest = children } = Just (label, children) nodeEncoding nodeenc = wrap unmakeNode makeNode (pair integralInteger (seq nodeenc)) in recursive nodeEncoding treeEncodingTests = let iso = treeEncoding in [ testNameTags "isomorphism" ["isomorphism", "recursive"] (testIsomorphism iso 10000), testNameTags "bounds_low" ["bounds", "recursive"] (assertThrows (\(IllegalArgument _) -> assertSuccess) (return $! decode iso (-1))), testNameTags "size" ["size", "recursive"] (size iso @?= Nothing), testNameTags "inDomain" ["inDomain", "recursive"] (testInDomain iso (map (decode iso) [0..10000])) ] testlist :: [Test] testlist = [ "identity" ~: testInfDimlessEncoding ["Integer"] identity, "singleton" ~: testFiniteEncodingWithVals ["singleton"] (singleton 'A') ['A'] ['B'], "integral" ~: integralTests, "interval" ~: intervalTests, "fromHashableList" ~: testFiniteEncodingWithVals ["fromHashableList"] (fromHashableList ['A', 'B', 'C', 'D', 'E']) ['A', 'B', 'C', 'D', 'E'] ['F', 'G'], "fromOrdList" ~: testFiniteEncodingWithVals ["fromOrdList"] (fromOrdList ['A', 'B', 'C', 'D', 'E']) ['A', 'B', 'C', 'D', 'E'] ['F', 'G'], "wrap" ~: testFiniteEncodingWithVals ["wrap", "fromOrdList"] (wrap (Just . toUpper) (Just . toLower) (fromOrdList ['A', 'B', 'C', 'D', 'E'])) ['a', 'b', 'c', 'd', 'e'] ['f', 'g'], "optional" ~: optionalEncodingTests, "mandatory" ~: testFiniteEncodingWithVals ["mandatory"] (mandatory optionalEncoding) ['A', 'B', 'C', 'D'] ['E', 'F'], "nonzero" ~: testFiniteEncodingWithVals ["nonzero", "fromHashableList"] (nonzero (fromHashableList ['A', 'B', 'C', 'D', 'E', 'F'])) ['B', 'C', 'D', 'E', 'F'] ['A', 'G'], "exclude" ~: excludeTests, "either" ~: eitherTests, "pair" ~: pairTests, "power" ~: powerTests, "union" ~: unionTests, "set" ~: setTests, "hashSet" ~: hashSetTests, "seq" ~: seqTests, "boundedSeq" ~: boundedSeqTests, "recursive" ~: treeEncodingTests ] tests :: Test tests = "Basic" ~: testlist