Commit f9381a60 authored by Erik de Castro Lopo's avatar Erik de Castro Lopo
Browse files

Cabal: Add a NubList type with tests.

A NubList is a list where all elements are unique, but are maintained in
their original order. The Monoid NubList's mappend implement is just:

    NubList xs `mappend` NubList ys = NubList . nub $ xs ++ ys

which preserves NubList's required properties (ordering and unique-ness
of elements) and meets the requirements of the Monoid laws (identity,
associativity and closure).
parent 8e83684e
......@@ -219,6 +219,7 @@ library
Distribution.System
Distribution.TestSuite
Distribution.Text
Distribution.Utils.NubList
Distribution.Verbosity
Distribution.Version
Language.Haskell.Extension
......@@ -241,6 +242,7 @@ test-suite unit-tests
other-modules:
UnitTests.Distribution.Compat.CreatePipe
UnitTests.Distribution.Compat.ReadP
UnitTests.Distribution.Utils.NubList
main-is: UnitTests.hs
build-depends:
base,
......
module Distribution.Utils.NubList
( NubList -- opaque
, toNubList -- smart construtor
, fromNubList
) where
import Data.Binary
import Data.List (nub)
import Data.Monoid
import Distribution.Simple.Utils
import qualified Text.Read as R
-- | NubList : A list where every element in the list is unique to the list
-- and the original list order is maintained.
newtype NubList a =
NubList { fromNubList :: [a] }
deriving Eq
-- NubList assumes that nub retains the list order while removing duplicate
-- elements (keeping the first occurence). The Data.List.nub documentation does
-- not specifically state that ordering is maintained so we will add a test for
-- that to the test suite.
toNubList :: Ord a => [a] -> NubList a
toNubList list = NubList $ ordNub list
-- | Monoid operations on NubLists.
-- For a valid Monoid instance we need to satistfy the required monoid laws;
-- identity, associativity and closure.
--
-- Identity : by inspection:
-- mempty `mappend` NubList xs == NubList xs `mappend` mempty
--
-- Associativity : by inspection:
-- (NubList xs `mappend` NubList ys) `mappend` NubList zs
-- == NubList xs `mappend` (NubList ys `mappend` NubList zs)
--
-- Closure : appending two lists of type a and removing duplicates obviously
-- does not change the type.
instance Ord a => Monoid (NubList a) where
mempty = NubList []
NubList xs `mappend` NubList ys = NubList . nub $ xs ++ ys
instance Show a => Show (NubList a) where
show (NubList a) = show a
instance (Ord a, Read a) => Read (NubList a) where
readPrec = R.parens . R.prec 10 $ fmap toNubList R.readPrec
-- Binary instance of NubList is the same as for List. For put, we just pull off
-- constructor and put the list. For get, we get the list and make a NubList
-- out of it using toNubList.
instance (Ord a, Binary a) => Binary (NubList a) where
put (NubList l) = put l
get = fmap toNubList get
......@@ -7,6 +7,7 @@ import Test.Framework
import qualified UnitTests.Distribution.Compat.CreatePipe
import qualified UnitTests.Distribution.Compat.ReadP
import qualified UnitTests.Distribution.Utils.NubList
tests :: [Test]
tests =
......@@ -14,6 +15,8 @@ tests =
UnitTests.Distribution.Compat.ReadP.tests
, testGroup "Distribution.Compat.CreatePipe"
UnitTests.Distribution.Compat.CreatePipe.tests
, testGroup "Distribution.Utils.NubList"
UnitTests.Distribution.Utils.NubList.tests
]
main :: IO ()
......
module UnitTests.Distribution.Utils.NubList
( tests
) where
import Data.Monoid
import Distribution.Utils.NubList
import Test.Framework
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Providers.QuickCheck2
import Test.HUnit (Assertion, assertBool)
tests :: [Test]
tests =
[ testCase "Numlist retains ordering" testOrdering
, testCase "Numlist removes duplicates" testDeDupe
, testProperty "Monoid Numlist Identity" prop_Identity
, testProperty "Monoid Numlist Associativity" prop_Associativity
]
someIntList :: [Int]
-- This list must not have duplicate entries.
someIntList = [ 1, 3, 4, 2, 0, 7, 6, 5, 9, -1 ]
testOrdering :: Assertion
testOrdering =
assertBool "Maintains element ordering:" $
fromNubList (toNubList someIntList) == someIntList
testDeDupe :: Assertion
testDeDupe =
assertBool "De-duplicates a list:" $
fromNubList (toNubList (someIntList ++ someIntList)) == someIntList
-- ---------------------------------------------------------------------------
-- QuickCheck properties for NubList
prop_Identity :: [Int] -> Bool
prop_Identity xs =
mempty `mappend` toNubList xs == toNubList xs `mappend` mempty
prop_Associativity :: [Int] -> [Int] -> [Int] -> Bool
prop_Associativity xs ys zs =
(toNubList xs `mappend` toNubList ys) `mappend` toNubList zs
== toNubList xs `mappend` (toNubList ys `mappend` toNubList zs)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment