diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -28,7 +28,7 @@ - env: GHCVER=7.10.3 CABALVER=1.24 compiler: ghc-7.10.3 addons: {apt: {packages: [cabal-install-1.24, ghc-7.10.3, alex-3.1.4, happy-1.19.5], sources: [hvr-ghc]}} - - env: GHCVER=8.0.1 CABALVER=1.24 ROOT=1 + - env: GHCVER=8.0.1 CABALVER=1.24 compiler: ghc-8.0.1 addons: {apt: {packages: [cabal-install-1.24, ghc-8.0.1, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} - env: GHCVER=8.2.2 CABALVER=2.0 @@ -37,10 +37,16 @@ - env: GHCVER=8.4.4 CABALVER=2.2 compiler: ghc-8.4.4 addons: {apt: {packages: [cabal-install-2.2, ghc-8.4.4, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} - - env: GHCVER=8.6.3 CABALVER=2.4 - compiler: ghc-8.6.3 - addons: {apt: {packages: [cabal-install-2.4, ghc-8.6.3, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} - - env: GHCVER=head CABALVER=head ALLOW_NEWER="template-haskell" + - env: GHCVER=8.6.5 CABALVER=2.4 + compiler: ghc-8.6.5 + addons: {apt: {packages: [cabal-install-2.4, ghc-8.6.5, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} + - env: GHCVER=8.8.3 CABALVER=3.0 ROOT=1 V2=1 + compiler: ghc-8.8.3 + addons: {apt: {packages: [cabal-install-3.0, ghc-8.8.3, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} + - env: GHCVER=8.10.1 CABALVER=3.2 V2=1 + compiler: ghc-8.10.1 + addons: {apt: {packages: [cabal-install-3.2, ghc-8.10.1, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} + - env: GHCVER=head CABALVER=head ALLOW_NEWER="template-haskell" V2=1 compiler: ghc-head addons: {apt: {packages: [cabal-install-head, ghc-head, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} allow_failures: diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2013-2016 Benno Fünfstück +Copyright 2013-2020 Benno Fünfstück All rights reserved. diff --git a/src/Instances/TH/Lift.hs b/src/Instances/TH/Lift.hs --- a/src/Instances/TH/Lift.hs +++ b/src/Instances/TH/Lift.hs @@ -54,6 +54,9 @@ ) where import Language.Haskell.TH.Syntax (Lift(..)) +#if MIN_VERSION_template_haskell(2,16,0) +import Language.Haskell.TH.Syntax (unsafeTExpCoerce) +#endif import Language.Haskell.TH import qualified Data.Foldable as F @@ -110,6 +113,17 @@ import Control.Applicative (Const (..)) import Data.Functor.Identity (Identity (..)) +-- support typed template haskell (requires template-haskell>=1.16) +#if MIN_VERSION_template_haskell(2,16,0) +#define LIFT liftTyped +#define QUOTE(x) [|| (x) ||] +#define TYPED_RETURN unsafeTExpCoerce . return +#else +#define LIFT lift +#define QUOTE(x) [| (x) |] +#define TYPED_RETURN return +#endif + -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- @@ -179,45 +193,45 @@ -------------------------------------------------------------------------------- -- Containers instance Lift v => Lift (IntMap.IntMap v) where - lift m = [| IntMap.fromList m' |] where - m' = IntMap.toList m + LIFT m = QUOTE(IntMap.fromDistinctAscList ml) where + ml = IntMap.toAscList m instance Lift IntSet.IntSet where - lift s = [| IntSet.fromList s' |] where - s' = IntSet.toList s + LIFT s = QUOTE(IntSet.fromDistinctAscList sl) where + sl = IntSet.toAscList s instance (Lift k, Lift v) => Lift (Map.Map k v) where - lift m = [| Map.fromList m' |] where - m' = Map.toList m + LIFT m = QUOTE(Map.fromDistinctAscList ml) where + ml = Map.toAscList m instance Lift a => Lift (Sequence.Seq a) where - lift s = [| Sequence.fromList s' |] where - s' = F.toList s + LIFT s = QUOTE(Sequence.fromList sl) where + sl = F.toList s instance Lift a => Lift (Set.Set a) where - lift s = [| Set.fromList s' |] where - s' = Set.toList s + LIFT s = QUOTE(Set.fromDistinctAscList sl) where + sl = Set.toAscList s instance Lift a => Lift (Tree.Tree a) where - lift (Tree.Node x xs) = [| Tree.Node x xs |] + LIFT (Tree.Node x xs) = QUOTE(Tree.Node x xs) #if !MIN_VERSION_text(1,2,4) -------------------------------------------------------------------------------- -- Text instance Lift Text.Text where - lift t = [| Text.pack t' |] where - t' = Text.unpack t + LIFT t = QUOTE(Text.pack tp) where + tp = Text.unpack t instance Lift Text.Lazy.Text where - lift t = [| Text.Lazy.pack t' |] where - t' = Text.Lazy.unpack t + LIFT t = QUOTE(Text.Lazy.pack tp) where + tp = Text.Lazy.unpack t #endif -------------------------------------------------------------------------------- -- ByteString instance Lift ByteString.ByteString where -- this is essentially what e.g. file-embed does - lift b = return $ AppE (VarE 'unsafePerformIO) $ + LIFT b = TYPED_RETURN $ AppE (VarE 'unsafePerformIO) $ VarE 'ByteString.Unsafe.unsafePackAddressLen `AppE` l `AppE` b' where l = LitE $ IntegerL $ fromIntegral $ ByteString.length b @@ -229,34 +243,35 @@ #endif instance Lift ByteString.Lazy.ByteString where - lift lb = do - b' <- lift b - return (VarE 'ByteString.Lazy.fromChunks `AppE` b') - where - b = ByteString.Lazy.toChunks lb + LIFT lb = QUOTE(ByteString.Lazy.fromChunks bc) where + bc = ByteString.Lazy.toChunks lb -------------------------------------------------------------------------------- -- Vector instance (Vector.Primitive.Prim a, Lift a) => Lift (Vector.Primitive.Vector a) where - lift v = [| Vector.Primitive.fromList v' |] where - v' = Vector.Primitive.toList v + LIFT v = QUOTE(Vector.Primitive.fromListN np vp) where + np = Vector.Primitive.length v + vp = Vector.Primitive.toList v instance (Vector.Storable.Storable a, Lift a) => Lift (Vector.Storable.Vector a) where - lift v = [| Vector.Storable.fromList v' |] where - v' = Vector.Storable.toList v + LIFT v = QUOTE(Vector.Storable.fromListN np vp) where + np = Vector.Storable.length v + vp = Vector.Storable.toList v instance (Vector.Unboxed.Unbox a, Lift a) => Lift (Vector.Unboxed.Vector a) where - lift v = [| Vector.Unboxed.fromList v' |] where - v' = Vector.Unboxed.toList v + LIFT v = QUOTE(Vector.Unboxed.fromListN np vp) where + np = Vector.Unboxed.length v + vp = Vector.Unboxed.toList v instance Lift a => Lift (Vector.Boxed.Vector a) where - lift v = [| Vector.Boxed.fromList v' |] where - v' = Vector.Boxed.toList v + LIFT v = QUOTE(Vector.Boxed.fromListN np vp) where + np = Vector.Boxed.length v + vp = Vector.Boxed.toList v -------------------------------------------------------------------------------- -- Transformers instance Lift a => Lift (Identity a) where - lift (Identity a) = [| Identity a |] + LIFT (Identity a) = QUOTE(Identity a) instance Lift a => Lift (Const a b) where - lift (Const a) = [| Const a |] + LIFT (Const a) = QUOTE(Const a) diff --git a/th-lift-instances.cabal b/th-lift-instances.cabal --- a/th-lift-instances.cabal +++ b/th-lift-instances.cabal @@ -1,20 +1,19 @@ name: th-lift-instances -version: 0.1.14 +version: 0.1.15 cabal-version: >=1.10 build-type: Simple license: BSD3 license-file: LICENSE -copyright: Copyright (C) 2013-2016 Benno Fünfstück +copyright: Copyright (C) 2013-2020 Benno Fünfstück maintainer: Benno Fünfstück stability: experimental homepage: http://github.com/bennofs/th-lift-instances/ bug-reports: http://github.com/bennofs/th-lift-instances/issues synopsis: Lift instances for template-haskell for common data types. description: - Most data types in haskell platform do not have Lift instances. + Most data types in the haskell platform do not have Lift instances. This package provides orphan instances for containers, text, bytestring and vector. - It also acts as a compat instances, definining instances not existing - in @template-haskell@ + It also provides compat instances for older versions of @template-haskell@ . Note that package provides Template Haskell based derivation of @Lift@ instances (when you cannot use @DeriveLift@ extension), @@ -38,7 +37,7 @@ base >=4.3 && <5, template-haskell >=2.5.0.0, containers, - vector >= 0.4, + vector >= 0.7, text, transformers, bytestring