Merge some instances from th-orphans.

2 files changed, 54 insertions, 6 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 0f828eb98b..4ba43f3973 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -211,6 +211,9 @@ pprBody eq body = case body of
               | otherwise = arrow
 
 ------------------------------
+instance Ppr Lit where
+  ppr = pprLit noPrec
+
 pprLit :: Precedence -> Lit -> Doc
 pprLit i (IntPrimL x)    = parensIf (i > noPrec && x < 0)
                                     (integer x <> char '#')
@@ -576,3 +579,14 @@ hashParens d = text "(# " <> d <> text " #)"
 
 quoteParens :: Doc -> Doc
 quoteParens d = text "'(" <> d <> text ")"
+
+-----------------------------
+instance Ppr Loc where
+  ppr (Loc { loc_module = md
+           , loc_package = pkg
+           , loc_start = (start_ln, start_col)
+           , loc_end = (end_ln, end_col) })
+    = hcat [ text pkg, colon, text md, colon
+           , parens $ int start_ln <> comma <> int start_col
+           , text "-"
+           , parens $ int end_ln <> comma <> int end_col ]
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 3634ef777d..8e4b34462d 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents,
-             RoleAnnotations, DeriveGeneric, TypeSynonymInstances,
-             FlexibleInstances #-}
+             RoleAnnotations, DeriveGeneric, FlexibleInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -27,7 +26,9 @@ import System.IO.Unsafe ( unsafePerformIO )
 import Control.Monad (liftM)
 import System.IO        ( hPutStrLn, stderr )
 import Data.Char        ( isAlpha, isAlphaNum, isUpper )
-import Data.Word        ( Word8 )
+import Data.Int
+import Data.Word
+import Data.Ratio
 import GHC.Generics     ( Generic )
 
 -----------------------------------------------------
@@ -36,7 +37,7 @@ import GHC.Generics     ( Generic )
 --
 -----------------------------------------------------
 
-class (Monad m, Applicative m) => Quasi m where
+class Monad m => Quasi m where
   qNewName :: String -> m Name
         -- ^ Fresh names
 
@@ -457,8 +458,41 @@ instance Lift Integer where
 instance Lift Int where
   lift x = return (LitE (IntegerL (fromIntegral x)))
 
-instance Lift Rational where
-  lift x = return (LitE (RationalL x))
+instance Lift Int8 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Int16 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Int32 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Int64 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word8 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word16 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word32 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Lift Word64 where
+  lift x = return (LitE (IntegerL (fromIntegral x)))
+
+instance Integral a => Lift (Ratio a) where
+  lift x = return (LitE (RationalL (toRational x)))
+
+instance Lift Float where
+  lift x = return (LitE (RationalL (toRational x)))
+
+instance Lift Double where
+  lift x = return (LitE (RationalL (toRational x)))
 
 instance Lift Char where
   lift x = return (LitE (CharL x))