diff options
| -rw-r--r-- | testsuite/tests/quasiquotation/qq005/Expr.hs | 20 | ||||
| -rw-r--r-- | testsuite/tests/quasiquotation/qq005/Main.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/quasiquotation/qq006/Expr.hs | 20 | ||||
| -rw-r--r-- | testsuite/tests/quasiquotation/qq006/Main.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/quasiquotation/qq006/qq006.stderr | 8 |
5 files changed, 47 insertions, 13 deletions
diff --git a/testsuite/tests/quasiquotation/qq005/Expr.hs b/testsuite/tests/quasiquotation/qq005/Expr.hs index d628e8d52f..1c51d9db1f 100644 --- a/testsuite/tests/quasiquotation/qq005/Expr.hs +++ b/testsuite/tests/quasiquotation/qq005/Expr.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} module Expr where -import Data.Generics +import Data.Data +import Data.Typeable import Language.Haskell.TH as TH import Language.Haskell.TH.Quote @@ -29,6 +31,7 @@ eval (BinopExpr op x y) = (opToFun op) (eval x) (eval y) opToFun MulOp = (*) opToFun DivOp = (div) +small :: CharParser st Char small = lower <|> char '_' large = upper idchar = small <|> large <|> digit <|> char '\'' @@ -74,7 +77,8 @@ parseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s = eof return e -expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat } +expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat, + quoteType = undefined, quoteDec = undefined } parseExprExp :: String -> Q Exp parseExprExp s = do loc <- location @@ -97,3 +101,15 @@ antiExprPat (AntiIntExpr v) = Just $ conP (mkName "IntExpr") [varP (mkName v)] antiExprPat (AntiExpr v) = Just $ varP (mkName v) antiExprPat _ = Nothing + +-- Copied from syb for the test + +-- | Extend a generic query by a type-specific case +extQ :: ( Typeable a + , Typeable b + ) + => (a -> q) + -> (b -> q) + -> a + -> q +extQ f g a = maybe (f a) g (cast a) diff --git a/testsuite/tests/quasiquotation/qq005/Main.hs b/testsuite/tests/quasiquotation/qq005/Main.hs index d8c8a3433c..7b2de89831 100644 --- a/testsuite/tests/quasiquotation/qq005/Main.hs +++ b/testsuite/tests/quasiquotation/qq005/Main.hs @@ -7,7 +7,7 @@ main :: IO () main = do print $ eval [expr|1 + 3 + 5|] case [expr|2|] of [expr|$n|] -> print n - _ -> return () - case [$expr|1 + 2|] of + _ -> return () + case [expr|1 + 2|] of [expr|$x + $y|] -> putStrLn $ show x ++ " + " ++ show y - _ -> return () + _ -> return () diff --git a/testsuite/tests/quasiquotation/qq006/Expr.hs b/testsuite/tests/quasiquotation/qq006/Expr.hs index d628e8d52f..1c51d9db1f 100644 --- a/testsuite/tests/quasiquotation/qq006/Expr.hs +++ b/testsuite/tests/quasiquotation/qq006/Expr.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} module Expr where -import Data.Generics +import Data.Data +import Data.Typeable import Language.Haskell.TH as TH import Language.Haskell.TH.Quote @@ -29,6 +31,7 @@ eval (BinopExpr op x y) = (opToFun op) (eval x) (eval y) opToFun MulOp = (*) opToFun DivOp = (div) +small :: CharParser st Char small = lower <|> char '_' large = upper idchar = small <|> large <|> digit <|> char '\'' @@ -74,7 +77,8 @@ parseExpr (Loc {loc_filename = file, loc_start = (line,col)}) s = eof return e -expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat } +expr = QuasiQuoter { quoteExp = parseExprExp, quotePat = parseExprPat, + quoteType = undefined, quoteDec = undefined } parseExprExp :: String -> Q Exp parseExprExp s = do loc <- location @@ -97,3 +101,15 @@ antiExprPat (AntiIntExpr v) = Just $ conP (mkName "IntExpr") [varP (mkName v)] antiExprPat (AntiExpr v) = Just $ varP (mkName v) antiExprPat _ = Nothing + +-- Copied from syb for the test + +-- | Extend a generic query by a type-specific case +extQ :: ( Typeable a + , Typeable b + ) + => (a -> q) + -> (b -> q) + -> a + -> q +extQ f g a = maybe (f a) g (cast a) diff --git a/testsuite/tests/quasiquotation/qq006/Main.hs b/testsuite/tests/quasiquotation/qq006/Main.hs index 7e21acc235..686b849022 100644 --- a/testsuite/tests/quasiquotation/qq006/Main.hs +++ b/testsuite/tests/quasiquotation/qq006/Main.hs @@ -4,6 +4,6 @@ module Main where import Expr main :: IO () -main = do case [$expr|1 + 2|] of - [$expr|$x + $x|] -> print x - _ -> return () +main = do case [expr|1 + 2|] of + [expr|$x + $x|] -> print x + _ -> return () diff --git a/testsuite/tests/quasiquotation/qq006/qq006.stderr b/testsuite/tests/quasiquotation/qq006/qq006.stderr index 3eb51824b0..3fd0d019e3 100644 --- a/testsuite/tests/quasiquotation/qq006/qq006.stderr +++ b/testsuite/tests/quasiquotation/qq006/qq006.stderr @@ -1,4 +1,6 @@ -Main.hs:8:20: - Conflicting definitions for `x' - In a case alternative +Main.hs:8:20: error: + • Conflicting definitions for ‘x’ + Bound at: Main.hs:8:20-28 + Main.hs:8:20-28 + • In a case alternative |