Skip to content

Commit

Permalink
Make tests pass
Browse files Browse the repository at this point in the history
  • Loading branch information
jappeace committed Sep 22, 2021
1 parent d691df5 commit 70f5bdc
Show file tree
Hide file tree
Showing 4 changed files with 24 additions and 6 deletions.
9 changes: 9 additions & 0 deletions Data/HashMap/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,8 @@ module Data.HashMap.Internal
, fromList'
, fromListWith
, fromListWithKey
, fromListWith'
, fromListWithKey'

-- Internals used by the strict version
, Hash
Expand Down Expand Up @@ -248,6 +250,13 @@ data HashMapT (salt :: Nat) k v
-- backwards compatibility
type HashMap = HashMapT DefaultSalt

-- Allows coercion of a hashmap for example:
--
-- >>> newtype X = MkX Text
-- >>> coerce (HashMap Text X) = HashMap Text Text
--
-- nominal role indicates that this isn't allowed.
-- we don't want to coerce key's or salt, because it'd cause issues.
type role HashMapT nominal nominal representational

instance (NFData k, NFData v) => NFData (HashMapT salt k v) where
Expand Down
6 changes: 6 additions & 0 deletions Data/HashMap/Lazy.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,10 +28,13 @@ module Data.HashMap.Lazy
-- $strictness

HashMap
, HashMapT

-- * Construction
, empty
, singleton
, empty'
, singleton'

-- * Basic interface
, null
Expand Down Expand Up @@ -101,6 +104,9 @@ module Data.HashMap.Lazy
, fromList
, fromListWith
, fromListWithKey
, fromList'
, fromListWith'
, fromListWithKey'

-- ** HashSets
, HS.keysSet
Expand Down
10 changes: 6 additions & 4 deletions tests/HashMapProperties.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module Main (main) where

import Control.Monad ( guard )
import qualified Data.Foldable as Foldable
import GHC.TypeNats(KnownNat)
#if MIN_VERSION_base(4,10,0)
import Data.Bifoldable
#endif
Expand All @@ -16,11 +17,11 @@ import Data.Hashable (Hashable(hashWithSalt))
import qualified Data.List as L
import Data.Ord (comparing)
#if defined(STRICT)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict (HashMap, HashMapT)
import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as M
#else
import Data.HashMap.Lazy (HashMap)
import Data.HashMap.Lazy (HashMap, HashMapT)
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map.Lazy as M
#endif
Expand All @@ -41,8 +42,9 @@ newtype Key = K { unK :: Int }
instance Hashable Key where
hashWithSalt salt k = hashWithSalt salt (unK k) `mod` 20

instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where
arbitrary = fmap (HM.fromList) arbitrary
instance (Eq k, Hashable k, Arbitrary k, Arbitrary v, KnownNat salt)
=> Arbitrary (HashMapT salt k v) where
arbitrary = fmap (HM.fromList') arbitrary

------------------------------------------------------------------------
-- * Properties
Expand Down
5 changes: 3 additions & 2 deletions tests/Strictness.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP, FlexibleInstances, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Main (main) where
Expand Down Expand Up @@ -125,7 +126,7 @@ pFromListWithValueResultStrict :: [(Key, Maybe A)]
pFromListWithValueResultStrict lst comb_lazy calc_good_raw
= all (all isJust) recovered .&&. (recovered === recover (fmap recover fake_map))
where
recovered :: Maybe (HashMapT salt Key (Maybe A))
recovered :: Maybe (HashMap Key (Maybe A))
recovered = recover (fmap recover real_map)
-- What we get out of the conversion using insertWith
fake_map = foldl' (\m (k,v) -> HM.insertWith real_comb k v m) HM.empty real_list
Expand Down Expand Up @@ -191,7 +192,7 @@ main = defaultMain tests
------------------------------------------------------------------------
-- * Utilities

keyStrict :: (Key -> HashMapT salt Key Int -> a) -> HashMapT salt Key Int -> Bool
keyStrict :: (Key -> HashMap Key Int -> a) -> HashMap Key Int -> Bool
keyStrict f m = isBottom $ f bottom m

const2 :: a -> b -> c -> a
Expand Down

0 comments on commit 70f5bdc

Please sign in to comment.