
Just occurred to me that you can actually do this with a preprocessor. If we extract the "template" declarations to a separate module, then it can happen something like this (I have corrected some errors in the above code): ---- main.hs ---- import Language.Haskell.TH import QList import Control.Monad {- pretend we had this: main = do print (1,2,3) print (1) print (1,(2,3)) print ((1,2),3) - "template_outfix_lparen_rparen_expression" matches normal parens in the expression context - we also have a template operator for commas The rules for the preprocessor are: inputs to the templates are always wrapped in [| |]. The templates are wrapped in $(). This explains some of the extraneous nesting below (trying to pretend I'm a machine!) -} main = do print $( template_outfix_lparen_rparen_expression `fmap` [| $( comma `fmap` [| 1 |] `ap` (comma `fmap` [| 2 |] `ap` [| 3 |]) ) |]) print $( template_outfix_lparen_rparen_expression `fmap` [| $( [| 1 |] ) |]) print $( template_outfix_lparen_rparen_expression `fmap` [| $( comma `fmap` [| 1 |] `ap` [| $(template_outfix_lparen_rparen_expression `fmap` [| $( comma `fmap` [| 2 |] `ap` [| 3 |]) |] ) |] ) |]) print $( template_outfix_lparen_rparen_expression `fmap` [| $( comma `fmap` [| $( template_outfix_lparen_rparen_expression `fmap` [| $(comma `fmap` [| 1 |] `ap` [| 2 |]) |] ) |] `ap` [| 3 |] ) |]) ---------------------- QList.hs ------------------------------- {- contains the templates and QList. (the module created by preprocessor would usually only include templates, with QList being a helper module) -} module QList where import Debug.Trace import Language.Haskell.TH data QList a = QCons a (QList a) | QNil comma :: Exp → Exp → Exp a `comma` b@(AppE (AppE (ConE x) _) _) | x == qconsName = a `qcons` b | otherwise = a `qcons` (b `qcons` qnil) a `comma` b = a `qcons` (b `qcons` qnil) qnil :: Exp qnil = ConE (mkName "QNil") qcons :: Exp → Exp → Exp a `qcons` b = (ConE (mkName "QCons")) `AppE` a `AppE` b template_outfix_lparen_rparen_expression :: Exp → Exp template_outfix_lparen_rparen_expression x = case x of (AppE (AppE (ConE y) _) _) → if y == qconsName then TupE $ fromQList x else x _ → x fromQList :: Exp → [Exp] fromQList (AppE (AppE (ConE c) h) t) | c == qconsName = h:fromQList t | otherwise = error "malformed qlist (head)" fromQList (ConE n) | n == mkName "QNil" = [] | otherwise = error "malformed qlist (tail)" qconsName = mkName "QCons"