1module Main where 2 3import Control.Exception 4import System.Mem 5 6import GHC.Compact 7 8assertFail :: String -> IO () 9assertFail msg = throwIO $ AssertionFailed msg 10 11assertEquals :: (Eq a, Show a) => a -> a -> IO () 12assertEquals expected actual = 13 if expected == actual then return () 14 else assertFail $ "expected " ++ (show expected) 15 ++ ", got " ++ (show actual) 16 17-- test :: (Word -> a -> IO (Maybe (Compact a))) -> IO () 18test func = do 19 let val = ("hello", 1, 42, 42, Just 42) :: 20 (String, Int, Int, Integer, Maybe Int) 21 str <- func val 22 23 -- check that val is still good 24 assertEquals ("hello", 1, 42, 42, Just 42) val 25 -- check the value in the compact 26 assertEquals ("hello", 1, 42, 42, Just 42) (getCompact str) 27 performMajorGC 28 -- check again val 29 assertEquals ("hello", 1, 42, 42, Just 42) val 30 -- check again the value in the compact 31 assertEquals ("hello", 1, 42, 42, Just 42) (getCompact str) 32 33 print =<< compactSize str 34 35main = do 36 test compactWithSharing 37 test compact 38