th-orphans 0.13.8 → 0.13.9
raw patch · 4 files changed
+121/−157 lines, 4 filesdep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: template-haskell
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- src/Language/Haskell/TH/Instances.hs +13/−153
- src/Language/Haskell/TH/Instances/Internal.hs +99/−0
- th-orphans.cabal +5/−4
CHANGELOG.md view
@@ -1,3 +1,7 @@+### 0.13.9 [2019.09.28]+* Implement `qReifyType` (introduced in `template-haskell-2.16.0.0`) for the+ `Quasi` instances defined in `th-orphans`.+ ### 0.13.8 [2019.09.04] * Backport the `Bounded` instance for `Extension` (from `Language.Haskell.TH.LanguageExtensions`), which was introduced in
src/Language/Haskell/TH/Instances.hs view
@@ -58,6 +58,7 @@ module Language.Haskell.TH.Instances () where import Language.Haskell.TH+import Language.Haskell.TH.Instances.Internal import Language.Haskell.TH.Lift (deriveLiftMany) import Language.Haskell.TH.ReifyMany import Language.Haskell.TH.Syntax@@ -67,7 +68,6 @@ import Control.Monad.RWS (RWST(RWST), runRWST) import Control.Monad.State (StateT(StateT), runStateT) import Control.Monad.Writer (WriterT(WriterT), runWriterT)-import qualified Control.Monad.Trans as MTL (lift) import Instances.TH.Lift () #if !(MIN_VERSION_template_haskell(2,8,0))@@ -395,161 +395,21 @@ deriving instance Bounded Extension #endif -instance Quasi m => Quasi (ReaderT r m) where- qNewName = MTL.lift . qNewName- qReport a b = MTL.lift $ qReport a b- qRecover m1 m2 = ReaderT $ \ r -> runReaderT m1 r `qRecover` runReaderT m2 r- qReify = MTL.lift . qReify- qLocation = MTL.lift qLocation- qRunIO = MTL.lift . qRunIO-#if MIN_VERSION_template_haskell(2,7,0)- qReifyInstances a b = MTL.lift $ qReifyInstances a b- qLookupName a b = MTL.lift $ qLookupName a b- qAddDependentFile = MTL.lift . qAddDependentFile-# if MIN_VERSION_template_haskell(2,9,0)- qReifyRoles = MTL.lift . qReifyRoles- qReifyAnnotations = MTL.lift . qReifyAnnotations- qReifyModule = MTL.lift . qReifyModule- qAddTopDecls = MTL.lift . qAddTopDecls- qAddModFinalizer = MTL.lift . qAddModFinalizer- qGetQ = MTL.lift qGetQ- qPutQ = MTL.lift . qPutQ-# endif-# if MIN_VERSION_template_haskell(2,11,0)- qReifyFixity = MTL.lift . qReifyFixity- qReifyConStrictness = MTL.lift . qReifyConStrictness- qIsExtEnabled = MTL.lift . qIsExtEnabled- qExtsEnabled = MTL.lift qExtsEnabled-# endif-#elif MIN_VERSION_template_haskell(2,5,0)- qClassInstances a b = MTL.lift $ qClassInstances a b-#endif-#if MIN_VERSION_template_haskell(2,14,0)- qAddForeignFilePath a b = MTL.lift $ qAddForeignFilePath a b- qAddTempFile = MTL.lift . qAddTempFile-#elif MIN_VERSION_template_haskell(2,12,0)- qAddForeignFile a b = MTL.lift $ qAddForeignFile a b-#endif-#if MIN_VERSION_template_haskell(2,13,0)- qAddCorePlugin = MTL.lift . qAddCorePlugin-#endif+$(deriveQuasiTrans+ [t| forall r m. Quasi m => Proxy2 (ReaderT r m) |]+ [e| \m1 m2 -> ReaderT $ \ r -> runReaderT m1 r `qRecover` runReaderT m2 r |]) -instance (Quasi m, Monoid w) => Quasi (WriterT w m) where- qNewName = MTL.lift . qNewName- qReport a b = MTL.lift $ qReport a b- qRecover m1 m2 = WriterT $ runWriterT m1 `qRecover` runWriterT m2- qReify = MTL.lift . qReify- qLocation = MTL.lift qLocation- qRunIO = MTL.lift . qRunIO-#if MIN_VERSION_template_haskell(2,7,0)- qReifyInstances a b = MTL.lift $ qReifyInstances a b- qLookupName a b = MTL.lift $ qLookupName a b- qAddDependentFile = MTL.lift . qAddDependentFile-# if MIN_VERSION_template_haskell(2,9,0)- qReifyRoles = MTL.lift . qReifyRoles- qReifyAnnotations = MTL.lift . qReifyAnnotations- qReifyModule = MTL.lift . qReifyModule- qAddTopDecls = MTL.lift . qAddTopDecls- qAddModFinalizer = MTL.lift . qAddModFinalizer- qGetQ = MTL.lift qGetQ- qPutQ = MTL.lift . qPutQ-# endif-# if MIN_VERSION_template_haskell(2,11,0)- qReifyFixity = MTL.lift . qReifyFixity- qReifyConStrictness = MTL.lift . qReifyConStrictness- qIsExtEnabled = MTL.lift . qIsExtEnabled- qExtsEnabled = MTL.lift qExtsEnabled-# endif-#elif MIN_VERSION_template_haskell(2,5,0)- qClassInstances a b = MTL.lift $ qClassInstances a b-#endif-#if MIN_VERSION_template_haskell(2,14,0)- qAddForeignFilePath a b = MTL.lift $ qAddForeignFilePath a b- qAddTempFile = MTL.lift . qAddTempFile-#elif MIN_VERSION_template_haskell(2,12,0)- qAddForeignFile a b = MTL.lift $ qAddForeignFile a b-#endif-#if MIN_VERSION_template_haskell(2,13,0)- qAddCorePlugin = MTL.lift . qAddCorePlugin-#endif+$(deriveQuasiTrans+ [t| forall w m. (Quasi m, Monoid w) => Proxy2 (WriterT w m) |]+ [e| \m1 m2 -> WriterT $ runWriterT m1 `qRecover` runWriterT m2 |]) -instance Quasi m => Quasi (StateT s m) where- qNewName = MTL.lift . qNewName- qReport a b = MTL.lift $ qReport a b- qRecover m1 m2 = StateT $ \ s -> runStateT m1 s `qRecover` runStateT m2 s- qReify = MTL.lift . qReify- qLocation = MTL.lift qLocation- qRunIO = MTL.lift . qRunIO-#if MIN_VERSION_template_haskell(2,7,0)- qReifyInstances a b = MTL.lift $ qReifyInstances a b- qLookupName a b = MTL.lift $ qLookupName a b- qAddDependentFile = MTL.lift . qAddDependentFile-# if MIN_VERSION_template_haskell(2,9,0)- qReifyRoles = MTL.lift . qReifyRoles- qReifyAnnotations = MTL.lift . qReifyAnnotations- qReifyModule = MTL.lift . qReifyModule- qAddTopDecls = MTL.lift . qAddTopDecls- qAddModFinalizer = MTL.lift . qAddModFinalizer- qGetQ = MTL.lift qGetQ- qPutQ = MTL.lift . qPutQ-# endif-# if MIN_VERSION_template_haskell(2,11,0)- qReifyFixity = MTL.lift . qReifyFixity- qReifyConStrictness = MTL.lift . qReifyConStrictness- qIsExtEnabled = MTL.lift . qIsExtEnabled- qExtsEnabled = MTL.lift qExtsEnabled-# endif-#elif MIN_VERSION_template_haskell(2,5,0)- qClassInstances a b = MTL.lift $ qClassInstances a b-#endif-#if MIN_VERSION_template_haskell(2,14,0)- qAddForeignFilePath a b = MTL.lift $ qAddForeignFilePath a b- qAddTempFile = MTL.lift . qAddTempFile-#elif MIN_VERSION_template_haskell(2,12,0)- qAddForeignFile a b = MTL.lift $ qAddForeignFile a b-#endif-#if MIN_VERSION_template_haskell(2,13,0)- qAddCorePlugin = MTL.lift . qAddCorePlugin-#endif+$(deriveQuasiTrans+ [t| forall s m. Quasi m => Proxy2 (StateT s m) |]+ [e| \m1 m2 -> StateT $ \ s -> runStateT m1 s `qRecover` runStateT m2 s |]) -instance (Quasi m, Monoid w) => Quasi (RWST r w s m) where- qNewName = MTL.lift . qNewName- qReport a b = MTL.lift $ qReport a b- qRecover m1 m2 = RWST $ \ r s -> runRWST m1 r s `qRecover` runRWST m2 r s- qReify = MTL.lift . qReify- qLocation = MTL.lift qLocation- qRunIO = MTL.lift . qRunIO-#if MIN_VERSION_template_haskell(2,7,0)- qReifyInstances a b = MTL.lift $ qReifyInstances a b- qLookupName a b = MTL.lift $ qLookupName a b- qAddDependentFile = MTL.lift . qAddDependentFile-# if MIN_VERSION_template_haskell(2,9,0)- qReifyRoles = MTL.lift . qReifyRoles- qReifyAnnotations = MTL.lift . qReifyAnnotations- qReifyModule = MTL.lift . qReifyModule- qAddTopDecls = MTL.lift . qAddTopDecls- qAddModFinalizer = MTL.lift . qAddModFinalizer- qGetQ = MTL.lift qGetQ- qPutQ = MTL.lift . qPutQ-# endif-# if MIN_VERSION_template_haskell(2,11,0)- qReifyFixity = MTL.lift . qReifyFixity- qReifyConStrictness = MTL.lift . qReifyConStrictness- qIsExtEnabled = MTL.lift . qIsExtEnabled- qExtsEnabled = MTL.lift qExtsEnabled-# endif-#elif MIN_VERSION_template_haskell(2,5,0)- qClassInstances a b = MTL.lift $ qClassInstances a b-#endif-#if MIN_VERSION_template_haskell(2,14,0)- qAddForeignFilePath a b = MTL.lift $ qAddForeignFilePath a b- qAddTempFile = MTL.lift . qAddTempFile-#elif MIN_VERSION_template_haskell(2,12,0)- qAddForeignFile a b = MTL.lift $ qAddForeignFile a b-#endif-#if MIN_VERSION_template_haskell(2,13,0)- qAddCorePlugin = MTL.lift . qAddCorePlugin-#endif+$(deriveQuasiTrans+ [t| forall r w s m. (Quasi m, Monoid w) => Proxy2 (RWST r w s m) |]+ [e| \m1 m2 -> RWST $ \ r s -> runRWST m1 r s `qRecover` runRWST m2 r s |]) #if MIN_VERSION_base(4,7,0) && defined(LANGUAGE_DeriveDataTypeable) && __GLASGOW_HASKELL__ < 710 deriving instance Typeable Lift
+ src/Language/Haskell/TH/Instances/Internal.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Defines a utility function for deriving 'Quasi' instances for monad+-- transformer data types.+module Language.Haskell.TH.Instances.Internal+ ( deriveQuasiTrans+ , Proxy2+ ) where++import qualified Control.Monad.Trans as MTL (lift)+import Language.Haskell.TH.Lib+import Language.Haskell.TH.Ppr (pprint)+import Language.Haskell.TH.Syntax++deriveQuasiTrans ::+ Q Type -- ^ The instance head. For example, this might be of the form:+ --+ -- > [t| forall r m. Quasi m => Proxy2 (ReaderT r m) |]+ --+ -- Why use 'Proxy2' instead of 'Quasi'? Sadly, GHC 7.0/7.2 will+ -- not accept it if you use the latter due to old TH bugs, so we+ -- use 'Proxy2' as an ugly workaround.+ -> Q Exp -- ^ The implementation of 'qRecover'+ -> Q [Dec] -- ^ The 'Quasi' instance declaration+deriveQuasiTrans qInstHead qRecoverExpr = do+ instHead <- qInstHead+ let (instCxt, mangledInstTy) = decomposeType instHead+ qInstCxt = return instCxt+ qInstTy = case mangledInstTy of+ ConT proxy2 `AppT` instTy+ | proxy2 == ''Proxy2+ -> conT ''Quasi `appT` return instTy+ _ -> fail $ "Unexpected type " ++ pprint mangledInstTy+ instDec <- instanceD qInstCxt qInstTy qInstMethDecs+ return [instDec]+ where+ decomposeType :: Type -> (Cxt, Type)+ decomposeType (ForallT _tvbs ctxt ty) = (ctxt, ty)+ decomposeType ty = ([], ty)++ qInstMethDecs :: [Q Dec]+ qInstMethDecs =+ let instMeths :: [(Name, Q Exp)]+ instMeths =+ [ -- qRecover is different for each instance+ ('qRecover, qRecoverExpr)++ -- The remaining methods are straightforward+ , ('qNewName, [| MTL.lift . qNewName |])+ , ('qReport, [| \a b -> MTL.lift $ qReport a b |])+ , ('qReify, [| MTL.lift . qReify |])+ , ('qLocation, [| MTL.lift qLocation |])+ , ('qRunIO, [| MTL.lift . qRunIO |])+#if MIN_VERSION_template_haskell(2,7,0)+ , ('qReifyInstances, [| \a b -> MTL.lift $ qReifyInstances a b |])+ , ('qLookupName, [| \a b -> MTL.lift $ qLookupName a b |])+ , ('qAddDependentFile, [| MTL.lift . qAddDependentFile |])+# if MIN_VERSION_template_haskell(2,9,0)+ , ('qReifyRoles, [| MTL.lift . qReifyRoles |])+ , ('qReifyAnnotations, [| MTL.lift . qReifyAnnotations |])+ , ('qReifyModule, [| MTL.lift . qReifyModule |])+ , ('qAddTopDecls, [| MTL.lift . qAddTopDecls |])+ , ('qAddModFinalizer, [| MTL.lift . qAddModFinalizer |])+ , ('qGetQ, [| MTL.lift qGetQ |])+ , ('qPutQ, [| MTL.lift . qPutQ |])+# endif+# if MIN_VERSION_template_haskell(2,11,0)+ , ('qReifyFixity, [| MTL.lift . qReifyFixity |])+ , ('qReifyConStrictness, [| MTL.lift . qReifyConStrictness |])+ , ('qIsExtEnabled, [| MTL.lift . qIsExtEnabled |])+ , ('qExtsEnabled, [| MTL.lift qExtsEnabled |])+# endif+#elif MIN_VERSION_template_haskell(2,5,0)+ , ('qClassInstances, [| \a b -> MTL.lift $ qClassInstances a b |])+#endif+#if MIN_VERSION_template_haskell(2,14,0)+ , ('qAddForeignFilePath, [| \a b -> MTL.lift $ qAddForeignFilePath a b |])+ , ('qAddTempFile, [| MTL.lift . qAddTempFile |])+#elif MIN_VERSION_template_haskell(2,12,0)+ , ('qAddForeignFile, [| \a b -> MTL.lift $ qAddForeignFile a b |])+#endif+#if MIN_VERSION_template_haskell(2,13,0)+ , ('qAddCorePlugin, [| MTL.lift . qAddCorePlugin |])+#endif+#if MIN_VERSION_template_haskell(2,16,0)+ , ('qReifyType, [| MTL.lift . qReifyType |])+#endif+ ]++ mkDec :: Name -> Q Exp -> Q Dec+ mkDec methName methRhs = valD (varP methName) (normalB methRhs) []++ in map (uncurry mkDec) instMeths++-- | See the Haddocks for 'deriveQuasiTrans' for an explanation of why this+-- type needs to exist.+data Proxy2 (m :: * -> *)
th-orphans.cabal view
@@ -1,13 +1,13 @@ name: th-orphans-version: 0.13.8+version: 0.13.9 cabal-version: >= 1.10 build-type: Simple license: BSD3 license-file: LICENSE category: Template Haskell-author: Matt Morrow-copyright: (c) Matt Morrow-maintainer: Michael Sloan <mgsloan at gmail>+author: Matt Morrow, Michael Sloan, Ryan Scott+copyright: (c) Matt Morrow, Michael Sloan, Ryan Scott+maintainer: Ryan Scott <ryan.gl.scott@gmail.com> bug-reports: https://github.com/mgsloan/th-orphans/issues stability: experimental tested-with: GHC == 7.0.4@@ -51,6 +51,7 @@ hs-source-dirs: src ghc-options: -Wall exposed-modules: Language.Haskell.TH.Instances+ other-modules: Language.Haskell.TH.Instances.Internal default-language: Haskell2010 test-suite test