diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,10 @@
+Version 1.4.1
+-------------
+* Added `Language.Haskell.TH.Desugar.Lift`, which provides `Lift` instances
+for all of the th-desugar types, as well as several Template Haskell types.
+
+* Added `applyDExp` and `applyDType` as convenience functions.
+
 Version 1.4.0
 -------------
 * All `Dec`s can now be desugared, to the new `DDec` type.
diff --git a/Language/Haskell/TH/Desugar.hs b/Language/Haskell/TH/Desugar.hs
--- a/Language/Haskell/TH/Desugar.hs
+++ b/Language/Haskell/TH/Desugar.hs
@@ -7,10 +7,19 @@
 {-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies,
              TypeSynonymInstances, FlexibleInstances #-}
 
-{-|
-Desugars full Template Haskell syntax into a smaller core syntax for further
-processing. The desugared types and constructors are prefixed with a D.
--}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.Haskell.TH.Desugar
+-- Copyright   :  (C) 2014 Richard Eisenberg
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Desugars full Template Haskell syntax into a smaller core syntax for further
+-- processing. The desugared types and constructors are prefixed with a D.
+--
+----------------------------------------------------------------------------
 
 module Language.Haskell.TH.Desugar (
   -- * Desugared data types
@@ -34,6 +43,7 @@
   dsMatches, dsBody, dsGuards, dsDoStmts, dsComp, dsClauses, 
 
   -- * Utility functions
+  applyDExp, applyDType,
   dPatToDExp, removeWilds, reifyWithWarning,
   getDataD, dataConNameToDataName, dataConNameToCon,
   nameOccursIn, allNamesIn, flattenDValD, getRecordSelectors,
diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
--- a/Language/Haskell/TH/Desugar/Core.hs
+++ b/Language/Haskell/TH/Desugar/Core.hs
@@ -160,7 +160,7 @@
 
 #if __GLASGOW_HASKELL__ < 707
 -- | Same as @Role@ from TH; defined here for GHC 7.6.3 compatibility.
-data Role = Nominal | Representational | Phantom
+data Role = NominalR | RepresentationalR | PhantomR | InferR
           deriving (Show, Typeable, Data)
 
 -- | Same as @AnnTarget@ from TH; defined here for GHC 7.6.3 compatibility.
@@ -921,3 +921,11 @@
 isUniversalPattern (DTildePa {}) = return True
 isUniversalPattern (DBangPa pat) = isUniversalPattern pat
 isUniversalPattern DWildPa       = return True
+
+-- | Apply one 'DExp' to a list of arguments
+applyDExp :: DExp -> [DExp] -> DExp
+applyDExp = foldl DAppE
+
+-- | Apply one 'DType' to a list of arguments
+applyDType :: DType -> [DType] -> DType
+applyDType = foldl DAppT
diff --git a/Language/Haskell/TH/Desugar/Expand.hs b/Language/Haskell/TH/Desugar/Expand.hs
--- a/Language/Haskell/TH/Desugar/Expand.hs
+++ b/Language/Haskell/TH/Desugar/Expand.hs
@@ -6,9 +6,19 @@
 
 {-# LANGUAGE CPP #-}
 
-{-| Expands type synonyms in desugared types, ignoring type families.
-See also the package th-expand-syns for doing this to non-desugared types.
--}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.Haskell.TH.Desugar.Expand
+-- Copyright   :  (C) 2014 Richard Eisenberg
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Expands type synonyms in desugared types, ignoring type families.
+-- See also the package th-expand-syns for doing this to non-desugared types.
+--
+----------------------------------------------------------------------------
 
 module Language.Haskell.TH.Desugar.Expand (
   expand, expandType, substTy
diff --git a/Language/Haskell/TH/Desugar/Lift.hs b/Language/Haskell/TH/Desugar/Lift.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/TH/Desugar/Lift.hs
@@ -0,0 +1,256 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.Haskell.TH.Desugar.Lift
+-- Copyright   :  (C) 2014 Richard Eisenberg
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Defines @Lift@ instances for the desugared language. This is defined
+-- in a separate module because it also must define @Lift@ instances for
+-- several TH types, which are orphans and may want another definition
+-- downstream.
+--
+----------------------------------------------------------------------------
+
+{-# LANGUAGE TemplateHaskell, MagicHash, TypeSynonymInstances, FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Language.Haskell.TH.Desugar.Lift () where
+
+import Prelude hiding ( mod, words )
+import Language.Haskell.TH.Desugar
+import Language.Haskell.TH.Syntax
+import Control.Applicative
+import GHC.Exts
+import GHC.Word
+
+foldApp :: Exp -> [Exp] -> Exp
+foldApp = foldl AppE
+           
+instance Lift DExp where
+  lift (DVarE n)      = foldApp (ConE 'DVarE)  <$> sequence [lift n]
+  lift (DConE n)      = foldApp (ConE 'DConE)  <$> sequence [lift n]
+  lift (DLitE l)      = foldApp (ConE 'DLitE)  <$> sequence [lift l]
+  lift (DAppE e1 e2)  = foldApp (ConE 'DAppE)  <$> sequence [lift e1, lift e2]
+  lift (DLamE ns e)   = foldApp (ConE 'DLamE)  <$> sequence [lift ns, lift e]
+  lift (DCaseE e ms)  = foldApp (ConE 'DCaseE) <$> sequence [lift e, lift ms]
+  lift (DLetE decs e) = foldApp (ConE 'DLetE)  <$> sequence [lift decs, lift e]
+  lift (DSigE e t)    = foldApp (ConE 'DSigE)  <$> sequence [lift e, lift t]
+
+instance Lift DPat where
+  lift (DLitPa l)    = foldApp (ConE 'DLitPa)   <$> sequence [lift l]
+  lift (DVarPa n)    = foldApp (ConE 'DVarPa)   <$> sequence [lift n]
+  lift (DConPa n ps) = foldApp (ConE 'DConPa)   <$> sequence [lift n, lift ps]
+  lift (DTildePa p)  = foldApp (ConE 'DTildePa) <$> sequence [lift p]
+  lift (DBangPa p)   = foldApp (ConE 'DBangPa)  <$> sequence [lift p]
+  lift DWildPa       = return $ ConE 'DWildPa
+
+instance Lift DType where
+  lift (DForallT tvbs cxt t) =
+    foldApp (ConE 'DForallT) <$> sequence [lift tvbs, lift cxt, lift t]
+  lift (DAppT t1 t2) = foldApp (ConE 'DAppT) <$> sequence [lift t1, lift t2]
+  lift (DSigT t k)   = foldApp (ConE 'DSigT) <$> sequence [lift t, lift k]
+  lift (DVarT n)     = foldApp (ConE 'DVarT) <$> sequence [lift n]
+  lift (DConT n)     = foldApp (ConE 'DConT) <$> sequence [lift n]
+  lift DArrowT       = return $ ConE 'DArrowT
+  lift (DLitT l)     = foldApp (ConE 'DLitT) <$> sequence [lift l]
+
+instance Lift DKind where
+  lift (DForallK ns k) = foldApp (ConE 'DForallK) <$> sequence [lift ns, lift k]
+  lift (DVarK n)       = foldApp (ConE 'DVarK)    <$> sequence [lift n]
+  lift (DConK n ks)    = foldApp (ConE 'DConK)    <$> sequence [lift n, lift ks]
+  lift (DArrowK k1 k2) = foldApp (ConE 'DArrowK)  <$> sequence [lift k1, lift k2]
+  lift DStarK          = return $ ConE 'DStarK
+
+instance Lift DPred where
+  lift (DAppPr p t) = foldApp (ConE 'DAppPr) <$> sequence [lift p, lift t]
+  lift (DSigPr p k) = foldApp (ConE 'DSigPr) <$> sequence [lift p, lift k]
+  lift (DVarPr n)   = foldApp (ConE 'DVarPr) <$> sequence [lift n]
+  lift (DConPr n)   = foldApp (ConE 'DConPr) <$> sequence [lift n]
+
+instance Lift DTyVarBndr where
+  lift (DPlainTV n)    = foldApp (ConE 'DPlainTV)  <$> sequence [lift n]
+  lift (DKindedTV n k) = foldApp (ConE 'DKindedTV) <$> sequence [lift n, lift k]
+
+instance Lift DMatch where
+  lift (DMatch p e) = foldApp (ConE 'DMatch) <$> sequence [lift p, lift e]
+
+instance Lift DClause where
+  lift (DClause ps e) = foldApp (ConE 'DClause) <$> sequence [lift ps, lift e]
+
+instance Lift DLetDec where
+  lift (DFunD n cs)  = foldApp (ConE 'DFunD)   <$> sequence [lift n, lift cs]
+  lift (DValD p e)   = foldApp (ConE 'DValD)   <$> sequence [lift p, lift e]
+  lift (DSigD n t)   = foldApp (ConE 'DSigD)   <$> sequence [lift n, lift t]
+  lift (DInfixD f n) = foldApp (ConE 'DInfixD) <$> sequence [lift f, lift n]
+
+instance Lift NewOrData where
+  lift Newtype = return $ ConE 'Newtype
+  lift Data    = return $ ConE 'Data
+
+instance Lift DDec where
+  lift (DLetDec dec) = foldApp (ConE 'DLetDec) <$> sequence [lift dec]
+  lift (DDataD nd cxt n tvbs cons derivs) =
+    foldApp (ConE 'DDataD) <$> sequence [ lift nd, lift cxt, lift n
+                                        , lift tvbs, lift cons, lift derivs ]
+  lift (DTySynD n tvbs ty) =
+    foldApp (ConE 'DTySynD) <$> sequence [lift n, lift tvbs, lift ty]
+  lift (DClassD cxt n tvbs fds decs) =
+    foldApp (ConE 'DClassD) <$> sequence [ lift cxt, lift n, lift tvbs
+                                         , lift fds, lift decs ]
+  lift (DInstanceD cxt ty decs) =
+    foldApp (ConE 'DInstanceD) <$> sequence [lift cxt, lift ty, lift decs]
+  lift (DForeignD for) = foldApp (ConE 'DForeignD) <$> sequence [lift for]
+  lift (DPragmaD prag) = foldApp (ConE 'DPragmaD) <$> sequence [lift prag]
+  lift (DFamilyD flav n tvbs res) =
+    foldApp (ConE 'DFamilyD) <$> sequence [lift flav, lift n, lift tvbs, lift res]
+  lift (DDataInstD nd cxt n tys cons derivs) =
+    foldApp (ConE 'DDataInstD) <$> sequence [ lift nd, lift cxt, lift n
+                                            , lift tys, lift cons, lift derivs ]
+  lift (DTySynInstD n eqn) = foldApp (ConE 'DTySynInstD) <$> sequence [lift n, lift eqn]
+  lift (DClosedTypeFamilyD n tvbs res eqns) =
+    foldApp (ConE 'DClosedTypeFamilyD) <$> sequence [ lift n, lift tvbs
+                                                    , lift res, lift eqns ]
+  lift (DRoleAnnotD n rs) =
+    foldApp (ConE 'DRoleAnnotD) <$> sequence [lift n, lift rs]
+
+instance Lift DCon where
+  lift (DCon tvbs cxt n fields) =
+    foldApp (ConE 'DCon) <$> sequence [lift tvbs, lift cxt, lift n, lift fields]
+
+instance Lift DConFields where
+  lift (DNormalC stys) = foldApp (ConE 'DNormalC) <$> sequence [lift stys]
+  lift (DRecC vstys)   = foldApp (ConE 'DRecC)    <$> sequence [lift vstys]
+
+instance Lift DForeign where
+  lift (DImportF cc safe str n ty) =
+    foldApp (ConE 'DImportF) <$> sequence [ lift cc, lift safe, lift str
+                                          , lift n, lift ty ]
+  lift (DExportF cc str n ty) =
+    foldApp (ConE 'DExportF) <$> sequence [lift cc, lift str, lift n, lift ty]
+
+instance Lift DPragma where
+  lift (DInlineP n i rm phases) =
+    foldApp (ConE 'DInlineP) <$> sequence [lift n, lift i, lift rm, lift phases]
+  lift (DSpecialiseP n ty m_i phases) =
+    foldApp (ConE 'DSpecialiseP) <$> sequence [ lift n, lift ty
+                                              , lift m_i, lift phases ]
+  lift (DSpecialiseInstP ty) = foldApp (ConE 'DSpecialiseInstP) <$> sequence [lift ty]
+  lift (DRuleP str bndrs e1 e2 phases) =
+    foldApp (ConE 'DRuleP) <$> sequence [ lift str, lift bndrs, lift e1
+                                        , lift e2, lift phases ]
+  lift (DAnnP targ e) = foldApp (ConE 'DAnnP) <$> sequence [lift targ, lift e]
+
+instance Lift DRuleBndr where
+  lift (DRuleVar n) = foldApp (ConE 'DRuleVar) <$> sequence [lift n]
+  lift (DTypedRuleVar n ty) =
+    foldApp (ConE 'DTypedRuleVar) <$> sequence [lift n, lift ty]
+
+instance Lift DTySynEqn where
+  lift (DTySynEqn lhs rhs) = foldApp (ConE 'DTySynEqn) <$> sequence [lift lhs, lift rhs]
+                                 
+-- Template Haskell liftings
+
+instance Lift OccName where
+  lift (OccName n) = foldApp (ConE 'OccName) <$> sequence [lift n]
+
+instance Lift ModName where
+  lift (ModName n) = foldApp (ConE 'ModName) <$> sequence [lift n]
+
+instance Lift PkgName where
+  lift (PkgName n) = foldApp (ConE 'PkgName) <$> sequence [lift n]
+
+instance Lift NameSpace where
+  lift VarName   = return $ ConE 'VarName
+  lift DataName  = return $ ConE 'DataName
+  lift TcClsName = return $ ConE 'TcClsName
+
+instance Lift NameFlavour where
+  lift NameS       = return $ ConE 'NameS
+  lift (NameQ mod) = foldApp (ConE 'NameQ) <$> sequence [lift mod]
+  lift (NameU n)   = return $ foldApp (ConE 'NameU) [LitE $ IntPrimL $ toInteger $ I# n]
+  lift (NameL n)   = return $ foldApp (ConE 'NameL) [LitE $ IntPrimL $ toInteger $ I# n]
+  lift (NameG ns pkg mod) =
+    foldApp (ConE 'NameG) <$> sequence [lift ns, lift pkg, lift mod]
+
+instance Lift Name where
+  lift (Name occ flav) = foldApp (ConE 'Name) <$> sequence [lift occ, lift flav]
+                                  
+instance Lift Lit where
+  lift (CharL ch)          = foldApp (ConE 'CharL)       <$> sequence [lift ch]
+  lift (StringL str)       = foldApp (ConE 'StringL)     <$> sequence [lift str]
+  lift (IntegerL i)        = foldApp (ConE 'IntegerL)    <$> sequence [lift i]
+  lift (RationalL rat)     = foldApp (ConE 'RationalL)   <$> sequence [lift rat]
+  lift (IntPrimL i)        = foldApp (ConE 'IntPrimL)    <$> sequence [lift i]
+  lift (WordPrimL i)       = foldApp (ConE 'WordPrimL)   <$> sequence [lift i]
+  lift (FloatPrimL rat)    = foldApp (ConE 'FloatPrimL)  <$> sequence [lift rat]
+  lift (DoublePrimL rat)   = foldApp (ConE 'DoublePrimL) <$> sequence [lift rat]
+  lift (StringPrimL words) = foldApp (ConE 'StringPrimL) <$> sequence [lift words]
+
+instance Lift TyLit where
+  lift (NumTyLit i) = foldApp (ConE 'NumTyLit) <$> sequence [lift i]
+  lift (StrTyLit s) = foldApp (ConE 'StrTyLit) <$> sequence [lift s]
+
+instance Lift Fixity where
+  lift (Fixity i dir) = foldApp (ConE 'Fixity) <$> sequence [lift i, lift dir]
+
+instance Lift FixityDirection where
+  lift InfixL = return $ ConE 'InfixL
+  lift InfixR = return $ ConE 'InfixR
+  lift InfixN = return $ ConE 'InfixN
+
+instance Lift Strict where
+  lift IsStrict  = return $ ConE 'IsStrict
+  lift NotStrict = return $ ConE 'NotStrict
+  lift Unpacked  = return $ ConE 'Unpacked
+
+instance Lift Callconv where
+  lift CCall   = return $ ConE 'CCall
+  lift StdCall = return $ ConE 'StdCall
+
+instance Lift Safety where
+  lift Unsafe = return $ ConE 'Unsafe
+  lift Safe   = return $ ConE 'Safe
+  lift Interruptible = return $ ConE 'Interruptible
+
+instance Lift Inline where
+  lift NoInline  = return $ ConE 'NoInline
+  lift Inline    = return $ ConE 'Inline
+  lift Inlinable = return $ ConE 'Inlinable
+
+instance Lift RuleMatch where
+  lift ConLike = return $ ConE 'ConLike
+  lift FunLike = return $ ConE 'FunLike
+
+instance Lift Phases where
+  lift AllPhases       = return $ ConE 'AllPhases
+  lift (FromPhase i)   = foldApp (ConE 'FromPhase)   <$> sequence [lift i]
+  lift (BeforePhase i) = foldApp (ConE 'BeforePhase) <$> sequence [lift i]
+
+instance Lift AnnTarget where
+  lift ModuleAnnotation    = return $ ConE 'ModuleAnnotation
+  lift (TypeAnnotation n)  = foldApp (ConE 'TypeAnnotation)  <$> sequence [lift n]
+  lift (ValueAnnotation n) = foldApp (ConE 'ValueAnnotation) <$> sequence [lift n]
+
+instance Lift FunDep where
+  lift (FunDep lhs rhs) = foldApp (ConE 'FunDep) <$> sequence [lift lhs, lift rhs]
+
+instance Lift FamFlavour where
+  lift TypeFam = return $ ConE 'TypeFam
+  lift DataFam = return $ ConE 'DataFam
+
+instance Lift Role where
+  lift NominalR          = return $ ConE 'NominalR
+  lift RepresentationalR = return $ ConE 'RepresentationalR
+  lift PhantomR          = return $ ConE 'PhantomR
+  lift InferR            = return $ ConE 'InferR
+
+-- Other type liftings:
+                                      
+instance Lift Rational where
+  lift rat = return $ LitE $ RationalL rat
+
+instance Lift Word8 where
+  lift word = return $ foldApp (VarE 'fromInteger) [LitE $ IntegerL (toInteger word)]
diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs
--- a/Language/Haskell/TH/Desugar/Sweeten.hs
+++ b/Language/Haskell/TH/Desugar/Sweeten.hs
@@ -8,8 +8,19 @@
 
 {-# LANGUAGE CPP #-}
 
-{-| The functions in this module convert desugared Template Haskell back into
-    proper Template Haskell. -}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.Haskell.TH.Desugar.Sweeten
+-- Copyright   :  (C) 2014 Richard Eisenberg
+-- License     :  BSD-style (see LICENSE)
+-- Maintainer  :  Richard Eisenberg (eir@cis.upenn.edu)
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- The functions in this module convert desugared Template Haskell back into
+-- proper Template Haskell.
+--
+----------------------------------------------------------------------------
 
 module Language.Haskell.TH.Desugar.Sweeten where
 
diff --git a/Test/Splices.hs b/Test/Splices.hs
--- a/Test/Splices.hs
+++ b/Test/Splices.hs
@@ -199,7 +199,7 @@
                 type instance Dec10 Int = Maybe
                 type instance Dec10 Bool = [] |]
 
-ds_role_test = DRoleAnnotD (mkName "Dec3") [Nominal]
+ds_role_test = DRoleAnnotD (mkName "Dec3") [NominalR]
 role_test = []
 #else
 dectest10 = [d| type family Dec10 a :: * -> * where
diff --git a/th-desugar.cabal b/th-desugar.cabal
--- a/th-desugar.cabal
+++ b/th-desugar.cabal
@@ -1,5 +1,5 @@
 name:           th-desugar
-version:        1.4.0
+version:        1.4.1
 cabal-version:  >= 1.10
 synopsis:       Functions to desugar Template Haskell
 homepage:       http://www.cis.upenn.edu/~eir/packages/th-desugar
@@ -26,7 +26,7 @@
 source-repository this
   type:     git
   location: https://github.com/goldfirere/th-desugar.git
-  tag:      v1.4.0
+  tag:      v1.4.1
 
 library
   build-depends:      
@@ -35,18 +35,22 @@
       containers >= 0.5,
       mtl >= 2.1,
       syb >= 0.4
+  default-extensions: TemplateHaskell
   exposed-modules:    Language.Haskell.TH.Desugar,
                       Language.Haskell.TH.Desugar.Sweeten,
-                      Language.Haskell.TH.Desugar.Expand
+                      Language.Haskell.TH.Desugar.Expand,
+                      Language.Haskell.TH.Desugar.Lift
   other-modules:      Language.Haskell.TH.Desugar.Core,
                       Language.Haskell.TH.Desugar.Util
   default-language:   Haskell2010
+  ghc-options:        -Wall
 
 
 test-suite spec
   type:               exitcode-stdio-1.0
   ghc-options:        -Wall -Werror -main-is Test.Run
   default-language:   Haskell2010
+  default-extensions: TemplateHaskell
   main-is:            Test/Run.hs
   other-modules:      Test.Splices, Test.Dec, Test.DsDec