appendmap 0.1.4 → 0.1.5

raw patch · 6 files changed

+69/−12 lines, 6 filesdep +QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck

API changes (from Hackage documentation)

Files

• ChangeLog.md +2/−0
• appendmap.cabal +4/−3
• src/Data/Map/Append/Lazy.hs +12/−3
• src/Data/Map/Append/Strict.hs +10/−1
• src/Data/Map/Counter.hs +8/−1
• test/Spec.hs +33/−4

@@ -2,6 +2,8 @@  ## Unreleased changes +## 0.1.5+ ## 0.1.4  ## 0.1.3

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: da3c92d32d8763def130a63fd3d7770833e6f5a30a50b0a56e8d011019a440ec+-- hash: 3bb3e55562b1f29834565ea4cbe850f15c1e6069067b7876d0a414c62e1da4b7  name:           appendmap-version:        0.1.4+version:        0.1.5 synopsis:       Map with a Semigroup and Monoid instances delegating to Semigroup of the elements description:    Please see the README on GitHub at <https://github.com/koterpillar/appendmap#readme> category:       Data Structures@@ -50,7 +50,8 @@       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      appendmap+      QuickCheck+    , appendmap     , base >=4.7 && <5     , containers     , hspec

@@ -1,16 +1,25 @@+{-| A wrapper for 'Map' with a 'Semigroup' and 'Monoid' instances that delegate to+  the individual keys.+-} module Data.Map.Append.Lazy where -import           Data.Map           (Map)-import qualified Data.Map           as Map+import           Data.Map.Lazy      (Map)+import qualified Data.Map.Lazy      as Map  import           Data.Monoid        hiding ((<>)) import           Data.Semigroup  import qualified Data.List.NonEmpty as NE +-- | Map wrapper with 'Semigroup' and 'Monoid' instances that delegate to the+-- keys. It satisfies the following property:+--+-- > lookup k (m1 <> m2) === lookup k m1 <> lookup k m2+-- >   where+-- >     lookup key = Map.lookup key . unAppendMap newtype AppendMap k v = AppendMap   { unAppendMap :: Map k v-  }+  } deriving (Ord, Eq, Show)  instance (Ord k, Semigroup v) => Semigroup (AppendMap k v) where   AppendMap a <> AppendMap b = AppendMap $ Map.unionWith (<>) a b

@@ -1,3 +1,6 @@+{-| A wrapper for 'Map' with a 'Semigroup' and 'Monoid' instances that delegate to+  the individual keys.+-} module Data.Map.Append.Strict where  import           Data.Map.Strict    (Map)@@ -8,9 +11,15 @@  import qualified Data.List.NonEmpty as NE +-- | Map wrapper with 'Semigroup' and 'Monoid' instances that delegate to the+-- keys. It satisfies the following property:+--+-- > lookup k (m1 <> m2) === lookup k m1 <> lookup k m2+-- >   where+-- >     lookup key = Map.lookup key . unAppendMap newtype AppendMap k v = AppendMap   { unAppendMap :: Map k v-  }+  } deriving (Ord, Eq, Show)  instance (Ord k, Semigroup v) => Semigroup (AppendMap k v) where   AppendMap a <> AppendMap b = AppendMap $ Map.unionWith (<>) a b

@@ -1,3 +1,4 @@+-- | A 'Semigroup'-based counter type. module Data.Map.Counter where  import           Data.Map.Append.Strict@@ -6,10 +7,16 @@  import           Data.Monoid +-- | A 'Semigroup'-based counter type.+--+-- > let counts = mkCounter 1 <> mkCounter 2 <> mkCounter 1 :: Counter Int+-- > getCounts counts === Map.fromList [(1, 2), (2, 1)] type Counter key = AppendMap key (Sum Int) +-- | Counter that has a single occurrence for a single item. mkCounter :: Ord key => key -> Counter key mkCounter key = AppendMap $ Map.singleton key (Sum 1) +-- | Get counts as a map. getCounts :: Counter key -> Map key Int-getCounts = Map.map getSum . unAppendMap+getCounts = fmap getSum . unAppendMap

@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}  import qualified Data.Map.Append.Lazy   as Lazy import qualified Data.Map.Lazy          as Lazy@@ -10,21 +11,31 @@  import qualified Data.Map.Counter       as Counter +import           Data.Maybe+ import           Data.Semigroup +import           Data.Set               (Set)+import qualified Data.Set               as Set+ import           Test.Hspec+import           Test.QuickCheck  data AppendMap appendmap map = AppendMap-  { mapFromList :: [(Int, String)] -> map Int String-  , mapEmpty    :: map Int String-  , appendMap   :: forall k v. map k v -> appendmap k v-  , unAppendMap :: forall k v. appendmap k v -> map k v+  { mapFromList :: !(forall v. [(Int, v)] -> map Int v)+  , mapKeys     :: !(forall v. map Int v -> Set Int)+  , mapLookup   :: !(forall v. Int -> map Int v -> Maybe v)+  , mapEmpty    :: !(map Int String)+  , appendMap   :: !(forall k v. map k v -> appendmap k v)+  , unAppendMap :: !(forall k v. appendmap k v -> map k v)   }  lazy :: AppendMap Lazy.AppendMap Lazy.Map lazy =   AppendMap     { mapFromList = Lazy.fromList+    , mapKeys = Lazy.keysSet+    , mapLookup = Lazy.lookup     , mapEmpty = Lazy.empty     , appendMap = Lazy.AppendMap     , unAppendMap = Lazy.unAppendMap@@ -34,6 +45,8 @@ strict =   AppendMap     { mapFromList = Strict.fromList+    , mapKeys = Strict.keysSet+    , mapLookup = Strict.lookup     , mapEmpty = Strict.empty     , appendMap = Strict.AppendMap     , unAppendMap = Strict.unAppendMap@@ -42,6 +55,7 @@ appendMapSpec ::      ( Show (map Int String)      , Eq (map Int String)+     , Arbitrary (map Int String)      , Semigroup (appendmap Int String)      , Monoid (appendmap Int String)      )@@ -54,6 +68,21 @@     let two = appendMap $ mapFromList [(1, "world"), (3, "again")]     unAppendMap (one <> two) `shouldBe`       mapFromList [(1, "helloworld"), (2, "goodbye"), (3, "again")]+  it "is distributive against mconcat" $+    property $ \(maps :: [map Int String]) ->+      let appended = unAppendMap $ mconcat $ map appendMap maps+          individuallyAppended =+            mapFromList+              [ (k, mconcat $ mapMaybe (mapLookup k) maps)+              | k <- Set.toList $ Set.unions $ map mapKeys maps+              ]+       in appended === individuallyAppended+  it "is distributive over lookup" $+    property $ \(m1' :: map Int String) (m2' :: map Int String) (k :: Int) ->+      let lookup key = mapLookup key . unAppendMap+          m1 = appendMap m1'+          m2 = appendMap m2'+       in lookup k (m1 <> m2) === lookup k m1 <> lookup k m2  counterSpec :: Spec counterSpec =