th-lift-instances-0.1.20/0000755000000000000000000000000007346545000013317 5ustar0000000000000000th-lift-instances-0.1.20/.ghci0000644000000000000000000000012507346545000014230 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h th-lift-instances-0.1.20/.gitignore0000644000000000000000000000016307346545000015307 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# .cabal-sandbox cabal.sandbox.config .stack-workth-lift-instances-0.1.20/.travis.yml0000644000000000000000000000502507346545000015432 0ustar0000000000000000language: c sudo: false cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages - $HOME/tools before_cache: - rm -f $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar before_install: source travis/setup.sh install: travis/install.sh script: travis/script.sh matrix: include: - env: GHCVER=7.2.2 CABALVER=1.18 compiler: ghc-7.2.2 addons: {apt: {packages: [cabal-install-1.18, ghc-7.2.2, alex-3.1.4, happy-1.19.5], sources: [hvr-ghc]}} - env: GHCVER=7.4.2 CABALVER=1.24 compiler: ghc-7.4.2 addons: {apt: {packages: [cabal-install-1.24, ghc-7.4.2, alex-3.1.4, happy-1.19.5], sources: [hvr-ghc]}} - env: GHCVER=7.6.3 CABALVER=1.24 compiler: ghc-7.6.3 addons: {apt: {packages: [cabal-install-1.24, ghc-7.6.3, alex-3.1.4, happy-1.19.5], sources: [hvr-ghc]}} - env: GHCVER=7.8.4 CABALVER=1.24 compiler: ghc-7.8.4 addons: {apt: {packages: [cabal-install-1.24, ghc-7.8.4, alex-3.1.4, happy-1.19.5], sources: [hvr-ghc]}} - 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 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 compiler: ghc-8.2.2 addons: {apt: {packages: [cabal-install-2.0, ghc-8.2.2, alex-3.1.7, happy-1.19.5], sources: [hvr-ghc]}} - 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.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: - compiler: ghc-head fast_finish: true th-lift-instances-0.1.20/LICENSE0000644000000000000000000000266507346545000014335 0ustar0000000000000000Copyright 2013-2020 Benno Fünfstück All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. th-lift-instances-0.1.20/README.md0000644000000000000000000000014107346545000014572 0ustar0000000000000000th-lift-instances ==================== Some more Lift instances for common haskell data types. th-lift-instances-0.1.20/Setup.hs0000644000000000000000000000005607346545000014754 0ustar0000000000000000import Distribution.Simple main = defaultMain th-lift-instances-0.1.20/src/Instances/TH/0000755000000000000000000000000007346545000016350 5ustar0000000000000000th-lift-instances-0.1.20/src/Instances/TH/Lift.hs0000644000000000000000000003003307346545000017601 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE DeriveLift #-} {-# LANGUAGE StandaloneDeriving #-} #else {-# LANGUAGE TemplateHaskell #-} #endif module Instances.TH.Lift ( -- | This module provides orphan instances for the 'Language.Haskell.TH.Syntax.Lift' class from template-haskell. Following is a list of the provided instances. -- -- Lift instances are useful to precompute values at compile time using template haskell. For example, if you write the following code, -- you can make sure that @3 * 10@ is really computed at compile time: -- -- > {-# LANGUAGE TemplateHaskell #-} -- > -- > import Language.Haskell.TH.Syntax -- > -- > expensiveComputation :: Word32 -- > expensiveComputation = $(lift $ 3 * 10) -- This will computed at compile time -- -- This uses the Lift instance for Word32. -- -- The following instances are provided by this package: -- * Base -- | * 'Word8', 'Word16', 'Word32', 'Word64' -- -- * 'Int8', 'Int16', 'Int32', 'Int64' -- -- * 'NonEmpty' and 'Void', until provided by @template-haskell-2.15@ -- * Containers (both strict/lazy) -- | * 'Data.IntMap.IntMap' -- -- * 'Data.IntSet.IntSet' -- -- * 'Data.Map.Map' -- -- * 'Data.Set.Set' -- -- * 'Data.Tree.Tree' -- -- * 'Data.Sequence.Seq' -- * ByteString (both strict/lazy) -- | * 'Data.ByteString.ByteString' -- * Text (both strict/lazy) -- | * 'Data.Text.Text' -- * Vector (Boxed, Unboxed, Storable, Primitive) -- | * 'Data.Vector.Vector' ) 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 -- Base #if !MIN_VERSION_template_haskell(2,9,1) import Data.Int import Data.Word #endif #if !MIN_VERSION_template_haskell(2,10,0) import Data.Ratio (Ratio) #endif #if !MIN_VERSION_template_haskell(2,15,0) #if MIN_VERSION_base(4,8,0) import Data.Void (Void, absurd) #endif #if MIN_VERSION_base(4,9,0) import Data.List.NonEmpty (NonEmpty (..)) #endif #endif -- Containers #if !MIN_VERSION_containers(0,6,6) import qualified Data.Tree as Tree #if MIN_VERSION_containers(0,5,10) -- recent enough containers exports internals, -- so we can use DeriveLift -- This way we construct the data type exactly as we have it -- during compile time, so there is nothing left for run-time. #define HAS_CONTAINERS_INTERNALS 1 import qualified Data.IntMap.Internal as IntMap import qualified Data.IntSet.Internal as IntSet import qualified Data.Map.Internal as Map import qualified Data.Set.Internal as Set import qualified Data.Sequence.Internal as Sequence # if __GLASGOW_HASKELL__ >= 708 import Data.Coerce (coerce) # else import Unsafe.Coerce (unsafeCoerce) # endif #else import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Sequence as Sequence import qualified Data.Foldable as F #endif # endif #if !MIN_VERSION_text(1,2,4) -- Text import qualified Data.Text as Text import qualified Data.Text.Lazy as Text.Lazy #endif #if !MIN_VERSION_bytestring(0,11,2) -- ByteString import qualified Data.ByteString as ByteString import qualified Data.ByteString.Unsafe as ByteString.Unsafe import qualified Data.ByteString.Lazy as ByteString.Lazy import System.IO.Unsafe (unsafePerformIO) #if !MIN_VERSION_template_haskell(2, 8, 0) import qualified Data.ByteString.Char8 as ByteString.Char8 #endif #endif -- Vector import qualified Data.Vector as Vector.Boxed import qualified Data.Vector.Primitive as Vector.Primitive import qualified Data.Vector.Storable as Vector.Storable import qualified Data.Vector.Unboxed as Vector.Unboxed -- transformers (or base) import Control.Applicative (Const (..)) import Data.Functor.Identity (Identity (..)) #if MIN_VERSION_template_haskell(2,17,0) #define LIFT_TYPED_DEFAULT liftTyped = Code . unsafeTExpCoerce . lift #elif MIN_VERSION_template_haskell(2,16,0) #define LIFT_TYPED_DEFAULT liftTyped = unsafeTExpCoerce . lift #else #define LIFT_TYPED_DEFAULT #endif -------------------------------------------------------------------------------- -------------------------------------------------------------------------------- #if !MIN_VERSION_template_haskell(2,9,1) -- Base instance Lift Word8 where lift x = [| fromInteger x' :: Word8 |] where x' = toInteger x instance Lift Word16 where lift x = [| fromInteger x' :: Word16 |] where x' = toInteger x instance Lift Word32 where lift x = [| fromInteger x' :: Word32 |] where x' = toInteger x instance Lift Word64 where lift x = [| fromInteger x' :: Word64 |] where x' = toInteger x instance Lift Int8 where lift x = [| fromInteger x' :: Int8 |] where x' = toInteger x instance Lift Int16 where lift x = [| fromInteger x' :: Int16 |] where x' = toInteger x instance Lift Int32 where lift x = [| fromInteger x' :: Int32 |] where x' = toInteger x instance Lift Int64 where lift x = [| fromInteger x' :: Int64 |] where x' = toInteger x instance Lift Float where lift x = return (LitE (RationalL (toRational x))) instance Lift Double where lift x = return (LitE (RationalL (toRational x))) # endif #if !MIN_VERSION_template_haskell(2,10,0) instance Lift () where lift () = [| () |] instance Integral a => Lift (Ratio a) where lift x = return (LitE (RationalL (toRational x))) #endif #if !MIN_VERSION_template_haskell(2,15,0) #if MIN_VERSION_base(4,8,0) instance Lift Void where lift = absurd #endif #if MIN_VERSION_base(4,9,0) instance Lift a => Lift (NonEmpty a) where lift (x :| xs) = [| x :| xs |] #endif #endif -------------------------------------------------------------------------------- -- Containers -- #if !MIN_VERSION_containers(0,6,6) #if __GLASGOW_HASKELL__ >= 800 deriving instance Lift a => Lift (Tree.Tree a) #else instance Lift a => Lift (Tree.Tree a) where lift (Tree.Node x xs) = [| Tree.Node x xs |] LIFT_TYPED_DEFAULT #endif #if __GLASGOW_HASKELL__ >= 800 deriving instance Lift a => Lift (Sequence.ViewL a) deriving instance Lift a => Lift (Sequence.ViewR a) #else instance Lift a => Lift (Sequence.ViewL a) where lift Sequence.EmptyL = [| Sequence.EmptyL |] lift (x Sequence.:< xs) = [| x Sequence.:< xs |] LIFT_TYPED_DEFAULT instance Lift a => Lift (Sequence.ViewR a) where lift Sequence.EmptyR = [| Sequence.EmptyR |] lift (xs Sequence.:> x) = [| xs Sequence.:> x |] LIFT_TYPED_DEFAULT #endif #if HAS_CONTAINERS_INTERNALS -- The coercion gunk reduces the expression size by a substantial -- constant factor, which I imagine is good for compilation -- speed. instance Lift a => Lift (Sequence.Seq a) where lift xs = [| fixupSeq ft' |] where -- The tree produced by zipWith has the same shape as -- that of its first argument. replicate produces a shallow -- tree, which is usually desirable. Sequence.Seq rebalanced = Sequence.zipWith (flip const) (Sequence.replicate (Sequence.length xs) ()) xs ft' :: Sequence.FingerTree a ft' = stripElem rebalanced LIFT_TYPED_DEFAULT fixupSeq :: Sequence.FingerTree a -> Sequence.Seq a stripElem :: Sequence.FingerTree (Sequence.Elem a) -> Sequence.FingerTree a # if __GLASGOW_HASKELL__ >= 708 fixupSeq = coerce stripElem = coerce # else fixupSeq = unsafeCoerce stripElem = unsafeCoerce # endif # if __GLASGOW_HASKELL__ >= 800 deriving instance Lift a => Lift (Sequence.Digit a) deriving instance Lift a => Lift (Sequence.Node a) deriving instance Lift a => Lift (Sequence.FingerTree a) # else instance Lift a => Lift (Sequence.Elem a) where lift (Sequence.Elem a) = [| Sequence.Elem a |] LIFT_TYPED_DEFAULT instance Lift a => Lift (Sequence.Digit a) where lift (Sequence.One a) = [| Sequence.One a |] lift (Sequence.Two a b) = [| Sequence.Two a b |] lift (Sequence.Three a b c) = [| Sequence.Three a b c |] lift (Sequence.Four a b c d) = [| Sequence.Four a b c d |] LIFT_TYPED_DEFAULT instance Lift a => Lift (Sequence.Node a) where lift (Sequence.Node2 s a b) = [| Sequence.Node2 s a b |] lift (Sequence.Node3 s a b c) = [| Sequence.Node3 s a b c |] LIFT_TYPED_DEFAULT instance Lift a => Lift (Sequence.FingerTree a) where lift Sequence.EmptyT = [| Sequence.EmptyT |] lift (Sequence.Single a) = [| Sequence.Single a |] lift (Sequence.Deep s pr m sf) = [| Sequence.Deep s pr m sf |] LIFT_TYPED_DEFAULT # endif #endif #if HAS_CONTAINERS_INTERNALS && __GLASGOW_HASKELL__ >= 800 deriving instance Lift v => Lift (IntMap.IntMap v) deriving instance Lift IntSet.IntSet deriving instance (Lift k, Lift v) => Lift (Map.Map k v) deriving instance Lift a => Lift (Set.Set a) #else -- No containers internals here, or no Lift deriving instance Lift v => Lift (IntMap.IntMap v) where lift m = [| IntMap.fromDistinctAscList m' |] where m' = IntMap.toAscList m LIFT_TYPED_DEFAULT instance Lift IntSet.IntSet where lift s = [| IntSet.fromList s' |] where s' = IntSet.toList s LIFT_TYPED_DEFAULT instance (Lift k, Lift v) => Lift (Map.Map k v) where lift m = [| Map.fromDistinctAscList m' |] where m' = Map.toAscList m LIFT_TYPED_DEFAULT instance Lift a => Lift (Set.Set a) where lift s = [| Set.fromDistinctAscList s' |] where s' = Set.toAscList s LIFT_TYPED_DEFAULT #endif #if !HAS_CONTAINERS_INTERNALS instance Lift a => Lift (Sequence.Seq a) where lift s = [| Sequence.fromList s' |] where s' = F.toList s LIFT_TYPED_DEFAULT #endif # endif #if !MIN_VERSION_text(1,2,4) -------------------------------------------------------------------------------- -- Text instance Lift Text.Text where lift t = [| Text.pack t' |] where t' = Text.unpack t LIFT_TYPED_DEFAULT instance Lift Text.Lazy.Text where lift t = [| Text.Lazy.pack t' |] where t' = Text.Lazy.unpack t LIFT_TYPED_DEFAULT #endif #if !MIN_VERSION_bytestring(0,11,2) -------------------------------------------------------------------------------- -- ByteString instance Lift ByteString.ByteString where -- this is essentially what e.g. file-embed does lift b = return $ AppE (VarE 'unsafePerformIO) $ VarE 'ByteString.Unsafe.unsafePackAddressLen `AppE` l `AppE` b' where l = LitE $ IntegerL $ fromIntegral $ ByteString.length b b' = #if MIN_VERSION_template_haskell(2, 8, 0) LitE $ StringPrimL $ ByteString.unpack b #else LitE $ StringPrimL $ ByteString.Char8.unpack b #endif LIFT_TYPED_DEFAULT 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_TYPED_DEFAULT #endif -------------------------------------------------------------------------------- -- Vector instance (Vector.Primitive.Prim a, Lift a) => Lift (Vector.Primitive.Vector a) where lift v = [| Vector.Primitive.fromListN n' v' |] where n' = Vector.Primitive.length v v' = Vector.Primitive.toList v LIFT_TYPED_DEFAULT instance (Vector.Storable.Storable a, Lift a) => Lift (Vector.Storable.Vector a) where lift v = [| Vector.Storable.fromListN n' v' |] where n' = Vector.Storable.length v v' = Vector.Storable.toList v LIFT_TYPED_DEFAULT instance (Vector.Unboxed.Unbox a, Lift a) => Lift (Vector.Unboxed.Vector a) where lift v = [| Vector.Unboxed.fromListN n' v' |] where n' = Vector.Unboxed.length v v' = Vector.Unboxed.toList v LIFT_TYPED_DEFAULT instance Lift a => Lift (Vector.Boxed.Vector a) where lift v = [| Vector.Boxed.fromListN n' v' |] where n' = Vector.Boxed.length v v' = Vector.Boxed.toList v LIFT_TYPED_DEFAULT -------------------------------------------------------------------------------- -- Transformers #if __GLASGOW_HASKELL__ >= 800 deriving instance Lift a => Lift (Identity a) deriving instance Lift a => Lift (Const a b) #else instance Lift a => Lift (Identity a) where lift (Identity a) = [| Identity a |] instance Lift a => Lift (Const a b) where lift (Const a) = [| Const a |] #endif th-lift-instances-0.1.20/tests/0000755000000000000000000000000007346545000014461 5ustar0000000000000000th-lift-instances-0.1.20/tests/Data.hs0000644000000000000000000000162107346545000015666 0ustar0000000000000000module Data where import Data.Tree import Data.Word import Numeric.Natural (Natural) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as ByteString.Lazy mapdata :: [(Int, Rational)] mapdata = [(10, 20), (3,13), (2242,234), (324, 543.3)] setdata :: [Int] setdata = [1,2,3,4,1,2,6,1,4367,832,23,56] treedata :: Tree Double treedata = Node 1 [Node 2 [], Node 5 [], Node 6 [Node 7 [], Node 8.9 []]] textdata :: String textdata = "Some text! Hello world!" bytedata :: [Word8] bytedata = map fromIntegral setdata bigByteString :: ByteString.ByteString bigByteString = ByteString.pack $ replicate 16384 97 -- 'a' bigLazyByteString :: ByteString.Lazy.ByteString bigLazyByteString = ByteString.Lazy.pack $ replicate 16384 98 -- 'b' nonEmptyNatural :: NonEmpty Natural nonEmptyNatural = 0 :| [1, 2, 3] natural1 :: Natural natural1 = 1 th-lift-instances-0.1.20/tests/Main.hs0000644000000000000000000001017107346545000015701 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Main where import Data import Control.Monad import Data.Int import Data.Word import Instances.TH.Lift() import Language.Haskell.TH.Syntax import System.Exit import Test.QuickCheck.All import Numeric.Natural (Natural) import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.Map as Map import qualified Data.Sequence as Sequence import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Text.Lazy as Text.Lazy import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as ByteString.Lazy import qualified Data.Vector as Vector.Boxed import qualified Data.Vector.Primitive as Vector.Primitive import qualified Data.Vector.Storable as Vector.Storable import qualified Data.Vector.Unboxed as Vector.Unboxed -------------------------------------------------------------------------------- -- Base prop_word8 :: Bool prop_word8 = $(lift (10 :: Word8)) == (10 :: Word8) prop_word16 :: Bool prop_word16 = $(lift (10 :: Word16)) == (10 :: Word16) prop_word32 :: Bool prop_word32 = $(lift (10 :: Word32)) == (10 :: Word32) prop_word64 :: Bool prop_word64 = $(lift (10 :: Word64)) == (10 :: Word64) prop_int8 :: Bool prop_int8 = $(lift (10 :: Int8)) == (10 :: Int8) prop_int16 :: Bool prop_int16 = $(lift (10 :: Int16)) == (10 :: Int16) prop_int32 :: Bool prop_int32 = $(lift (10 :: Int32)) == (10 :: Int32) prop_int64 :: Bool prop_int64 = $(lift (10 :: Int64)) == (10 :: Int64) prop_float :: Bool prop_float = $(lift (1.1 :: Float)) == (1.1 :: Float) prop_double :: Bool prop_double = $(lift (1.1 :: Double)) == (1.1 :: Double) prop_natural :: Bool prop_natural = $(lift (1 :: Natural)) == (1 :: Natural) prop_nonempty_natural :: Bool #if MIN_VERSION_base(4,10,0) -- this test will fail, as there aren't yet semigroups with NonEmpty instance prop_nonempty_natural = $(lift nonEmptyNatural) == nonEmptyNatural #else prop_nonempty_natural = True #endif prop_unit :: Bool prop_unit = $(lift ()) == () -------------------------------------------------------------------------------- -- Containers prop_lazy_int_map :: Bool prop_lazy_int_map = $(lift $ IntMap.fromList mapdata) == IntMap.fromList mapdata prop_lazy_map :: Bool prop_lazy_map = $(lift $ Map.fromList mapdata) == Map.fromList mapdata prop_int_set :: Bool prop_int_set = $(lift $ IntSet.fromList setdata) == IntSet.fromList setdata prop_set :: Bool prop_set = $(lift $ Set.fromList setdata) == Set.fromList setdata prop_tree :: Bool prop_tree = $(lift treedata) == treedata prop_sequence :: Bool prop_sequence = $(lift $ Sequence.fromList setdata) == Sequence.fromList setdata -------------------------------------------------------------------------------- -- Text prop_text :: Bool prop_text = $(lift $ Text.pack textdata) == Text.pack textdata prop_lazy_text :: Bool prop_lazy_text = $(lift $ Text.Lazy.pack textdata) == Text.Lazy.pack textdata -------------------------------------------------------------------------------- -- ByteString prop_bytestring :: Bool prop_bytestring = $(lift $ ByteString.pack bytedata) == ByteString.pack bytedata prop_big_bytestring :: Bool prop_big_bytestring = $(lift bigByteString) == bigByteString prop_lazy_bytestring :: Bool prop_lazy_bytestring = $(lift $ ByteString.Lazy.pack bytedata) == ByteString.Lazy.pack bytedata prop_big_lazy_bytestring :: Bool prop_big_lazy_bytestring = $(lift bigLazyByteString) == bigLazyByteString -------------------------------------------------------------------------------- -- Vector prop_boxed_vector :: Bool prop_boxed_vector = $(lift $ Vector.Boxed.fromList bytedata) == Vector.Boxed.fromList bytedata prop_unboxed_vector :: Bool prop_unboxed_vector = $(lift $ Vector.Unboxed.fromList bytedata) == Vector.Unboxed.fromList bytedata prop_primitive_vector :: Bool prop_primitive_vector = $(lift $ Vector.Primitive.fromList bytedata) == Vector.Primitive.fromList bytedata prop_storable_vector :: Bool prop_storable_vector = $(lift $ Vector.Storable.fromList bytedata) == Vector.Storable.fromList bytedata return [] main :: IO () main = do success <- $quickCheckAll unless success exitFailure th-lift-instances-0.1.20/th-lift-instances.cabal0000644000000000000000000000506007346545000017640 0ustar0000000000000000name: th-lift-instances version: 0.1.20 cabal-version: >=1.10 build-type: Simple license: BSD3 license-file: LICENSE 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 the haskell platform do not have Lift instances. This package provides orphan instances for containers, text, bytestring and vector. 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), and package provides instances for TH datatypes. category: Template Haskell author: Benno Fünfstück extra-source-files: .ghci .gitignore .travis.yml README.md source-repository head type: git location: https://github.com/bennofs/th-lift-instances.git library exposed-modules: Instances.TH.Lift build-depends: base >=4.3 && <5, template-haskell >=2.5.0.0, containers, vector >= 0.7, text, transformers, bytestring -- the dependency is added to avoid diamond orphans problem. -- Without a dependency there could be a plan with th-lift-0.7.x and -- th-lift-instances, which both define instances for same data types. build-depends: th-lift >= 0.8 default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall -fwarn-tabs if impl(ghc >= 8.0) other-extensions: TemplateHaskellQuotes else other-extensions: TemplateHaskell test-suite tests type: exitcode-stdio-1.0 main-is: Main.hs build-depends: base <5, template-haskell, containers, vector >= 0.4, text, bytestring, th-lift-instances, QuickCheck >=2.6 if !impl(ghc >= 7.10) build-depends: nats >= 1.1.2 && < 1.2 if !impl(ghc >= 8.0) build-depends: -- todo: we need to bump lower bound when new semigroups is released -- with NonEmpty instance semigroups >= 0.18.5 && < 0.19 default-language: Haskell2010 other-extensions: TemplateHaskell hs-source-dirs: tests other-modules: Data