Fix #11287.
[ghc.git] / testsuite / tests / th / TH_unresolvedInfix_Lib.hs
1 {-# LANGUAGE TypeOperators #-}
2
3 module TH_unresolvedInfix_Lib where
4
5 import Language.Haskell.TH
6 import Language.Haskell.TH.Lib
7 import Language.Haskell.TH.Quote
8
9 infixl 6 :+
10 infixl 7 :*
11
12 data Tree = N
13 | Tree :+ Tree
14 | Tree :* Tree
15
16 -- custom instance, including redundant parentheses
17 instance Show Tree where
18 show N = "N"
19 show (a :+ b) = "(" ++ show a ++ " :+ " ++ show b ++ ")"
20 show (a :* b) = "(" ++ show a ++ " :* " ++ show b ++ ")"
21
22 -- VarE versions
23 infixl 6 +:
24 infixl 7 *:
25 (+:) = (:+)
26 (*:) = (:*)
27
28 n = conE (mkName "N")
29 plus = conE (mkName ":+")
30 times = conE (mkName ":*")
31
32 a +? b = uInfixE a plus b
33 a *? b = uInfixE a times b
34 a +! b = infixApp a plus b
35 a *! b = infixApp a times b
36
37 plus2 = varE (mkName "+:")
38 times2 = varE (mkName "*:")
39 plus3 = conE ('(:+))
40
41
42 --------------------------------------------------------------------------------
43 -- Patterns --
44 --------------------------------------------------------------------------------
45 -- The only way to test pattern splices is using QuasiQuotation
46 mkQQ pat = QuasiQuoter undefined (const pat) undefined undefined
47 p = conP (mkName "N") []
48 plus' = mkName ":+"
49 times' = mkName ":*"
50
51 a ^+? b = uInfixP a plus' b
52 a ^*? b = uInfixP a times' b
53 a ^+! b = infixP a plus' b
54 a ^*! b = infixP a times' b
55
56 -------------- Completely-unresolved patterns
57 p1 = mkQQ ( p ^+? (p ^*? p) )
58 p2 = mkQQ ( (p ^+? p) ^*? p )
59 p3 = mkQQ ( p ^+? (p ^+? p) )
60 p4 = mkQQ ( (p ^+? p) ^+? p )
61 -------------- Completely-resolved patterns
62 p5 = mkQQ ( p ^+! (p ^*! p) )
63 p6 = mkQQ ( (p ^+! p) ^*! p )
64 p7 = mkQQ ( p ^+! (p ^+! p) )
65 p8 = mkQQ ( (p ^+! p) ^+! p )
66 -------------- Mixed resolved/unresolved
67 p9 = mkQQ ( (p ^+! p) ^*? (p ^+? p) )
68 p10 = mkQQ ( (p ^+? p) ^*? (p ^+! p) )
69 p11 = mkQQ ( (p ^+? p) ^*! (p ^+! p) )
70 p12 = mkQQ ( (p ^+? p) ^*! (p ^+? p) )
71 -------------- Parens
72 p13 = mkQQ ( ((parensP ((p ^+? p) ^*? p)) ^+? p) ^*? p )
73 p14 = mkQQ ( (parensP (p ^+? p)) ^*? (parensP (p ^+? p)) )
74 p15 = mkQQ ( parensP ((p ^+? p) ^*? (p ^+? p)) )
75 -------------- Dropping constructors
76 p16 = mkQQ ( p ^*? (tupP [p ^+? p]) )
77
78 --------------------------------------------------------------------------------
79 -- Types --
80 --------------------------------------------------------------------------------
81
82 infixl 6 +
83 infixl 7 *
84 data (+) a b = Plus a b
85 data (*) a b = Times a b
86
87 int = conT (mkName "Int")
88 tyPlus = mkName "+"
89 tyTimes = mkName "*"
90
91 a $+? b = uInfixT a tyPlus b
92 a $*? b = uInfixT a tyTimes b
93 a $+! b = infixT a tyPlus b
94 a $*! b = infixT a tyTimes b