Build values eagerly on lift

haskell-unordered-containers · Dec 22, 2021 · 8ae3071 · 8ae3071
1 parent c52a526
commit 8ae3071
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 3 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -2,6 +2,8 @@
 
 * Define `dataCast1` for `HashMap`.
 
+* [Add `Lift` instances for Template Haskell](https://github.com/haskell-unordered-containers/unordered-containers/pull/343)
+
 ## [0.2.16.0]
 
 * [Increase maximum branching factor from 16 to 32](https://github.com/haskell-unordered-containers/unordered-containers/pull/317)

diff --git a/Data/HashMap/Internal.hs b/Data/HashMap/Internal.hs
@@ -6,6 +6,8 @@
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UnboxedTuples #-}
 #if __GLASGOW_HASKELL__ >= 802
@@ -192,11 +194,19 @@ hash :: H.Hashable a => a -> Hash
 hash = fromIntegral . H.hash
 
 data Leaf k v = L !k v
-  deriving (Eq, TH.Lift)
+  deriving (Eq)
 
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
 
+-- | @since 0.2.17.0
+instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
+#if MIN_VERSION_template_haskell(2,16,0)
+  liftTyped (L k v) = [|| L k $! v ||]
+#else
+  lift (L k v) = [| L k $! v |]
+#endif
+
 #if MIN_VERSION_deepseq(1,4,3)
 -- | @since 0.2.14.0
 instance NFData k => NF.NFData1 (Leaf k) where
@@ -218,10 +228,12 @@ data HashMap k v
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
     | Collision !Hash !(A.Array (Leaf k v))
-      deriving (TH.Lift)
 
 type role HashMap nominal representational
 
+-- | @since 0.2.17.0
+deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)
+
 instance (NFData k, NFData v) => NFData (HashMap k v) where
     rnf Empty                 = ()
     rnf (BitmapIndexed _ ary) = rnf ary

diff --git a/Data/HashSet/Internal.hs b/Data/HashSet/Internal.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE Trustworthy #-}
 {-# OPTIONS_HADDOCK not-home #-}
@@ -121,10 +122,12 @@ import qualified Language.Haskell.TH.Syntax as TH
 newtype HashSet a = HashSet {
       asMap :: HashMap a ()
     }
-    } deriving (TH.Lift)
 
 type role HashSet nominal
 
+-- | @since 0.2.17.0
+deriving instance TH.Lift a => TH.Lift (HashSet a)
+
 instance (NFData a) => NFData (HashSet a) where
     rnf = rnf . asMap
     {-# INLINE rnf #-}