th-compat-0.1.4/0000755000000000000000000000000007346545000011601 5ustar0000000000000000th-compat-0.1.4/CHANGELOG.md0000644000000000000000000000132107346545000013407 0ustar0000000000000000### 0.1.4 [2022.07.23] * Backport the `getPackageRoot` and `makeRelativeToProject` functions introduced in `template-haskell-2.19.0.0` (GHC 9.4). * Implement `qGetPackageRoot` in the `Quasi` instance for `QuoteToQuasi` when building with `template-haskell-2.19.0.0` (GHC 9.4) or later. ### 0.1.3 [2021.08.29] * Implement `qGetDoc` and `qPutDoc` in the `Quasi` instance for `QuoteToQuasi`. * Add `expToSplice`. ### 0.1.2 [2021.03.12] * Add `bindSplice`, `bindSplice_`, `examineSplice`, `joinSplice`, `hoistSplice`, `liftSplice`, and `unTypeSplice` to `Language.Haskell.TH.Syntax.Compat`. ### 0.1.1 [2021.02.07] * Mark `Language.Haskell.TH.Syntax.Compat` as `Trustworthy`. ## 0.1 [2020.09.29] * Initial release th-compat-0.1.4/LICENSE0000644000000000000000000000275607346545000012620 0ustar0000000000000000Copyright (c) 2020, Ryan Scott All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of Ryan Scott nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER 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-compat-0.1.4/README.md0000644000000000000000000000663307346545000013070 0ustar0000000000000000# `th-compat` [![Hackage](https://img.shields.io/hackage/v/th-compat.svg)][Hackage: th-compat] [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/th-compat.svg)](http://packdeps.haskellers.com/reverse/th-compat) [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] [![Build Status](https://github.com/haskell-compat/th-compat/workflows/Haskell-CI/badge.svg)](https://github.com/haskell-compat/th-compat/actions?query=workflow%3AHaskell-CI) [Hackage: th-compat]: http://hackage.haskell.org/package/th-compat "th-compat package on Hackage" [Haskell.org]: http://www.haskell.org "The Haskell Programming Language" [tl;dr Legal: BSD3]: https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 "BSD 3-Clause License (Revised)" This package defines a `Language.Haskell.TH.Syntax.Compat` module, which backports the `Quote` and `Code` types to work across a wide range of `template-haskell` versions. On recent versions of `template-haskell` (2.17.0.0 or later), this module simply reexports `Quote` and `Code` from `Language.Haskell.TH.Syntax`. Refer to the Haddocks for `Language.Haskell.TH.Syntax.Compat` for examples of how to use this module. ## Quick Start Guide Let's say you have a library that offers a `foo :: Q (TExp a)`, you want to make it compatible with the new `Code` type, and you intend that `foo` is spliced directly in to user code. Use `SpliceQ` as a type alias for the return of your function. This is `Q (TExp a)` prior to GHC 9, and `Code Q a` after. This allows your code to be spliced in regardless of GHC version. Use `liftSplice` to convert a `m (TExp a)` into a `Splice m a`. Use `examineSplice` before typed quoters. This will allow a typed quasiquotation to work regardless of GHC version. When splicing in a `TExp a` value into a typed quoter, use `expToSplice`. For a real life example, consider [this conversion, from this PR](https://github.com/parsonsmatt/discover-instances/pull/2): ```haskell discoverInstances :: forall c. (Typeable c) => Q (TExp [SomeDict c]) discoverInstances = do let className = show (typeRep (Proxy @c)) instanceDecs <- reifyInstances (mkName className) [VarT (mkName "a")] dicts <- fmap listTE $ traverse decToDict instanceDecs [|| concat $$(pure dicts) ||] listTE :: [TExp a] -> TExp [a] listTE = TExp . ListE . map unType decToDict :: InstanceDec -> Q (TExp [SomeDict c]) ``` With GHC 9, this will have the following problems: 1. `reifyInstances` operates in `Q`, not `Code`, so it will not type check with the `[|| concat $$(pure dicts) ||]` line. 2. We cannot call `pure` in `Code`, since `Code` is not an applicative. 3. Typed quasiquotes return a `Quote m => Code m a`, not `Q (TExp a)`. To fix these problems, we make the following diff: ```diff discoverInstances :: forall c. (Typeable c) - => Q (TExp [SomeDict c]) + => SpliceQ [SomeDict c] - discoverInstances = do + discoverInstances = liftSplice $ do let className = show (typeRep (Proxy @c)) instanceDecs <- reifyInstances (mkName className) [VarT (mkName "a")] dicts <- fmap listTE $ traverse decToDict instanceDecs - [|| concat $$(pure dicts) ||] + examineSplice [|| concat $$(expToSplice dicts) ||] ``` The above pattern should work to ensure that code is compatible across a wide range of GHC versions. th-compat-0.1.4/Setup.hs0000644000000000000000000000005607346545000013236 0ustar0000000000000000import Distribution.Simple main = defaultMain th-compat-0.1.4/src/Language/Haskell/TH/Syntax/0000755000000000000000000000000007346545000017277 5ustar0000000000000000th-compat-0.1.4/src/Language/Haskell/TH/Syntax/Compat.hs0000644000000000000000000011614207346545000021063 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE RoleAnnotations #-} #endif -- | This module exists to make it possible to define code that works across -- a wide range of @template-haskell@ versions with as little CPP as possible. -- To that end, this module currently backports the following -- @template-haskell@ constructs: -- -- * The 'Quote' class -- -- * The 'Code' type -- -- * The 'getPackageRoot' and 'makeRelativeToProject' utility functions -- -- Refer to the Haddocks below for examples of how to use each of these in a -- backwards-compatible way. module Language.Haskell.TH.Syntax.Compat ( -- * The @Quote@ class -- $quote Quote(..) -- * @Quote@ functionality -- ** The @unsafeQToQuote@ function , unsafeQToQuote -- ** Functions from @Language.Haskell.TH.Syntax@ #if MIN_VERSION_template_haskell(2,9,0) , unTypeQQuote , unsafeTExpCoerceQuote #endif , liftQuote #if MIN_VERSION_template_haskell(2,9,0) , liftTypedQuote #endif , liftStringQuote #if MIN_VERSION_template_haskell(2,9,0) -- * The @Code@ and @CodeQ@ types -- $code , Code(..), CodeQ -- * @Code@ functionality -- ** The @IsCode@ class , IsCode(..) -- ** Limitations of @IsCode@ -- $isCodeLimitations -- ** Functions from @Language.Haskell.TH.Syntax@ , unsafeCodeCoerce , liftCode , unTypeCode , hoistCode , bindCode , bindCode_ , joinCode -- * Compatibility with @Splice@s -- $splice , Splice , SpliceQ , bindSplice , bindSplice_ , examineSplice , hoistSplice , joinSplice , liftSplice , liftTypedFromUntypedSplice , unsafeSpliceCoerce , unTypeSplice , expToSplice #endif -- * Package root functions , getPackageRoot , makeRelativeToProject ) where import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO(..)) import Language.Haskell.TH (Exp) import qualified Language.Haskell.TH.Lib as Lib () import Language.Haskell.TH.Syntax (Q, runQ, Quasi(..)) import qualified Language.Haskell.TH.Syntax as Syntax #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative #endif #if MIN_VERSION_template_haskell(2,16,0) import GHC.Exts (RuntimeRep, TYPE) #endif #if MIN_VERSION_template_haskell(2,17,0) import Language.Haskell.TH.Lib (CodeQ) import Language.Haskell.TH.Syntax ( Code(..), Quote(..) , bindCode, bindCode_, hoistCode, joinCode, liftCode, unsafeCodeCoerce, unTypeCode , unsafeTExpCoerce, unTypeQ ) #else import Language.Haskell.TH (Name) #endif #if MIN_VERSION_template_haskell(2,19,0) import Language.Haskell.TH.Syntax (getPackageRoot, makeRelativeToProject) #else import System.FilePath (isRelative, takeExtension, takeDirectory, ()) import System.Directory (getDirectoryContents, canonicalizePath) #endif ------------------------------------------------------------------------------- -- Quote ------------------------------------------------------------------------------- -- $quote -- The 'Quote' class (first proposed in -- ) -- was introduced in @template-haskell-2.17.0.0@. This module defines a version -- of 'Quote' that is backward-compatible with older @template-haskell@ -- releases and is forward-compatible with the existing 'Quote' class. -- -- In addition to 'Quote', this module also backports versions of functions in -- "Language.Haskell.TH.Syntax" that work over any 'Quote' instance instead of -- just 'Q'. Since this module is designed to coexist with the existing -- definitions in @template-haskell@ as much as possible, the backported -- functions are suffixed with @-Quote@ to avoid name clashes. For instance, -- the backported version of 'lift' is named 'liftQuote'. -- -- The one exception to the no-name-clashes policy is the backported 'newName' -- method of 'Quote'. We could have conceivably named it 'newNameQuote', but -- then it would not have been possible to define backwards-compatible 'Quote' -- instances without the use of CPP. As a result, some care must be exercised -- when combining this module with "Language.Haskell.TH" or -- "Language.Haskell.TH.Syntax" on older versions of @template-haskell@, as -- they both export a version of 'newName' with a different type. Here is an -- example of how to safely combine these modules: -- -- @ -- {-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell #-} -- -- import Control.Monad.State (MonadState(..), State, evalState) -- import "Language.Haskell.TH" hiding ('newName') -- import "Language.Haskell.TH.Syntax" hiding ('newName') -- import "Language.Haskell.TH.Syntax.Compat" -- -- newtype PureQ a = MkPureQ (State Uniq a) -- deriving (Functor, Applicative, Monad, MonadState Uniq) -- -- runPureQ :: PureQ a -> a -- runPureQ m = case m of MkPureQ m' -> evalState m' 0 -- -- instance 'Quote' PureQ where -- 'newName' s = state $ \i -> (mkNameU s i, i + 1) -- -- main :: IO () -- main = putStrLn $ runPureQ $ do -- a <- newName "a" -- return $ nameBase a -- @ -- -- We do not make an effort to backport any combinators from the -- "Language.Haskell.TH.Lib" module, as the surface area is simply too large. -- If you wish to generalize code that uses these combinators to work over -- 'Quote' in a backwards-compatible way, use the 'unsafeQToQuote' function. #if !(MIN_VERSION_template_haskell(2,17,0)) -- | The 'Quote' class implements the minimal interface which is necessary for -- desugaring quotations. -- -- * The @Monad m@ superclass is needed to stitch together the different -- AST fragments. -- * 'newName' is used when desugaring binding structures such as lambdas -- to generate fresh names. -- -- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp` -- -- For many years the type of a quotation was fixed to be `Q Exp` but by -- more precisely specifying the minimal interface it enables the `Exp` to -- be extracted purely from the quotation without interacting with `Q`. class ( Monad m # if !(MIN_VERSION_template_haskell(2,7,0)) , Functor m # elif !(MIN_VERSION_template_haskell(2,10,0)) , Applicative m # endif ) => Quote m where {- | Generate a fresh name, which cannot be captured. For example, this: @f = $(do nm1 <- newName \"x\" let nm2 = 'mkName' \"x\" return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1))) )@ will produce the splice >f = \x0 -> \x -> x0 In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@, and is not captured by the binding @VarP nm2@. Although names generated by @newName@ cannot /be captured/, they can /capture/ other names. For example, this: >g = $(do > nm1 <- newName "x" > let nm2 = mkName "x" > return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2))) > ) will produce the splice >g = \x -> \x0 -> x0 since the occurrence @VarE nm2@ is captured by the innermost binding of @x@, namely @VarP nm1@. -} newName :: String -> m Name instance Quote Q where newName = qNewName #endif #if MIN_VERSION_template_haskell(2,9,0) -- | Discard the type annotation and produce a plain Template Haskell -- expression -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. -- -- This is a variant of the 'unTypeQ' function that is always guaranteed to -- use a 'Quote' constraint, even on old versions of @template-haskell@. -- -- As this function interacts with typed Template Haskell, this function is -- only defined on @template-haskell-2.9.0.0@ (GHC 7.8) or later. unTypeQQuote :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif Quote m => m (Syntax.TExp a) -> m Exp # if MIN_VERSION_template_haskell(2,17,0) unTypeQQuote = unTypeQ # else unTypeQQuote m = do { Syntax.TExp e <- m ; return e } # endif -- | Annotate the Template Haskell expression with a type -- -- This is unsafe because GHC cannot check for you that the expression -- really does have the type you claim it has. -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. -- -- This is a variant of the 'unsafeTExpCoerce' function that is always -- guaranteed to use a 'Quote' constraint, even on old versions of -- @template-haskell@. -- -- As this function interacts with typed Template Haskell, this function is -- only defined on @template-haskell-2.9.0.0@ (GHC 7.8) or later. unsafeTExpCoerceQuote :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif Quote m => m Exp -> m (Syntax.TExp a) # if MIN_VERSION_template_haskell(2,17,0) unsafeTExpCoerceQuote = unsafeTExpCoerce # else unsafeTExpCoerceQuote m = do { e <- m ; return (Syntax.TExp e) } # endif #endif -- | Turn a value into a Template Haskell expression, suitable for use in -- a splice. -- -- This is a variant of the 'Syntax.lift' method of 'Syntax.Lift' that is -- always guaranteed to use a 'Quote' constraint, even on old versions of -- @template-haskell@. -- -- Levity-polymorphic since /template-haskell-2.17.0.0/. liftQuote :: #if MIN_VERSION_template_haskell(2,17,0) forall (r :: RuntimeRep) (t :: TYPE r) m . #else forall t m . #endif (Syntax.Lift t, Quote m) => t -> m Exp #if MIN_VERSION_template_haskell(2,17,0) liftQuote = Syntax.lift #else liftQuote = unsafeQToQuote . Syntax.lift #endif #if MIN_VERSION_template_haskell(2,9,0) -- | Turn a value into a Template Haskell typed expression, suitable for use -- in a typed splice. -- -- This is a variant of the 'Syntax.liftTyped' method of 'Syntax.Lift' that is -- always guaranteed to use a 'Quote' constraint and return a 'Code', even on -- old versions of @template-haskell@. -- -- As this function interacts with typed Template Haskell, this function is -- only defined on @template-haskell-2.9.0.0@ (GHC 7.8) or later. While the -- 'Syntax.liftTyped' method of 'Syntax.Lift' was first introduced in -- @template-haskell-2.16.0.0@, we are able to backport it back to -- @template-haskell-2.9.0.0@ by making use of the 'Syntax.lift' method on -- older versions of @template-haskell@. This crucially relies on the -- 'Syntax.Lift' law that @'lift' x ≡ 'unTypeQ' ('liftTyped' x)@ to work, -- so beware if you use 'liftTypedQuote' with an unlawful 'Syntax.Lift' -- instance. -- -- Levity-polymorphic since /template-haskell-2.17.0.0/. liftTypedQuote :: # if MIN_VERSION_template_haskell(2,17,0) forall (r :: RuntimeRep) (t :: TYPE r) m . # else forall t m . # endif (Syntax.Lift t, Quote m) => t -> Code m t # if MIN_VERSION_template_haskell(2,17,0) liftTypedQuote = Syntax.liftTyped # elif MIN_VERSION_template_haskell(2,16,0) liftTypedQuote = liftCode . unsafeQToQuote . Syntax.liftTyped # else liftTypedQuote = unsafeCodeCoerce . liftQuote # endif #endif -- | This is a variant of the 'Syntax.liftString' function that is always -- guaranteed to use a 'Quote' constraint, even on old versions of -- @template-haskell@. liftStringQuote :: Quote m => String -> m Exp #if MIN_VERSION_template_haskell(2,17,0) liftStringQuote = Syntax.liftString #else liftStringQuote = unsafeQToQuote . Syntax.liftString #endif -- | Use a 'Q' computation in a 'Quote' context. This function is only safe -- when the 'Q' computation performs actions from the 'Quote' instance for 'Q' -- or any of `Quote`'s subclasses ('Functor', 'Applicative', and 'Monad'). -- Attempting to perform actions from the 'MonadFail', 'MonadIO', or 'Quasi' -- instances for 'Q' will result in runtime errors. -- -- This is useful when you have some 'Q'-valued functions that only performs -- actions from 'Quote' and wish to generalise it from 'Q' to 'Quote' without -- having to rewrite the internals of the function. This is especially handy -- for code defined in terms of combinators from "Language.Haskell.TH.Lib", -- which were all hard-coded to 'Q' prior to @template-haskell-2.17.0.0@. For -- instance, consider this function: -- -- @ -- apply :: 'Exp' -> 'Exp' -> 'Q' 'Exp' -- apply f x = 'Lib.appE' (return x) (return y) -- @ -- -- There are two ways to generalize this function to use 'Quote' in a -- backwards-compatible way. One way to do so is to rewrite @apply@ to avoid -- the use of 'Lib.appE', like so: -- -- @ -- applyQuote :: 'Quote' m => 'Exp' -> 'Exp' -> m 'Exp' -- applyQuote f x = return ('Syntax.AppE' x y) -- @ -- -- For a small example like @applyQuote@, there isn't much work involved. But -- this can become tiresome for larger examples. In such cases, -- 'unsafeQToQuote' can do the heavy lifting for you. For example, @applyQuote@ -- can also be defined as: -- -- @ -- applyQuote :: 'Quote' m => 'Exp' -> 'Exp' -> m 'Exp' -- applyQuote f x = 'unsafeQToQuote' (apply f x) -- @ unsafeQToQuote :: Quote m => Q a -> m a unsafeQToQuote = unQTQ . runQ -- | An internal definition that powers 'unsafeQToQuote'. Its 'Quasi' instance -- defines 'qNewName' in terms of 'newName' from 'Quote', but defines every -- other method of 'Quasi' to be an error, since they cannot be implemented -- using 'Quote' alone. Similarly, its 'MonadFail' and 'MonadIO' instances -- define 'fail' and 'liftIO', respectively, to be errors. newtype QuoteToQuasi (m :: * -> *) a = QTQ { unQTQ :: m a } deriving (Functor, Applicative, Monad) qtqError :: String -> a qtqError name = error $ "`unsafeQToQuote` does not support code that uses " ++ name instance Monad m => Fail.MonadFail (QuoteToQuasi m) where fail = qtqError "MonadFail.fail" instance Monad m => MonadIO (QuoteToQuasi m) where liftIO = qtqError "liftIO" instance Quote m => Quasi (QuoteToQuasi m) where qNewName s = QTQ (newName s) qRecover = qtqError "qRecover" qReport = qtqError "qReport" qReify = qtqError "qReify" qLocation = qtqError "qLocation" qRunIO = qtqError "qRunIO" #if MIN_VERSION_template_haskell(2,7,0) qReifyInstances = qtqError "qReifyInstances" qLookupName = qtqError "qLookupName" qAddDependentFile = qtqError "qAddDependentFile" # if MIN_VERSION_template_haskell(2,9,0) qReifyRoles = qtqError "qReifyRoles" qReifyAnnotations = qtqError "qReifyAnnotations" qReifyModule = qtqError "qReifyModule" qAddTopDecls = qtqError "qAddTopDecls" qAddModFinalizer = qtqError "qAddModFinalizer" qGetQ = qtqError "qGetQ" qPutQ = qtqError "qPutQ" # endif # if MIN_VERSION_template_haskell(2,11,0) qReifyFixity = qtqError "qReifyFixity" qReifyConStrictness = qtqError "qReifyConStrictness" qIsExtEnabled = qtqError "qIsExtEnabled" qExtsEnabled = qtqError "qExtsEnabled" # endif #elif MIN_VERSION_template_haskell(2,5,0) qClassInstances = qtqError "qClassInstances" #endif #if MIN_VERSION_template_haskell(2,13,0) qAddCorePlugin = qtqError "qAddCorePlugin" #endif #if MIN_VERSION_template_haskell(2,14,0) qAddForeignFilePath = qtqError "qAddForeignFilePath" qAddTempFile = qtqError "qAddTempFile" #elif MIN_VERSION_template_haskell(2,12,0) qAddForeignFile = qtqError "qAddForeignFile" #endif #if MIN_VERSION_template_haskell(2,16,0) qReifyType = qtqError "qReifyType" #endif #if MIN_VERSION_template_haskell(2,18,0) qGetDoc = qtqError "qGetDoc" qPutDoc = qtqError "qPutDoc" #endif #if MIN_VERSION_template_haskell(2,19,0) qGetPackageRoot = qtqError "qGetPackageRoot" #endif ------------------------------------------------------------------------------- -- Code ------------------------------------------------------------------------------- -- $code -- The 'Code' type (first proposed in -- ) -- was introduced in @template-haskell-2.17.0.0@. This module defines a version -- of 'Code' that is backward-compatible with older @template-haskell@ -- releases and is forward-compatible with the existing 'Code' class. -- In addition to 'Code', this module also backports the functions in -- "Language.Haskell.TH.Syntax" that manipulate 'Code' values. -- -- One troublesome aspect of writing backwards-compatible code involving 'Code' -- is that GHC 9.0 changed the types of typed Template Haskell splices. Before, -- they were of type @'Q' ('TExp' a)@, but they are now of type @'Code' 'Q' a@. -- This modules provides two mechanisms for smoothing over the differences -- between these two types: -- -- * The 'IsCode' class can be used to convert 'Code' or 'TExp' values to -- 'Code', and vice versa. -- -- * The 'Splice' type synonym uses CPP so that @'Splice' q a@ is a synonym for -- @'Code' q a@ on GHC 9.0 or later and @q ('TExp' a)@ on older versions of -- GHC. This module also defines versions of 'Code'- and 'TExp'-related -- combinators that work over 'Splice'. -- -- Refer to the Haddocks for 'IsCode' and 'Splice' for more information on each -- approach. Both approaches have pros and cons, and as a result, neither -- approach is a one-size-fits-all solution. -- -- Because 'Code' interacts with typed Template Haskell, the 'Code' type and -- any function that mentions 'Code' in its type are only defined on -- @template-haskell-2.9.0.0@ (GHC 7.8) or later. #if MIN_VERSION_template_haskell(2,9,0) -- | A class that allows one to smooth over the differences between -- @'Code' 'm' a@ (the type of typed Template Haskell quotations on -- @template-haskell-2.17.0.0@ or later) and @'m' ('TExp' a)@ (the type of -- typed Template Haskell quotations on older versions of @template-haskell@). -- Here are two examples that demonstrate how to use each method of 'IsCode': -- -- @ -- {-# LANGUAGE TemplateHaskell #-} -- -- import "Language.Haskell.TH" -- import "Language.Haskell.TH.Syntax.Compat" -- -- -- 'toCode' will ensure that the end result is a 'Code', regardless of -- -- whether the quote itself returns a 'Code' or a 'TExp'. -- myCode :: 'Code' 'Q' Int -- myCode = 'toCode' [|| 42 ||] -- -- -- 'fromCode' will ensure that the input 'Code' is suitable for splicing -- -- (i.e., it will return a 'Code' or a 'TExp' depending on the -- -- @template-haskell@ version in use). -- fortyTwo :: Int -- fortyTwo = $$('fromCode' myCode) -- @ -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. class IsCode q # if MIN_VERSION_template_haskell(2,16,0) (a :: TYPE r) # else a # endif c | c -> a q where -- | Convert something to a 'Code'. toCode :: c -> Code q a -- | Convert to something from a 'Code'. fromCode :: Code q a -> c -- | Levity-polymorphic since /template-haskell-2.16.0.0/. instance Quote q => IsCode q # if MIN_VERSION_template_haskell(2,16,0) (a :: TYPE r) # else a # endif (Code q a) where toCode = id fromCode = id -- | Levity-polymorphic since /template-haskell-2.16.0.0/. instance texp ~ Syntax.TExp a => IsCode Q # if MIN_VERSION_template_haskell(2,16,0) (a :: TYPE r) # else a # endif (Q texp) where toCode = liftCode fromCode = examineCode -- $isCodeLimitations -- 'IsCode' makes it possible to backport code involving typed Template Haskell -- quotations and splices where the types are monomorphized to 'Q'. GHC 9.0 -- and later, however, make it possible to use typed TH quotations and splices -- that are polymorphic over any 'Quote' instance. Unfortunately, the -- @th-compat@ library does not yet have a good story for backporting -- 'Quote'-polymorphic quotations or splices. For example, consider this code: -- -- @ -- instance ('Syntax.Lift' a, 'Quote' q, 'Num' a) => 'Num' ('Code' q a) where -- -- ... -- x + y = [|| $$x + $$y ||] -- -- ... -- @ -- -- How might we backport this code? If we were in a setting where @q@ were -- monomorphized to 'Q', we could simply write this: -- -- @ -- x + y = 'toCode' [|| $$('fromCode' x) + $$('fromCode' y) ||] -- @ -- -- In a 'Quote'-polymorphic setting, however, we run into issues. While this -- will compile on GHC 9.0 or later, it will not compile on earlier GHC -- versions because all typed TH quotations and splices must use 'Q'. At -- present, the @th-compat@ library does not offer any solution to this -- problem. -- | Levity-polymorphic since /template-haskell-2.16.0.0/. # if !(MIN_VERSION_template_haskell(2,17,0)) type role Code representational nominal newtype Code m # if MIN_VERSION_template_haskell(2,16,0) (a :: TYPE (r :: RuntimeRep)) # else a # endif = Code { examineCode :: m (Syntax.TExp a) -- ^ Underlying monadic value } type CodeQ = Code Q # if MIN_VERSION_template_haskell(2,16,0) :: (TYPE r -> *) # endif -- | Unsafely convert an untyped code representation into a typed code -- representation. -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. unsafeCodeCoerce :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif Quote m => m Exp -> Code m a unsafeCodeCoerce m = Code (unsafeTExpCoerceQuote m) -- | Lift a monadic action producing code into the typed 'Code' -- representation -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. liftCode :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif m (Syntax.TExp a) -> Code m a liftCode = Code -- | Extract the untyped representation from the typed representation -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. unTypeCode :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif Quote m => Code m a -> m Exp unTypeCode = unTypeQQuote . examineCode -- | Modify the ambient monad used during code generation. For example, you -- can use `hoistCode` to handle a state effect: -- -- @ -- handleState :: Code (StateT Int Q) a -> Code Q a -- handleState = hoistCode (flip runState 0) -- @ -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. hoistCode :: # if MIN_VERSION_template_haskell(2,16,0) forall m n (r :: RuntimeRep) (a :: TYPE r) . # else forall m n a . # endif Monad m => (forall x . m x -> n x) -> Code m a -> Code n a hoistCode f (Code a) = Code (f a) -- | Variant of (>>=) which allows effectful computations to be injected -- into code generation. -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. bindCode :: # if MIN_VERSION_template_haskell(2,16,0) forall m a (r :: RuntimeRep) (b :: TYPE r) . # else forall m a b . # endif Monad m => m a -> (a -> Code m b) -> Code m b bindCode q k = liftCode (q >>= examineCode . k) -- | Variant of (>>) which allows effectful computations to be injected -- into code generation. -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. bindCode_ :: # if MIN_VERSION_template_haskell(2,16,0) forall m a (r :: RuntimeRep) (b :: TYPE r) . # else forall m a b . # endif Monad m => m a -> Code m b -> Code m b bindCode_ q c = liftCode ( q >> examineCode c) -- | A useful combinator for embedding monadic actions into 'Code' -- @ -- myCode :: ... => Code m a -- myCode = joinCode $ do -- x <- someSideEffect -- return (makeCodeWith x) -- @ -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. joinCode :: # if MIN_VERSION_template_haskell(2,16,0) forall m (r :: RuntimeRep) (a :: TYPE r) . # else forall m a . # endif Monad m => m (Code m a) -> Code m a joinCode = flip bindCode id # endif -- $splice -- -- This section of code is useful for library authors looking to provide -- a typed @TemplateHaskell@ interface that is backwards- and -- forward-compatible. This section may be useful for you if you -- specifically intend for the splice to be done directly. -- -- Prior to GHC 9, you'd offer a value with type @'Q' ('Syntax.TExp' a)@. -- After GHC 9, these values are no longer acceptable in a typed splice: -- typed splices must operate in @Code m a@ instead. -- -- The @'Splice' m a@ type is used to work with both versions - it is a type -- alias, and depending on the version of @template-haskell@ that was -- compiled, it will either be @'Code' m a@ or @m ('Syntax.TExp' a)@. -- -- The function 'liftSplice' can be used to convert a @'Q' ('Syntax.TExp' a)@ -- expression into a @'Code' 'Q' a@ expression in a compatible manner - by -- lifting to 'SpliceQ', you get the right behavior depending on your -- @template-haskell@ version. -- -- The function 'examineSplice' can be used on typed QuasiQuoters, and the -- result will be converted into an appropriate @m ('Syntax.TExp' a)@. This -- allows you to use typed quasiquoters in a @do@ block, much like -- 'examineCode' does with 'Code'. -- -- With 'expToSplice', you can substitute uses of 'pure' when given the -- specific type: -- -- @ -- pureTExp :: 'Syntax.TExp' a -> 'Q' ('Syntax.TExp' a) -- pureTExp = pure -- @ -- -- This allows you to splice @'Syntax.TExp' a@ values directly into a typed -- quasiquoter. -- | @'Splice' m a@ is a type alias for: -- -- * @'Code' m a@, if using @template-haskell-2.17.0.0@ or later, or -- -- * @m ('Syntax.TExp' a)@, if using an older version of @template-haskell@. -- -- This should be used with caution, as its definition differs depending on -- which version of @template-haskell@ you are using. It is mostly useful for -- contexts in which one is writing a definition that is intended to be used -- directly in a typed Template Haskell splice, as the types of TH splices -- differ between @template-haskell@ versions as well. -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. # if MIN_VERSION_template_haskell(2,17,0) type Splice = Code :: (forall r. (* -> *) -> TYPE r -> *) # elif MIN_VERSION_template_haskell(2,16,0) type Splice m (a :: TYPE r) = m (Syntax.TExp a) # else type Splice m a = m (Syntax.TExp a) # endif -- | @'SpliceQ' a@ is a type alias for: -- -- * @'Code' 'Q' a@, if using @template-haskell-2.17.0.0@ or later, or -- -- * @'Q' ('Syntax.TExp' a)@, if using an older version of @template-haskell@. -- -- This should be used with caution, as its definition differs depending on -- which version of @template-haskell@ you are using. It is mostly useful for -- contexts in which one is writing a definition that is intended to be used -- directly in a typed Template Haskell splice, as the types of TH splices -- differ between @template-haskell@ versions as well. -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. # if MIN_VERSION_template_haskell(2,17,0) type SpliceQ = Splice Q :: (TYPE r -> *) # elif MIN_VERSION_template_haskell(2,16,0) type SpliceQ (a :: TYPE r) = Splice Q a # else type SpliceQ a = Splice Q a # endif -- | A variant of 'bindCode' that works over 'Splice's. Because this function -- uses 'Splice', the type of this function will be different depending on -- which version of @template-haskell@ you are using. (See the Haddocks for -- 'Splice' for more information on this point.) -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. bindSplice :: # if MIN_VERSION_template_haskell(2,16,0) forall m a (r :: RuntimeRep) (b :: TYPE r) . # else forall m a b . # endif Monad m => m a -> (a -> Splice m b) -> Splice m b # if MIN_VERSION_template_haskell(2,17,0) bindSplice = bindCode # else bindSplice q k = liftSplice (q >>= examineSplice . k) # endif -- | A variant of 'bindCode_' that works over 'Splice's. Because this function -- uses 'Splice', the type of this function will be different depending on -- which version of @template-haskell@ you are using. (See the Haddocks for -- 'Splice' for more information on this point.) -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. bindSplice_ :: # if MIN_VERSION_template_haskell(2,16,0) forall m a (r :: RuntimeRep) (b :: TYPE r) . # else forall m a b . # endif Monad m => m a -> Splice m b -> Splice m b # if MIN_VERSION_template_haskell(2,17,0) bindSplice_ = bindCode_ # else bindSplice_ q c = liftSplice ( q >> examineSplice c) # endif -- | Lift a @'Syntax.TExp' a@ into a 'Splice'. This is useful when splicing -- in the result of a computation into a typed QuasiQuoter. -- -- One example is 'traverse'ing over a list of elements and returning an -- expression from each element. -- -- @ -- mkInt :: 'String' -> 'Q' ('Syntax.TExp' 'Int') -- mkInt str = [|| length $$str ||] -- -- mkInts :: ['String'] -> 'Q' ['Syntax.TExp' 'Int'] -- mkInts = traverse mkInt -- @ -- -- This gives us a list of 'Syntax.TExp', not a 'Syntax.TExp' of a list. We -- can push the list inside the type with this function: -- -- @ -- listTE :: ['Syntax.TExp' a] -> 'Syntax.TExp' [a] -- listTE = 'Syntax.TExp' . 'Syntax.ListE' . 'map' 'Syntax.unType' -- @ -- -- In a @do@ block using 'liftSplice', we can bind the resulting -- -- @'Syntax.TExp' ['Int']@ out of the expression. -- -- @ -- foo :: 'Q' ('Syntax.TExp' Int) -- foo = do -- ints <- mkInts ["hello", "world", "goodybe", "bob"] -- [|| sum $$(pure (listTE ints)) ||] -- @ -- -- Prior to GHC 9, with the 'Q' type, we can write @'pure' :: 'Syntax.TExp' a -> 'Q' ('Syntax.TExp' a)@, -- which is a valid thing to use in a typed quasiquoter. -- However, after GHC 9, this code will fail to type check. There is no -- 'Applicative' instance for @'Code' m a@, so we need another way to -- splice it in. -- -- A GHC 9 only solution can use @'Code' :: m ('Syntax.TExp' a) -> Code -- m a@ and 'pure' together, like: @'Code' . 'pure'@. -- -- With 'expToSplice', we can splice it in a backwards compatible way. -- A fully backwards- and forwards-compatible example looks like this: -- -- @ -- mkInt :: 'String' -> 'Q' 'Int' -- mkInt str = 'examineSplice' [|| length $$str ||] -- -- mkInts :: ['String'] -> 'Q' ['Syntax.TExp' 'Int'] -- mkInts = traverse mkInt -- -- foo :: 'SpliceQ' 'Int' -- foo = 'liftSplice' $ do -- ints <- mkInts ["hello", "world", "goodybe", "bob"] -- 'examineSplice' [|| sum $$(expToSplice (listTE ints)) ||] -- @ -- -- @since 0.1.3 expToSplice :: Applicative m => Syntax.TExp a -> Splice m a expToSplice a = liftSplice $ pure a -- | A variant of 'examineCode' that takes a 'Splice' as an argument. Because -- this function takes a 'Splice' as an argyment, the type of this function -- will be different depending on which version of @template-haskell@ you are -- using. (See the Haddocks for 'Splice' for more information on this point.) -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. examineSplice :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) m (a :: TYPE r) . # else forall m a . # endif Splice m a -> m (Syntax.TExp a) # if MIN_VERSION_template_haskell(2,17,0) examineSplice = examineCode # else examineSplice = id # endif -- | A variant of 'hoistCode' that works over 'Splice's. Because this function -- uses 'Splice', the type of this function will be different depending on -- which version of @template-haskell@ you are using. (See the Haddocks for -- 'Splice' for more information on this point.) -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. hoistSplice :: # if MIN_VERSION_template_haskell(2,16,0) forall m n (r :: RuntimeRep) (a :: TYPE r) . # else forall m n a . # endif Monad m => (forall x . m x -> n x) -> Splice m a -> Splice n a # if MIN_VERSION_template_haskell(2,17,0) hoistSplice = hoistCode # else hoistSplice f a = f a # endif -- | A variant of 'joinCode' that works over 'Splice's. Because this function -- uses 'Splice', the type of this function will be different depending on -- which version of @template-haskell@ you are using. (See the Haddocks for -- 'Splice' for more information on this point.) -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. joinSplice :: # if MIN_VERSION_template_haskell(2,16,0) forall m (r :: RuntimeRep) (a :: TYPE r) . # else forall m a . # endif Monad m => m (Splice m a) -> Splice m a # if MIN_VERSION_template_haskell(2,17,0) joinSplice = joinCode # else joinSplice = flip bindSplice id # endif -- | A variant of 'liftCode' that returns a 'Splice'. Because this function -- returns a 'Splice', the return type of this function will be different -- depending on which version of @template-haskell@ you are using. (See the -- Haddocks for 'Splice' for more -- information on this point.) -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. liftSplice :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif m (Syntax.TExp a) -> Splice m a # if MIN_VERSION_template_haskell(2,17,0) liftSplice = liftCode # else liftSplice = id # endif -- | A variant of 'liftTypedQuote' that is: -- -- 1. Always implemented in terms of 'Syntax.lift' behind the scenes, and -- -- 2. Returns a 'Splice'. This means that the return type of this function will -- be different depending on which version of @template-haskell@ you are -- using. (See the Haddocks for 'Splice' for more information on this -- point.) -- -- This is especially useful for minimizing CPP in one particular scenario: -- implementing 'Syntax.liftTyped' in hand-written 'Syntax.Lift' instances -- where the corresponding 'Syntax.lift' implementation cannot be derived. For -- instance, consider this example from the @text@ library: -- -- @ -- instance 'Syntax.Lift' Text where -- 'Syntax.lift' = appE (varE 'pack) . stringE . unpack -- #if MIN\_VERSION\_template\_haskell(2,17,0) -- 'Syntax.liftTyped' = 'unsafeCodeCoerce' . 'Syntax.lift' -- #elif MIN\_VERSION\_template\_haskell(2,16,0) -- 'Syntax.liftTyped' = 'Syntax.unsafeTExpCoerce' . 'Syntax.lift' -- #endif -- @ -- -- The precise details of how this 'Syntax.lift' implementation works are not -- important, only that it is something that @DeriveLift@ could not generate. -- The main point of this example is to illustrate how tiresome it is to write -- the CPP necessary to define 'Syntax.liftTyped' in a way that works across -- multiple versions of @template-haskell@. With 'liftTypedFromUntypedSplice', -- however, this becomes slightly easier to manage: -- -- @ -- instance 'Syntax.Lift' Text where -- 'Syntax.lift' = appE (varE 'pack) . stringE . unpack -- #if MIN\_VERSION\_template\_haskell(2,16,0) -- 'Syntax.liftTyped' = 'liftTypedFromUntypedSplice' -- #endif -- @ -- -- Note that due to the way this function is defined, this will only work -- for 'Syntax.Lift' instances @t@ such that @(t :: Type)@. If you wish to -- manually define 'Syntax.liftTyped' for a type with a different kind, you -- will have to use 'unsafeSpliceCoerce' to overcome levity polymorphism -- restrictions. liftTypedFromUntypedSplice :: (Syntax.Lift t, Quote m) => t -> Splice m t liftTypedFromUntypedSplice = unsafeSpliceCoerce . liftQuote -- | Unsafely convert an untyped splice representation into a typed 'Splice' -- representation. Because this function returns a 'Splice', the return type of -- this function will be different depending on which version of -- @template-haskell@ you are using. (See the Haddocks for 'Splice' for more -- information on this point.) -- -- This is especially useful for minimizing CPP when: -- -- 1. You need to implement 'Syntax.liftTyped' in a hand-written 'Syntax.Lift' -- instance where the corresponding 'Syntax.lift' implementation cannot be -- derived, and -- -- 2. The data type receiving a 'Lift' instance has a kind besides @Type@. -- -- Condition (2) is important because while it is possible to simply define -- @'Syntax.liftTyped = 'liftTypedFromUntypedSplice'@ for 'Syntax.Lift' -- instances @t@ such that @(t :: Type)@, this will not work for types with -- different types, such as unboxed types or unlifted newtypes. This is because -- GHC restrictions prevent defining 'liftTypedFromUntypedSplice' in a levity -- polymorphic fashion, so one must use 'unsafeSpliceCoerce' to work around -- these restrictions. Here is an example of how to use 'unsafeSpliceCoerce`: -- -- @ -- instance 'Syntax.Lift' Int# where -- 'Syntax.lift' x = litE (intPrimL (fromIntegral (I# x))) -- #if MIN\_VERSION\_template\_haskell(2,16,0) -- 'Syntax.liftTyped' x = 'unsafeSpliceCoerce' ('Syntax.lift' x) -- #endif -- @ -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. unsafeSpliceCoerce :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif Quote m => m Exp -> Splice m a # if MIN_VERSION_template_haskell(2,17,0) unsafeSpliceCoerce = unsafeCodeCoerce # else unsafeSpliceCoerce = unsafeTExpCoerceQuote # endif -- | A variant of 'unTypeCode' that takes a 'Splice' as an argument. Because -- this function takes a 'Splice' as an argyment, the type of this function -- will be different depending on which version of @template-haskell@ you are -- using. (See the Haddocks for 'Splice' for more information on this point.) -- -- Levity-polymorphic since /template-haskell-2.16.0.0/. unTypeSplice :: # if MIN_VERSION_template_haskell(2,16,0) forall (r :: RuntimeRep) (a :: TYPE r) m . # else forall a m . # endif Quote m => Splice m a -> m Exp # if MIN_VERSION_template_haskell(2,17,0) unTypeSplice = unTypeCode # else unTypeSplice = unTypeQQuote # endif #endif ------------------------------------------------------------------------------- -- Package root ------------------------------------------------------------------------------- #if !MIN_VERSION_template_haskell(2,19,0) -- | Get the package root for the current package which is being compiled. -- This can be set explicitly with the -package-root flag but is normally -- just the current working directory. -- -- The motivation for this flag is to provide a principled means to remove the -- assumption from splices that they will be executed in the directory where the -- cabal file resides. Projects such as haskell-language-server can't and don't -- change directory when compiling files but instead set the -package-root flag -- appropiately. -- -- This is best-effort compatibility implementation. -- This function looks at the source location of the Haskell file calling it, -- finds the first parent directory with a @.cabal@ file, and uses that as the -- root directory for fixing the relative path. -- getPackageRoot :: Q FilePath getPackageRoot = getPackageRootPredicate $ (==) ".cabal" . takeExtension -- The implementation is modified from the makeRelativeToLocationPredicate -- function in the file-embed package -- Copyright 2008, Michael Snoyman. All rights reserved. -- under BSD-2-Clause license. getPackageRootPredicate :: (FilePath -> Bool) -> Q FilePath getPackageRootPredicate isTargetFile = do loc <- qLocation (srcFP, mdir) <- Syntax.runIO $ do srcFP <- canonicalizePath $ Syntax.loc_filename loc mdir <- findProjectDir srcFP return (srcFP, mdir) case mdir of Nothing -> fail $ "Could not find .cabal file for path: " ++ srcFP Just dir -> return dir where findProjectDir x = do let dir = takeDirectory x if dir == x then return Nothing else do contents <- getDirectoryContents dir if any isTargetFile contents then return (Just dir) else findProjectDir dir -- | The input is a filepath, which if relative is offset by the package root. makeRelativeToProject :: FilePath -> Q FilePath makeRelativeToProject fp | isRelative fp = do root <- getPackageRoot return (root fp) makeRelativeToProject fp = return fp #endif th-compat-0.1.4/tests/Language/Haskell/TH/Syntax/0000755000000000000000000000000007346545000017652 5ustar0000000000000000th-compat-0.1.4/tests/Language/Haskell/TH/Syntax/CompatSpec.hs0000644000000000000000000000461207346545000022247 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} -- | Regression tests for "Language.Haskell.TH.Syntax.Compat". module Language.Haskell.TH.Syntax.CompatSpec (main, spec) where import Control.Exception (evaluate) import Control.Monad.State import Language.Haskell.TH.Syntax hiding (newName) import Language.Haskell.TH.Syntax.Compat import Prelude () import Prelude.Compat import Test.Hspec #if MIN_VERSION_template_haskell(2,9,0) import Types #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "newName" $ it "works on something that isn't a Quasi instance" $ runPureQ (newName "a") `shouldBe` mkNameU "a" 0 describe "unsafeQToQuote" $ do it "works on Quasi-less expressions" $ do $(unsafeQToQuote [| "abc" |]) `shouldBe` "abc" runPureQ (unsafeQToQuote [| "abc" |]) `shouldBe` LitE (StringL "abc") it "errors on Quasi-ful expressions" $ evaluate (runPureQ (unsafeQToQuote (qReport True "Explosion in 3... 2... 1..."))) `shouldThrow` errorCall "`unsafeQToQuote` does not support code that uses qReport" #if MIN_VERSION_template_haskell(2,9,0) describe "IsCode" $ it "manipulates typed TH expressions in a backwards-compatible way" $ $$(fromCode (toCode [|| "abc" ||])) `shouldBe` "abc" describe "joinSplice" $ it "allows intermixing typed TH splices with monadic computations in a convenient way" $ $$(joinSplice (do { x <- return "abc"; return [|| x ||] })) `shouldBe` "abc" describe "liftSplice" $ it "allows intermixing typed TH splices with monadic computations in a convenient way" $ $$(liftSplice (do { x <- return "abc"; examineSplice [|| x ||] })) `shouldBe` "abc" describe "liftTypedFromUntypedSplice" $ it "allows defining liftTyped in a convenient, backwards-compatible way" $ $$(liftTypedFromUntypedSplice MkFoo) `shouldBe` MkFoo describe "unTypeSplice" $ it "allows unwrapping Code in a convenient, backwards-compatible way" $ $$(unsafeSpliceCoerce (return . ListE =<< traverse unTypeSplice [ [|| "abc" ||] ]) :: SpliceQ [String]) `shouldBe` ["abc"] #endif newtype PureQ a = MkPureQ (State Uniq a) deriving (Functor, Applicative, Monad, MonadState Uniq) runPureQ :: PureQ a -> a runPureQ m = case m of MkPureQ m' -> evalState m' 0 instance Quote PureQ where newName s = state $ \i -> (mkNameU s i, i + 1) th-compat-0.1.4/tests/0000755000000000000000000000000007346545000012743 5ustar0000000000000000th-compat-0.1.4/tests/Spec.hs0000644000000000000000000000005407346545000014170 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} th-compat-0.1.4/tests/Types.hs0000644000000000000000000000253507346545000014410 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} #if MIN_VERSION_template_haskell(2,16,0) {-# LANGUAGE UnliftedNewtypes #-} #endif module Types (Foo(..)) where import Language.Haskell.TH.Syntax hiding (newName) #if MIN_VERSION_template_haskell(2,16,0) import GHC.Exts (Int#) import Language.Haskell.TH.Syntax.Compat #endif data Foo = MkFoo deriving (Eq, Show) -- An example of how to use liftTypedFromUntypedSplice to minimize the amount -- of CPP one has to use when manually defining `liftTyped` in `Lift` instance. -- This example is contrived, since you could just as well derive this -- particular `Lift` instance, but the same template will carry over to `Lift` -- instances that cannot be derived. instance Lift Foo where lift MkFoo = [| MkFoo |] #if MIN_VERSION_template_haskell(2,16,0) liftTyped = liftTypedFromUntypedSplice #endif #if MIN_VERSION_template_haskell(2,16,0) newtype UN = MkUN Int# -- An example of how to use unsafeSpliceCoerce to manually define liftTyped -- for an unlifted type in a backwards-compatible way. This example is -- contrived, since you could just as well derive this particular `Lift` -- instance, but the same template will carry over to `Lift` instances that -- cannot be derived. instance Lift UN where lift (MkUN i#) = [| MkUN i# |] liftTyped x = unsafeSpliceCoerce (lift x) #endif th-compat-0.1.4/th-compat.cabal0000644000000000000000000000607707346545000014473 0ustar0000000000000000cabal-version: >=1.10 name: th-compat version: 0.1.4 synopsis: Backward- (and forward-)compatible Quote and Code types description: This package defines a "Language.Haskell.TH.Syntax.Compat" module, which backports the @Quote@ and @Code@ types to work across a wide range of @template-haskell@ versions. The @makeRelativeToProject@ utility is also backported. On recent versions of @template-haskell@ (2.17.0.0 or later), this module simply reexports definitions from "Language.Haskell.TH.Syntax". Refer to the Haddocks for "Language.Haskell.TH.Syntax.Compat" for examples of how to use this module. homepage: https://github.com/haskell-compat/th-compat bug-reports: https://github.com/haskell-compat/th-compat/issues license: BSD3 license-file: LICENSE author: Ryan Scott maintainer: Ryan Scott copyright: (C) 2020 Ryan Scott category: Text build-type: Simple tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 , GHC == 9.2.3 , GHC == 9.4.1 extra-source-files: CHANGELOG.md, README.md source-repository head type: git location: https://github.com/haskell-compat/th-compat library exposed-modules: Language.Haskell.TH.Syntax.Compat build-depends: base >= 4.3 && < 5 , template-haskell >= 2.5 && < 2.20 if !impl(ghc >= 8.0) build-depends: fail == 4.9.* , transformers >= 0.2 && < 0.7 if !impl(ghc >= 9.4) build-depends: filepath >= 1.2.0.0 && < 1.5 , directory >= 1.1.0.0 && < 1.4 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Language.Haskell.TH.Syntax.CompatSpec Types build-depends: base >= 4.3 && < 5 , base-compat >= 0.6 && < 0.13 , hspec >= 2 && < 3 , mtl >= 2.1 && < 2.4 , template-haskell >= 2.5 && < 2.20 , th-compat build-tool-depends: hspec-discover:hspec-discover >= 2 hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts