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