Add support for LINE pragma in template-haskell

Summary:
Provide a way to generate {-# LINE #-} pragmas when generating
Decs in Template Haskell. This allows more meaningful line
numbers to be reported in compile-time errors for dynamically
generated code.

Test Plan: Run test suite

Reviewers: austin, hvr

Reviewed By: austin

Subscribers: hvr, simonmar, ezyang, carter, thomie

Differential Revision: https://phabricator.haskell.org/D299

4 files changed, 7 insertions, 0 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
index 29e3787bd0..76aae272bd 100644
--- a/libraries/template-haskell/Language/Haskell/TH.hs
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -137,6 +137,7 @@ module Language.Haskell.TH(
     -- **** Pragmas
     ruleVar, typedRuleVar,
     pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,
+    pragLineD,
 
         -- * Pretty-printer
     Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 3ac16d1dba..a7e3c238f9 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -413,6 +413,9 @@ pragAnnD target expr
       exp1 <- expr
       return $ PragmaD $ AnnP target exp1
 
+pragLineD :: Int -> String -> DecQ
+pragLineD line file = return $ PragmaD $ LineP line file
+
 familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
 familyNoKindD flav tc tvs = return $ FamilyD flav tc tvs Nothing
 
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index e2370666e4..81bf3c1d66 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -417,6 +417,8 @@ instance Ppr Pragma where
       where target1 ModuleAnnotation    = text "module"
             target1 (TypeAnnotation t)  = text "type" <+> ppr t
             target1 (ValueAnnotation v) = ppr v
+    ppr (LineP line file)
+       = text "{-# LINE" <+> int line <+> text (show file) <+> text "#-}"
 
 ------------------------------
 instance Ppr Inline where
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 87f18630dc..b5163cb44b 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1321,6 +1321,7 @@ data Pragma = InlineP         Name Inline RuleMatch Phases
             | SpecialiseInstP Type
             | RuleP           String [RuleBndr] Exp Exp Phases
             | AnnP            AnnTarget Exp
+            | LineP           Int String
         deriving( Show, Eq, Data, Typeable )
 
 data Inline = NoInline