Add Lift instances

Closes #342

Author: treeowl

Data/HashMap/Internal.hs

@@ -1,10 +1,14 @@
-{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE LambdaCase #-}
 #if __GLASGOW_HASKELL__ >= 802
 {-# LANGUAGE TypeInType #-}
 {-# LANGUAGE UnboxedSums #-}
@@ -180,6 +184,7 @@ import GHC.Exts (TYPE, Int (..), Int#)
 import Data.Functor.Identity (Identity (..))
 import Control.Applicative (Const (..))
 import Data.Coerce (coerce)
+import qualified Language.Haskell.TH.Syntax as TH
 
 -- | A set of values.  A set cannot contain duplicate values.
 ------------------------------------------------------------------------
@@ -189,7 +194,7 @@ hash :: H.Hashable a => a -> Hash
 hash = fromIntegral . H.hash
 
 data Leaf k v = L !k v
-  deriving (Eq)
+  deriving (Eq, TH.Lift)
 
 instance (NFData k, NFData v) => NFData (Leaf k v) where
     rnf (L k v) = rnf k `seq` rnf v
@@ -215,7 +220,7 @@ data HashMap k v
     | Leaf !Hash !(Leaf k v)
     | Full !(A.Array (HashMap k v))
     | Collision !Hash !(A.Array (Leaf k v))
-      deriving (Typeable)
+      deriving (Typeable, TH.Lift)
 
 type role HashMap nominal representational
 

Data/HashMap/Internal/Array.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
 {-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
 {-# OPTIONS_HADDOCK not-home #-}
 
@@ -69,6 +70,7 @@ module Data.HashMap.Internal.Array
     , traverse'
     , toList
     , fromList
+    , fromList'
     ) where
 
 import Control.Applicative (liftA2)
@@ -84,6 +86,8 @@ import GHC.Exts (SmallArray#, newSmallArray#, readSmallArray#, writeSmallArray#,
                  SmallMutableArray#, sizeofSmallArray#, copySmallArray#, thawSmallArray#,
                  sizeofSmallMutableArray#, copySmallMutableArray#, cloneSmallMutableArray#)
 
+import qualified Language.Haskell.TH.Syntax as TH
+
 #if defined(ASSERTS)
 import qualified Prelude
 #endif
@@ -474,6 +478,27 @@ fromList n xs0 =
     go (x:xs) mary i = do write mary i x
                           go xs mary (i+1)
 
+fromList' :: Int -> [a] -> Array a
+fromList' n xs0 =
+    CHECK_EQ("fromList'", n, Prelude.length xs0)
+        run $ do
+            mary <- new_ n
+            go xs0 mary 0
+  where
+    go [] !mary !_   = return mary
+    go (!x:xs) mary i = do write mary i x
+                           go xs mary (i+1)
+
+instance TH.Lift a => TH.Lift (Array a) where
+#if MIN_VERSION_template_haskell(2,16,0)
+  liftTyped ar = [|| fromList' arlen arlist ||]
+#else
+  lift ar = [| fromList' arlen arlist |]
+#endif
+    where
+      arlen = length ar
+      arlist = toList ar
+
 toList :: Array a -> [a]
 toList = foldr (:) []
 

Data/HashSet/Internal.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE Trustworthy #-}
@@ -114,11 +116,12 @@ import qualified Data.Hashable.Lifted as H
 #if MIN_VERSION_deepseq(1,4,3)
 import qualified Control.DeepSeq as NF
 #endif
+import qualified Language.Haskell.TH.Syntax as TH
 
 -- | A set of values.  A set cannot contain duplicate values.
 newtype HashSet a = HashSet {
       asMap :: HashMap a ()
-    } deriving (Typeable)
+    } deriving (Typeable, TH.Lift)
 
 type role HashSet nominal
 

unordered-containers.cabal

@@ -56,7 +56,8 @@ library
   build-depends:
     base >= 4.9 && < 5,
     deepseq >= 1.1,
-    hashable >= 1.0.1.1 && < 1.5
+    hashable >= 1.0.1.1 && < 1.5,
+    template-haskell
 
   default-language: Haskell2010