th-orphans 0.13.6 → 0.13.7
raw patch · 5 files changed
+122/−6 lines, 5 filesdep +bytestringdep +faildep ~template-haskelldep ~th-lift
Dependencies added: bytestring, fail
Dependency ranges changed: template-haskell, th-lift
Files
- CHANGELOG.md +7/−0
- src/Language/Haskell/TH/Instances.hs +45/−0
- test/Spec.hs +20/−1
- test/TestUtil.hs +38/−0
- th-orphans.cabal +12/−5
CHANGELOG.md view
@@ -1,3 +1,10 @@+### 0.13.7 [2019.03.24]+* Backport the `MonadFail Q` instance.+* Allow building with `template-haskell-2.16` by manually implementing+ `Lift` for `Bytes`. See [#27]++[#27]: https://github.com/mgsloan/th-orphans/issues/27+ ### 0.13.6 [2018.07.01] * Allow building with `template-haskell-2.14`. * Implement `qAddForeignFilePath` and `qAddTempFile` for `Quasi` instances
src/Language/Haskell/TH/Instances.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TemplateHaskell #-}@@ -69,6 +70,10 @@ import qualified Control.Monad.Trans as MTL (lift) import Instances.TH.Lift () +#if !(MIN_VERSION_template_haskell(2,8,0))+import Unsafe.Coerce (unsafeCoerce)+#endif+ -- Thanks to Richard Eisenberg, GHC 7.10 adds many of the instances -- from this module. #if !MIN_VERSION_template_haskell(2,10,0)@@ -108,9 +113,36 @@ # endif #endif +#if !(MIN_VERSION_template_haskell(2,11,0))+import qualified Control.Monad.Fail as Fail+#endif++-- TODO: Once GHC 8.10 is released, this should be updated to use the+-- proper template haskell version. Other related usages of this #if+-- should be replaced as well (and do not have a TODO like this).+--+-- #if MIN_VERSION_template_haskell(2,16,0)+#if __GLASGOW_HASKELL__ >= 809+import GHC.Ptr (Ptr(Ptr))+import GHC.ForeignPtr (newForeignPtr_)+import System.IO.Unsafe (unsafePerformIO)+#endif+ #if !MIN_VERSION_template_haskell(2,11,0) deriving instance Show NameFlavour deriving instance Show NameSpace++instance Fail.MonadFail Q where+ fail s = report True s >> q (fail "Q monad failure")+ where+ q :: (forall m. Quasi m => m a) -> Q a+# if MIN_VERSION_template_haskell(2,8,0)+ q = Q+# else+ -- Early versions of template-haskell did not expose Q's newtype+ -- constructor. Desperate times call for desperate measures.+ q = unsafeCoerce+# endif #endif -- Ideally, it'd be possible to use reifyManyWithoutInstances for@@ -515,6 +547,19 @@ deriving instance Typeable Lift deriving instance Typeable Ppr deriving instance Typeable Quasi+#endif++#if __GLASGOW_HASKELL__ >= 809+instance Lift Bytes where+ lift bytes =+ [| Bytes+ { bytesPtr = unsafePerformIO $ newForeignPtr_ (Ptr $(litE (BytesPrimL bytes)))+ , bytesOffset = 0+ , bytesSize = size+ }+ |]+ where+ size = bytesSize bytes #endif $(reifyManyWithoutInstances ''Lift [''Info, ''Loc] (const True) >>=
test/Spec.hs view
@@ -1,9 +1,15 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} +import Control.Exception (evaluate) import Language.Haskell.TH import Language.Haskell.TH.Instances+import Language.Haskell.TH.Lift import System.Timeout-import Test.Hspec+import System.Mem+import Test.Hspec hiding (runIO)+import TestUtil+import qualified Data.ByteString as BS main :: IO () main = hspec $ do@@ -19,3 +25,16 @@ it "Compares types correctly" $ compare (AppT (ConT ''Maybe) (ConT ''Int)) (AppT (ConT ''Maybe) (ConT ''Char)) `shouldBe` GT+#if __GLASGOW_HASKELL__ >= 809+ it "Lifts bytes" $ do+ let addr = $(do+ let result = $(do+ ast <- lift (LitE (BytesPrimL (bsToBytes testBytes)))+ runIO performMajorGC+ return ast)+ runIO $ evaluate result+ runIO performMajorGC+ return result)+ bs <- addrToBs addr (BS.length testBytes)+ bs `shouldBe` testBytes+#endif
+ test/TestUtil.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}++module TestUtil where++#if __GLASGOW_HASKELL__ >= 809++import Language.Haskell.TH.Syntax+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import GHC.Prim (Addr#)+import GHC.ForeignPtr (newForeignPtr_)+import GHC.Ptr (Ptr(Ptr))++testBytes :: BS.ByteString+testBytes =+ "test bytes " <>+ (BS.take (len - 2) $ BS.drop 1 $ BS.replicate len 42)+ where+ len = 20 * 1024 * 1024++bsToBytes :: BS.ByteString -> Bytes+bsToBytes bs =+ Bytes+ { bytesPtr = fp+ , bytesOffset = fromIntegral offset+ , bytesSize = fromIntegral size+ }+ where+ (fp, offset, size) = BS.toForeignPtr bs++addrToBs :: Addr# -> Int -> IO BS.ByteString+addrToBs addr len = do+ fp <- newForeignPtr_ (Ptr addr)+ return $ BS.fromForeignPtr fp 0 len++#endif
th-orphans.cabal view
@@ -1,5 +1,5 @@ name: th-orphans-version: 0.13.6+version: 0.13.7 cabal-version: >= 1.10 build-type: Simple license: BSD3@@ -18,8 +18,8 @@ , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2- , GHC == 8.4.3- , GHC == 8.6.1+ , GHC == 8.4.4+ , GHC == 8.6.4 synopsis: Orphan instances for TH datatypes description: Orphan instances for TH datatypes. In particular, instances for Ord and Lift, as well as a few missing Show / Eq. These@@ -36,6 +36,9 @@ th-lift-instances, mtl + if !impl(ghc >= 8.0)+ build-depends: fail == 4.9.*+ -- Use TH to derive Generics instances instead of DeriveGeneric, for < 7.10 if impl(ghc < 7.10) build-depends: generic-deriving >= 1.9@@ -53,10 +56,14 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs+ other-modules: TestUtil build-depends: base,- th-orphans,+ bytestring,+ ghc-prim, hspec,- template-haskell+ template-haskell,+ th-lift,+ th-orphans build-tool-depends: hspec-discover:hspec-discover default-language: Haskell2010