1. Bryan O'Sullivan
  2. critbit

Commits

Bryan O'Sullivan  committed e6ec009 Merge

Merge pull request #76 from archblob/Set_Monoid

Add monoid instance for Set. Uncomment and add test for mapMonotonic.

  • Participants
  • Parent commits c745bf8, 1d59de3
  • Branches default

Comments (0)

Files changed (3)

File Data/CritBit/Set.hs

View file
 instance (Show a) => Show (Set a) where
     show s = "fromList " ++ show (toList s)
 
+instance CritBitKey k => Monoid (Set k) where
+    mempty  = empty
+    mappend = union
+    mconcat = unions 
+
 instance Foldable Set where
     foldMap f (Set (CritBit n)) = foldSet f n
 
 -- > empty      == fromList []
 -- > size empty == 0
 empty :: Set a
-empty = Set $ T.empty
+empty = Set T.empty
 {-# INLINABLE empty #-}
 
 -- | /O(1)/. A set with a single element.
 -- If the set already contains an element equal to the given value,
 -- it is replaced with the new value.
 insert :: (CritBitKey a) => a -> Set a -> Set a
-insert = wrapVS Set (flip T.insert ())
+insert = wrapVS Set (`T.insert` ())
 {-# INLINABLE insert #-}
 
 -- | /O(log n)/. Delete an element from a set.
 -- >                     ==> mapMonotonic f s == map f s
 -- >     where ls = toList s
 mapMonotonic :: (CritBitKey a2) => (a1 -> a2) -> Set a1 -> Set a2
-mapMonotonic = error "Depends on T.mapKeysMonotonic"
---mapMonotonic = wrapVS Set T.mapKeysMonotonic
+mapMonotonic = wrapVS Set T.mapKeysMonotonic
 {-# INLINABLE mapMonotonic #-}
 
 -- | /O(n)/. Fold the elements in the set using the given left-associative

File Data/CritBit/Tree.hs

View file
 {-# LANGUAGE BangPatterns, RecordWildCards, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- |
 -- Module      :  Data.CritBit.Tree
 import Data.CritBit.Core
 import Data.CritBit.Types.Internal
 import Data.Maybe (fromMaybe)
+import Data.Monoid (Monoid(..))
 import Prelude hiding (foldl, foldr, lookup, null, map, filter)
 import qualified Data.Array as A
 import qualified Data.Foldable as Foldable
 import qualified Data.List as List
 
+instance CritBitKey k => Monoid (CritBit k v) where
+    mempty  = empty
+    mappend = union
+    mconcat = unions
+
 infixl 9 !, \\
 
 -- | /O(log n)/. Find the value at a key.
 -- This function has slightly better performance than 'mapKeys'.
 --
 -- > mapKeysMonotonic (\ k -> succ k) (fromList [("a",5), ("b",3)]) == fromList [("b",5), ("c",3)]
-mapKeysMonotonic :: (CritBitKey k1, CritBitKey k2)
-                 => (k1 -> k2) -> CritBit k1 v -> CritBit k2 v
+mapKeysMonotonic :: CritBitKey k
+                 => (a -> k) -> CritBit a v -> CritBit k v
 mapKeysMonotonic f m = foldlWithKey (insertRight f) empty m
 {-# INLINABLE mapKeysMonotonic #-}
 

File tests/Properties/Set.hs

View file
 
 updateFun :: Integral v => k -> v -> Maybe v
 updateFun _ v
-  | v `rem` 2 == 0 = Nothing
+  | even v    = Nothing
   | otherwise = Just (v + 1)
 
 t_insert_present :: (CritBitKey k, Ord k) => k -> [k] -> Bool
     partMap  = fixup Set.toList . Set.partition foo . Set.fromList $ ks
     foo = odd . byteCount
 
+t_mapMonotonic :: (CritBitKey k, Ord k, Monoid k, IsString k)
+               => k -> [k] -> Bool
+t_mapMonotonic = CS.mapMonotonic preps === Set.mapMonotonic preps
+  where preps = ("test" <>)
+
 propertiesFor :: (Arbitrary k, CritBitKey k, Ord k, Monoid k, Show k,
                   IsString k) => k -> [Test]
 propertiesFor t = [
   , testProperty "t_elems" $ t_elems t
   , testProperty "t_map" $ t_map t
   , testProperty "t_mapKeys" $ t_map t
+  , testProperty "t_mapMonotonic" $ t_mapMonotonic t
   , testProperty "t_toAscList" $ t_toAscList t
 #if MIN_VERSION_containers(0,5,0)
   , testProperty "t_toDescList" $ t_toDescList t