Merge some instances from th-orphans.

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 ]

libraries/template-haskell/Language/Haskell/TH/Syntax.hs

 {-# 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))

testsuite/tests/th/TH_Lift.hs

+-- test Lifting instances
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module TH_Lift where
+
+import Language.Haskell.TH.Syntax
+import Data.Ratio
+import Data.Word
+import Data.Int
+
+a :: Integer
+a = $( (\x -> [| x |]) (5 :: Integer) )
+
+b :: Int
+b = $( (\x -> [| x |]) (5 :: Int) )
+
+b1 :: Int8
+b1 = $( (\x -> [| x |]) (5 :: Int8) )
+
+b2 :: Int16
+b2 = $( (\x -> [| x |]) (5 :: Int16) )
+
+b3 :: Int32
+b3 = $( (\x -> [| x |]) (5 :: Int32) )
+
+b4 :: Int64
+b4 = $( (\x -> [| x |]) (5 :: Int64) )
+
+c :: Word
+c = $( (\x -> [| x |]) (5 :: Word) )
+
+d :: Word8
+d = $( (\x -> [| x |]) (5 :: Word8) )
+
+e :: Word16
+e = $( (\x -> [| x |]) (5 :: Word16) )
+
+f :: Word32
+f = $( (\x -> [| x |]) (5 :: Word32) )
+
+g :: Word64
+g = $( (\x -> [| x |]) (5 :: Word64) )
+
+h :: Rational
+h = $( (\x -> [| x |]) (5 % 3 :: Rational) )
+
+h1 :: Float
+h1 = $( (\x -> [| x |]) (pi :: Float) )
+
+h2 :: Double
+h2 = $( (\x -> [| x |]) (pi :: Double) )
+
+i :: Char
+i = $( (\x -> [| x |]) 'x' )
+
+j :: Bool
+j = $( (\x -> [| x |]) True )
+
+k :: Maybe Char
+k = $( (\x -> [| x |]) (Just 'x') )
+
+l :: Either Char Bool
+l = $( (\x -> [| x |]) (Right False :: Either Char Bool) )
+
+m :: [Char]
+m = $( (\x -> [| x |]) "hi!")
+
+n :: ()
+n = $( (\x -> [| x |]) () )
+
+o :: (Bool, Char, Int)
+o = $( (\x -> [| x |]) (True, 'x', 4 :: Int) )
+
+

testsuite/tests/th/all.T

@@ -354,3 +354,4 @@ test('T1476', normal, compile, ['-v0'])
 test('T1476b', normal, compile_fail, ['-v0'])
 test('T9824', normal, compile, ['-v0'])
 test('T8031', normal, compile, ['-v0'])
+test('TH_Lift', normal, compile, ['-v0'])