diff --git a/dist/build/Language/Haskell/Exts/InternalParser.hs b/dist/build/Language/Haskell/Exts/InternalParser.hs
--- a/dist/build/Language/Haskell/Exts/InternalParser.hs
+++ b/dist/build/Language/Haskell/Exts/InternalParser.hs
@@ -45,7 +45,7 @@
 import Language.Haskell.Exts.Comments ( Comment )
 import Language.Haskell.Exts.Extension
 
-import Control.Monad ( liftM )
+import Control.Monad ( liftM, (<=<) )
 #if __GLASGOW_HASKELL__ >= 503
 import qualified Data.Array as Happy_Data_Array
 #else
@@ -7727,14 +7727,15 @@
 
 
 simpleParse :: AppFixity a => P (a L) -> String -> ParseResult (a L)
-simpleParse p = fmap (applyFixities preludeFixities) . runParser p
+simpleParse p = applyFixities preludeFixities <=< runParser p
 
 modeParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L)
-modeParse p mode = fmap (applyFixities (fixities mode)) . runParserWithMode mode p
+modeParse p mode = applyFixities (fixities mode) <=< runParserWithMode mode p
 
 commentParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L, [Comment])
-commentParse p mode str = runParserWithModeComments mode p str
-                             >>= \(ast, cs) -> return (applyFixities (fixities mode) ast, cs)
+commentParse p mode str = do (ast, cs) <- runParserWithModeComments mode p str
+                             ast' <- applyFixities (fixities mode) ast
+                             return (ast', cs)
 
 -- | Partial parse of a string starting with a series of top-level option pragmas.
 getTopPragmas :: String -> ParseResult [OptionPragma SrcSpanInfo]
@@ -7742,16 +7743,17 @@
 
 -- | Parse of a string, which should contain a complete Haskell module.
 parseModules :: String -> ParseResult [Module SrcSpanInfo]
-parseModules = fmap (map (applyFixities preludeFixities)) . runParser mparseModules
+parseModules = mapM (applyFixities preludeFixities) <=< runParser mparseModules
 
 -- | Parse of a string containing a complete Haskell module, using an explicit mode.
 parseModulesWithMode :: ParseMode -> String -> ParseResult [Module SrcSpanInfo]
-parseModulesWithMode mode = fmap (map (applyFixities (fixities mode))) . runParserWithMode mode mparseModules
+parseModulesWithMode mode = mapM (applyFixities (fixities mode)) <=< runParserWithMode mode mparseModules
 
 -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments.
 parseModulesWithComments :: ParseMode -> String -> ParseResult ([Module SrcSpanInfo], [Comment])
-parseModulesWithComments mode str = runParserWithModeComments mode mparseModules str
-                             >>= \(ast, cs) -> return (map (applyFixities (fixities mode)) ast, cs)
+parseModulesWithComments mode str = do (ast,cs) <- runParserWithModeComments mode mparseModules str
+                                       ast' <- mapM (applyFixities (fixities mode)) ast
+                                       return (ast', cs)
 {-# LINE 1 "templates\GenericTemplate.hs" #-}
 {-# LINE 1 "templates\\GenericTemplate.hs" #-}
 {-# LINE 1 "<built-in>" #-}
diff --git a/haskell-src-exts.cabal b/haskell-src-exts.cabal
--- a/haskell-src-exts.cabal
+++ b/haskell-src-exts.cabal
@@ -1,5 +1,5 @@
 Name:                   haskell-src-exts
-Version:                1.5.3
+Version:                1.6.0
 License:                BSD3
 License-File:           LICENSE
 Author:                 Niklas Broberg
diff --git a/src/Language/Haskell/Exts/Annotated/Fixity.hs b/src/Language/Haskell/Exts/Annotated/Fixity.hs
--- a/src/Language/Haskell/Exts/Annotated/Fixity.hs
+++ b/src/Language/Haskell/Exts/Annotated/Fixity.hs
@@ -41,6 +41,9 @@
 import Language.Haskell.Exts.Annotated.Simplify ( sQOp, sOp, sAssoc, sQName )
 
 import Data.Char (isUpper)
+import Control.Monad (when, (<=<), liftM, liftM2, liftM3, liftM4)
+import Data.Traversable (mapM)
+import Prelude hiding (mapM)
 
 -- | All AST elements that may include expressions which in turn may
 --   need fixity tweaking will be instances of this class.
@@ -48,44 +51,46 @@
   -- | Tweak any expressions in the element to account for the
   --   fixities given. Assumes that all operator expressions are
   --   fully left associative chains to begin with.
-  applyFixities :: [Fixity]   -- ^ The fixities to account for.
-                    -> ast SrcSpanInfo  -- ^ The element to tweak.
-                    -> ast SrcSpanInfo  -- ^ The same element, but with operator expressions updated.
+  applyFixities :: Monad m => [Fixity]      -- ^ The fixities to account for.
+                    -> ast SrcSpanInfo      -- ^ The element to tweak.
+                    -> m (ast SrcSpanInfo)  -- ^ The same element, but with operator expressions updated, or a failure.
 
 
 instance AppFixity Exp where
-  applyFixities fixs = infFix fixs . leafFix fixs
+  applyFixities fixs = infFix fixs <=< leafFix fixs
     where -- This is the real meat case. We can assume a left-associative list to begin with.
-          infFix fixs (InfixApp l2 a op2 z) =
-              let e = infFix fixs a
-               in case e of
-                   InfixApp l1 x op1 y ->
-                      let (a1,p1) = askFixity fixs op1
-                          (a2,p2) = askFixity fixs op2
-                       in if (p1 == p2 && (a1 /= a2 || a1 == S.AssocNone )) -- Ambiguous infix expression!
-                              || (p1 > p2 || p1 == p2 && (a1 == S.AssocLeft || a2 == S.AssocNone)) -- Already right order
-                           then InfixApp l2 e op2 z
-                           else InfixApp l2 x op1 (infFix fixs $ InfixApp (ann y <++> ann z) y op2 z)
-                   _  -> InfixApp l2 e op2 z
+          infFix fixs (InfixApp l2 a op2 z) = do
+              e <- infFix fixs a
+              case e of
+               InfixApp l1 x op1 y -> do
+                  let (a1,p1) = askFixity fixs op1
+                      (a2,p2) = askFixity fixs op2
+                  when (p1 == p2 && (a1 /= a2 || a1 == S.AssocNone )) -- Ambiguous infix expression!
+                       $ fail "Ambiguous infix expression"
+                  if (p1 > p2 || p1 == p2 && (a1 == S.AssocLeft || a2 == S.AssocNone)) -- Already right order
+                   then return $ InfixApp l2 e op2 z
+                   else liftM (InfixApp l2 x op1) (infFix fixs $ InfixApp (ann y <++> ann z) y op2 z)
+               _  -> return $ InfixApp l2 e op2 z
 
-          infFix _ e = e
+          infFix _ e = return e
 
 instance AppFixity Pat where
-  applyFixities fixs = infFix fixs . leafFixP fixs
+  applyFixities fixs = infFix fixs <=< leafFixP fixs
     where -- This is the real meat case. We can assume a left-associative list to begin with.
-          infFix fixs (PInfixApp l2 a op2 z) =
-              let p = infFix fixs a
-               in case p of
-                   PInfixApp l1 x op1 y ->
-                      let (a1,p1) = askFixityP fixs op1
-                          (a2,p2) = askFixityP fixs op2
-                       in if (p1 == p2 && (a1 /= a2 || a1 == S.AssocNone )) -- Ambiguous infix expression!
-                              || (p1 > p2 || p1 == p2 && (a1 == S.AssocLeft || a2 == S.AssocNone)) -- Already right order
-                           then PInfixApp l2 p op2 z
-                           else PInfixApp l2 x op1 (infFix fixs $ PInfixApp (ann y <++> ann z) y op2 z)
-                   _  -> PInfixApp l2 p op2 z
+          infFix fixs (PInfixApp l2 a op2 z) = do
+              p <- infFix fixs a
+              case p of
+               PInfixApp l1 x op1 y -> do
+                  let (a1,p1) = askFixityP fixs op1
+                      (a2,p2) = askFixityP fixs op2
+                  when (p1 == p2 && (a1 /= a2 || a1 == S.AssocNone )) -- Ambiguous infix expression!
+                       $ fail "Ambiguous infix expression"
+                  if (p1 > p2 || p1 == p2 && (a1 == S.AssocLeft || a2 == S.AssocNone)) -- Already right order
+                   then return $ PInfixApp l2 p op2 z
+                   else liftM (PInfixApp l2 x op1) (infFix fixs $ PInfixApp (ann y <++> ann z) y op2 z)
+               _  -> return $ PInfixApp l2 p op2 z
 
-          infFix _ p = p
+          infFix _ p = return p
 
 -- Internal: lookup associativity and precedence of an operator
 askFixity :: [Fixity] -> QOp l -> (S.Assoc, Int)
@@ -121,138 +126,138 @@
 
 instance AppFixity Module where
     applyFixities fixs (Module l mmh prs imp decls) =
-        Module l mmh prs imp $ appFixDecls fixs decls
+        liftM (Module l mmh prs imp) $ appFixDecls fixs decls
     applyFixities fixs (XmlPage l mn os xn xas mexp cs) =
-        XmlPage l mn os xn (map fix xas) (fmap fix mexp) (map fix cs)
-      where fix x = applyFixities fixs x
+        liftM3 (XmlPage l mn os xn) (fix xas) (fix mexp) (fix cs)
+      where fix xs = mapM (applyFixities fixs) xs
     applyFixities fixs (XmlHybrid l mmh prs imp decls xn xas mexp cs) =
-        XmlHybrid l mmh prs imp (appFixDecls fixs decls)
-                xn (map fixe xas) (fmap fixe mexp) (map fixe cs)
-      where fixe x = let extraFixs = getFixities decls
-                      in applyFixities (fixs++extraFixs) x
+        liftM4 (flip (XmlHybrid l mmh prs imp) xn) (appFixDecls fixs decls)
+                (fixe xas) (fixe mexp) (fixe cs)
+      where fixe xs = let extraFixs = getFixities decls
+                       in mapM (applyFixities (fixs++extraFixs)) xs
 
 instance AppFixity Decl where
     applyFixities fixs decl = case decl of
-        ClassDecl l ctxt dh deps cdecls   -> ClassDecl l ctxt dh deps $ fmap (map fix) cdecls
-        InstDecl  l ctxt ih idecls        -> InstDecl  l ctxt ih      $ fmap (map fix) idecls
-        SpliceDecl l spl        -> SpliceDecl l $ fix spl
-        FunBind l matches       -> FunBind l $ map fix matches
-        PatBind l p mt rhs bs -> PatBind l (fix p) mt (fix rhs) (fmap fix bs)
-        _                       -> decl
+        ClassDecl l ctxt dh deps cdecls   -> liftM (ClassDecl l ctxt dh deps) $ mapM (mapM fix) cdecls
+        InstDecl  l ctxt ih idecls        -> liftM (InstDecl  l ctxt ih)      $ mapM (mapM fix) idecls
+        SpliceDecl l spl        -> liftM (SpliceDecl l) $ fix spl
+        FunBind l matches       -> liftM (FunBind l) $ mapM fix matches
+        PatBind l p mt rhs bs -> liftM3 (flip (PatBind l) mt) (fix p) (fix rhs) (mapM fix bs)
+        _                       -> return decl
       where fix x = applyFixities fixs x
 
-appFixDecls :: [Fixity] -> [Decl SrcSpanInfo] -> [Decl SrcSpanInfo]
+appFixDecls :: Monad m => [Fixity] -> [Decl SrcSpanInfo] -> m [Decl SrcSpanInfo]
 appFixDecls fixs decls =
     let extraFixs = getFixities decls
-     in map (applyFixities (fixs++extraFixs)) decls
+     in mapM (applyFixities (fixs++extraFixs)) decls
 
 getFixities = concatMap getFixity
 getFixity (InfixDecl _ a mp ops) = let p = maybe 9 id mp in map (Fixity (sAssoc a) p) (map sOp ops)
 getFixity _ = []
 
 instance AppFixity ClassDecl where
-    applyFixities fixs (ClsDecl l decl) = ClsDecl l $ applyFixities fixs decl
-    applyFixities _ cdecl = cdecl
+    applyFixities fixs (ClsDecl l decl) = liftM (ClsDecl l) $ applyFixities fixs decl
+    applyFixities _ cdecl = return cdecl
 
 instance AppFixity InstDecl where
-    applyFixities fixs (InsDecl l decl) = InsDecl l $ applyFixities fixs decl
-    applyFixities _ idecl = idecl
+    applyFixities fixs (InsDecl l decl) = liftM (InsDecl l) $ applyFixities fixs decl
+    applyFixities _ idecl = return idecl
 
 instance AppFixity Match where
     applyFixities fixs match = case match of
-        Match l n ps rhs bs -> Match l n (map fix ps) (fix rhs) (fmap fix bs)
-        InfixMatch l a n b rhs bs -> InfixMatch l (fix a) n (fix b) (fix rhs) (fmap fix bs)
+        Match l n ps rhs bs -> liftM3 (Match l n) (mapM fix ps) (fix rhs) (mapM fix bs)
+        InfixMatch l a n b rhs bs -> liftM4 (flip (InfixMatch l) n) (fix a) (fix b) (fix rhs) (mapM fix bs)
       where fix x = applyFixities fixs x
 
 instance AppFixity Rhs where
     applyFixities fixs rhs = case rhs of
-        UnGuardedRhs l e      -> UnGuardedRhs l $ fix e
-        GuardedRhss l grhss   -> GuardedRhss l $ map fix grhss
+        UnGuardedRhs l e      -> liftM (UnGuardedRhs l) $ fix e
+        GuardedRhss l grhss   -> liftM (GuardedRhss l) $ mapM fix grhss
       where fix x = applyFixities fixs x
 
 instance AppFixity GuardedRhs where
-    applyFixities fixs (GuardedRhs l stmts e) = GuardedRhs l (map fix stmts) $ fix e
+    applyFixities fixs (GuardedRhs l stmts e) = liftM2 (GuardedRhs l) (mapM fix stmts) $ fix e
       where fix x = applyFixities fixs x
 
 instance AppFixity PatField where
-    applyFixities fixs (PFieldPat l n p) = PFieldPat l n $ applyFixities fixs p
-    applyFixities _ pf = pf
+    applyFixities fixs (PFieldPat l n p) = liftM (PFieldPat l n) $ applyFixities fixs p
+    applyFixities _ pf = return pf
 
 instance AppFixity RPat where
     applyFixities fixs rp = case rp of
-        RPOp l rp op          -> RPOp l (fix rp) op
-        RPEither l a b        -> RPEither l (fix a) (fix b)
-        RPSeq l rps           -> RPSeq l $ map fix rps
-        RPGuard l p stmts     -> RPGuard l (fix p) $ map fix stmts
-        RPCAs l n rp          -> RPCAs l n $ fix rp
-        RPAs l n rp           -> RPAs l n $ fix rp
-        RPParen l rp          -> RPParen l $ fix rp
-        RPPat l p             -> RPPat l $ fix p
+        RPOp l rp op          -> liftM (flip (RPOp l) op) $ fix rp
+        RPEither l a b        -> liftM2 (RPEither l) (fix a) (fix b)
+        RPSeq l rps           -> liftM (RPSeq l) $ mapM fix rps
+        RPGuard l p stmts     -> liftM2 (RPGuard l) (fix p) $ mapM fix stmts
+        RPCAs l n rp          -> liftM (RPCAs l n) $ fix rp
+        RPAs l n rp           -> liftM (RPAs l n) $ fix rp
+        RPParen l rp          -> liftM (RPParen l) $ fix rp
+        RPPat l p             -> liftM (RPPat l) $ fix p
       where fix x = applyFixities fixs x
 
 instance AppFixity PXAttr where
-    applyFixities fixs (PXAttr l n p) = PXAttr l n $ applyFixities fixs p
+    applyFixities fixs (PXAttr l n p) = liftM (PXAttr l n) $ applyFixities fixs p
 
 instance AppFixity Stmt where
     applyFixities fixs stmt = case stmt of
-        Generator l p e       -> Generator l (fix p) (fix e)
-        Qualifier l e         -> Qualifier l $ fix e
-        LetStmt l bs          -> LetStmt l $ fix bs    -- special behavior
-        RecStmt l stmts       -> RecStmt l $ map fix stmts
+        Generator l p e       -> liftM2 (Generator l) (fix p) (fix e)
+        Qualifier l e         -> liftM (Qualifier l) $ fix e
+        LetStmt l bs          -> liftM (LetStmt l) $ fix bs    -- special behavior
+        RecStmt l stmts       -> liftM (RecStmt l) $ mapM fix stmts
       where fix x = applyFixities fixs x
 
 instance AppFixity Binds where
     applyFixities fixs bs = case bs of
-        BDecls l decls        -> BDecls l $ appFixDecls fixs decls  -- special behavior
-        IPBinds l ips         -> IPBinds l $ map fix ips
+        BDecls l decls        -> liftM (BDecls l) $ appFixDecls fixs decls  -- special behavior
+        IPBinds l ips         -> liftM (IPBinds l) $ mapM fix ips
       where fix x = applyFixities fixs x
 
 
 instance AppFixity IPBind where
-    applyFixities fixs (IPBind l n e) = IPBind l n $ applyFixities fixs e
+    applyFixities fixs (IPBind l n e) = liftM (IPBind l n) $ applyFixities fixs e
 
 instance AppFixity FieldUpdate where
-    applyFixities fixs (FieldUpdate l n e) = FieldUpdate l n $ applyFixities fixs e
-    applyFixities _ fup = fup
+    applyFixities fixs (FieldUpdate l n e) = liftM (FieldUpdate l n) $ applyFixities fixs e
+    applyFixities _ fup = return fup
 
 instance AppFixity Alt where
-    applyFixities fixs (Alt l p galts bs) = Alt l (fix p) (fix galts) (fmap fix bs)
+    applyFixities fixs (Alt l p galts bs) = liftM3 (Alt l) (fix p) (fix galts) (mapM fix bs)
       where fix x = applyFixities fixs x
 
 instance AppFixity GuardedAlts where
     applyFixities fixs galts = case galts of
-        UnGuardedAlt l e      -> UnGuardedAlt l $ fix e
-        GuardedAlts  l galts  -> GuardedAlts l $ map fix galts
+        UnGuardedAlt l e      -> liftM (UnGuardedAlt l) $ fix e
+        GuardedAlts  l galts  -> liftM (GuardedAlts l) $ mapM fix galts
       where fix x = applyFixities fixs x
 
 instance AppFixity GuardedAlt where
-    applyFixities fixs (GuardedAlt l stmts e) = GuardedAlt l (map fix stmts) (fix e)
+    applyFixities fixs (GuardedAlt l stmts e) = liftM2 (GuardedAlt l) (mapM fix stmts) (fix e)
       where fix x = applyFixities fixs x
 
 instance AppFixity QualStmt where
     applyFixities fixs qstmt = case qstmt of
-        QualStmt     l s      -> QualStmt l $ fix s
-        ThenTrans    l e      -> ThenTrans l $ fix e
-        ThenBy       l e1 e2  -> ThenBy l (fix e1) (fix e2)
-        GroupBy      l e      -> GroupBy l (fix e)
-        GroupUsing   l e      -> GroupUsing l (fix e)
-        GroupByUsing l e1 e2  -> GroupByUsing l (fix e1) (fix e2)
+        QualStmt     l s      -> liftM (QualStmt l) $ fix s
+        ThenTrans    l e      -> liftM (ThenTrans l) $ fix e
+        ThenBy       l e1 e2  -> liftM2 (ThenBy l) (fix e1) (fix e2)
+        GroupBy      l e      -> liftM (GroupBy l) (fix e)
+        GroupUsing   l e      -> liftM (GroupUsing l) (fix e)
+        GroupByUsing l e1 e2  -> liftM2 (GroupByUsing l) (fix e1) (fix e2)
       where fix x = applyFixities fixs x
 
 instance AppFixity Bracket where
     applyFixities fixs br = case br of
-        ExpBracket l e    -> ExpBracket l $ fix e
-        PatBracket l p    -> PatBracket l $ fix p
-        DeclBracket l ds  -> DeclBracket l $ map fix ds
-        _                 -> br
+        ExpBracket l e    -> liftM (ExpBracket l) $ fix e
+        PatBracket l p    -> liftM (PatBracket l) $ fix p
+        DeclBracket l ds  -> liftM (DeclBracket l) $ mapM fix ds
+        _                 -> return br
       where fix x = applyFixities fixs x
 
 instance AppFixity Splice where
-    applyFixities fixs (ParenSplice l e) = ParenSplice l $ applyFixities fixs e
-    applyFixities _ s = s
+    applyFixities fixs (ParenSplice l e) = liftM (ParenSplice l) $ applyFixities fixs e
+    applyFixities _ s = return s
 
 instance AppFixity XAttr where
-    applyFixities fixs (XAttr l n e) = XAttr l n $ applyFixities fixs e
+    applyFixities fixs (XAttr l n e) = liftM (XAttr l n) $ applyFixities fixs e
 
 
 -- the boring boilerplate stuff for expressions too
@@ -260,63 +265,63 @@
 -- without yet touching the chain itself. We assume all chains are
 -- left-associate to begin with.
 leafFix fixs e = case e of
-    InfixApp l e1 op e2       -> InfixApp l (leafFix fixs e1) op (fix e2)
-    App l e1 e2               -> App l (fix e1) (fix e2)
-    NegApp l e                -> NegApp l $ fix e
-    Lambda l pats e           -> Lambda l (map fix pats) $ fix e
-    Let l bs e                -> Let l (fix bs) $ fix e
-    If l e a b                -> If l (fix e) (fix a) (fix b)
-    Case l e alts             -> Case l (fix e) $ map fix alts
-    Do l stmts                -> Do l $ map fix stmts
-    MDo l stmts               -> MDo l $ map fix stmts
-    Tuple l exps              -> Tuple l $ map fix exps
-    List l exps               -> List l $ map fix  exps
-    Paren l e                 -> Paren l $ fix e
-    LeftSection l e op        -> LeftSection l (fix e) op
-    RightSection l op e       -> RightSection l op $ fix e
-    RecConstr l n fups        -> RecConstr l n $ map fix fups
-    RecUpdate l e fups        -> RecUpdate l (fix e) $ map fix fups
-    EnumFrom l e              -> EnumFrom l $ fix e
-    EnumFromTo l e1 e2        -> EnumFromTo l (fix e1) (fix e2)
-    EnumFromThen l e1 e2      -> EnumFromThen l (fix e1) (fix e2)
-    EnumFromThenTo l e1 e2 e3 -> EnumFromThenTo l (fix e1) (fix e2) (fix e3)
-    ListComp l e quals        -> ListComp l (fix e) $ map fix quals
-    ParComp  l e qualss       -> ParComp l (fix e) $ map (map fix) qualss
-    ExpTypeSig l e t          -> ExpTypeSig l (fix e) t
-    BracketExp l b            -> BracketExp l $ fix b
-    SpliceExp l s             -> SpliceExp l $ fix s
-    XTag l n ats mexp cs      -> XTag l n (map fix ats) (fmap fix mexp) (map fix cs)
-    XETag l n ats mexp        -> XETag l n (map fix ats) (fmap fix mexp)
-    XExpTag l e               -> XExpTag l $ fix e
-    Proc l p e                -> Proc l (fix p) (fix e)
-    LeftArrApp l e1 e2        -> LeftArrApp l (fix e1) (fix e2)
-    RightArrApp l e1 e2       -> RightArrApp l (fix e1) (fix e2)
-    LeftArrHighApp l e1 e2    -> LeftArrHighApp l (fix e1) (fix e2)
-    RightArrHighApp l e1 e2   -> RightArrHighApp l (fix e1) (fix e2)
-    CorePragma l s e          -> CorePragma l s (fix e)
-    SCCPragma l s e           -> SCCPragma l s (fix e)
-    GenPragma l s ab cd e     -> GenPragma l s ab cd (fix e)
+    InfixApp l e1 op e2       -> liftM2 (flip (InfixApp l) op) (leafFix fixs e1) (fix e2)
+    App l e1 e2               -> liftM2 (App l) (fix e1) (fix e2)
+    NegApp l e                -> liftM (NegApp l) $ fix e
+    Lambda l pats e           -> liftM2 (Lambda l) (mapM fix pats) $ fix e
+    Let l bs e                -> liftM2 (Let l) (fix bs) $ fix e
+    If l e a b                -> liftM3 (If l) (fix e) (fix a) (fix b)
+    Case l e alts             -> liftM2 (Case l) (fix e) $ mapM fix alts
+    Do l stmts                -> liftM (Do l) $ mapM fix stmts
+    MDo l stmts               -> liftM (MDo l) $ mapM fix stmts
+    Tuple l exps              -> liftM (Tuple l) $ mapM fix exps
+    List l exps               -> liftM (List l) $ mapM fix  exps
+    Paren l e                 -> liftM (Paren l) $ fix e
+    LeftSection l e op        -> liftM (flip (LeftSection l) op) (fix e)
+    RightSection l op e       -> liftM (RightSection l op) $ fix e
+    RecConstr l n fups        -> liftM (RecConstr l n) $ mapM fix fups
+    RecUpdate l e fups        -> liftM2 (RecUpdate l) (fix e) $ mapM fix fups
+    EnumFrom l e              -> liftM (EnumFrom l) $ fix e
+    EnumFromTo l e1 e2        -> liftM2 (EnumFromTo l) (fix e1) (fix e2)
+    EnumFromThen l e1 e2      -> liftM2 (EnumFromThen l) (fix e1) (fix e2)
+    EnumFromThenTo l e1 e2 e3 -> liftM3 (EnumFromThenTo l) (fix e1) (fix e2) (fix e3)
+    ListComp l e quals        -> liftM2 (ListComp l) (fix e) $ mapM fix quals
+    ParComp  l e qualss       -> liftM2 (ParComp l) (fix e) $ mapM (mapM fix) qualss
+    ExpTypeSig l e t          -> liftM (flip (ExpTypeSig l) t) (fix e)
+    BracketExp l b            -> liftM (BracketExp l) $ fix b
+    SpliceExp l s             -> liftM (SpliceExp l) $ fix s
+    XTag l n ats mexp cs      -> liftM3 (XTag l n) (mapM fix ats) (mapM fix mexp) (mapM fix cs)
+    XETag l n ats mexp        -> liftM2 (XETag l n) (mapM fix ats) (mapM fix mexp)
+    XExpTag l e               -> liftM (XExpTag l) $ fix e
+    Proc l p e                -> liftM2 (Proc l) (fix p) (fix e)
+    LeftArrApp l e1 e2        -> liftM2 (LeftArrApp l) (fix e1) (fix e2)
+    RightArrApp l e1 e2       -> liftM2 (RightArrApp l) (fix e1) (fix e2)
+    LeftArrHighApp l e1 e2    -> liftM2 (LeftArrHighApp l) (fix e1) (fix e2)
+    RightArrHighApp l e1 e2   -> liftM2 (RightArrHighApp l) (fix e1) (fix e2)
+    CorePragma l s e          -> liftM (CorePragma l s) (fix e)
+    SCCPragma l s e           -> liftM (SCCPragma l s) (fix e)
+    GenPragma l s ab cd e     -> liftM (GenPragma l s ab cd) (fix e)
 
-    _                         -> e
+    _                         -> return e
   where
     fix x = applyFixities fixs x
 
 leafFixP fixs p = case p of
-        PNeg l p                -> PNeg l $ fix p
-        PApp l n ps             -> PApp l n $ map fix ps
-        PTuple l ps             -> PTuple l $ map fix ps
-        PList l ps              -> PList l $ map fix ps
-        PParen l p              -> PParen l $ fix p
-        PRec l n pfs            -> PRec l n $ map fix pfs
-        PAsPat l n p            -> PAsPat l n $ fix p
-        PIrrPat l p             -> PIrrPat l $ fix p
-        PatTypeSig l p t        -> PatTypeSig l (fix p) t
-        PViewPat l e p          -> PViewPat l (fix e) (fix p)
-        PRPat l rps             -> PRPat l $ map fix rps
-        PXTag l n ats mp ps     -> PXTag l n (map fix ats) (fmap fix mp) (map fix ps)
-        PXETag l n ats mp       -> PXETag l n (map fix ats) (fmap fix mp)
-        PXPatTag l p            -> PXPatTag l $ fix p
-        PXRPats l rps           -> PXRPats l $ map fix rps
-        PBangPat l p            -> PBangPat l $ fix p
-        _                       -> p
+        PNeg l p                -> liftM (PNeg l) $ fix p
+        PApp l n ps             -> liftM (PApp l n) $ mapM fix ps
+        PTuple l ps             -> liftM (PTuple l) $ mapM fix ps
+        PList l ps              -> liftM (PList l) $ mapM fix ps
+        PParen l p              -> liftM (PParen l) $ fix p
+        PRec l n pfs            -> liftM (PRec l n) $ mapM fix pfs
+        PAsPat l n p            -> liftM (PAsPat l n) $ fix p
+        PIrrPat l p             -> liftM (PIrrPat l) $ fix p
+        PatTypeSig l p t        -> liftM (flip (PatTypeSig l) t) (fix p)
+        PViewPat l e p          -> liftM2 (PViewPat l) (fix e) (fix p)
+        PRPat l rps             -> liftM (PRPat l) $ mapM fix rps
+        PXTag l n ats mp ps     -> liftM3 (PXTag l n) (mapM fix ats) (mapM fix mp) (mapM fix ps)
+        PXETag l n ats mp       -> liftM2 (PXETag l n) (mapM fix ats) (mapM fix mp)
+        PXPatTag l p            -> liftM (PXPatTag l) $ fix p
+        PXRPats l rps           -> liftM (PXRPats l) $ mapM fix rps
+        PBangPat l p            -> liftM (PBangPat l) $ fix p
+        _                       -> return p
       where fix x = applyFixities fixs x
diff --git a/src/Language/Haskell/Exts/Annotated/Syntax.hs b/src/Language/Haskell/Exts/Annotated/Syntax.hs
--- a/src/Language/Haskell/Exts/Annotated/Syntax.hs
+++ b/src/Language/Haskell/Exts/Annotated/Syntax.hs
@@ -657,9 +657,9 @@
 #endif
 
 -- | /literal/
--- Values of this type hold the abstract value of the literal, not the
+-- Values of this type hold the abstract value of the literal, along with the
 -- precise string representation used.  For example, @10@, @0o12@ and @0xa@
--- have the same representation.
+-- have the same value representation, but each carry a different string representation.
 data Literal l
     = Char       l Char     String     -- ^ character literal
     | String     l String   String     -- ^ string literal
@@ -1107,7 +1107,7 @@
 -- AST traversal, boiler-plate style
 
 -- | Test if two AST elements are equal modulo annotations.
-(=~=) :: (Functor a, Eq (a ())) => a l1 -> a l2 -> Bool
+(=~=) :: (Annotated a, Eq (a ())) => a l1 -> a l2 -> Bool
 a =~= b = fmap (const ()) a == fmap (const ()) b
 
 instance Functor ModuleName where
diff --git a/src/Language/Haskell/Exts/Fixity.hs b/src/Language/Haskell/Exts/Fixity.hs
--- a/src/Language/Haskell/Exts/Fixity.hs
+++ b/src/Language/Haskell/Exts/Fixity.hs
@@ -36,6 +36,9 @@
 import Language.Haskell.Exts.Syntax
 
 import Data.Char (isUpper)
+import Control.Monad (when, (<=<), liftM, liftM2, liftM3, liftM4)
+import Data.Traversable (mapM)
+import Prelude hiding (mapM)
 
 -- | Operator fixities are represented by their associativity
 --   (left, right or none) and their precedence (0-9).
@@ -47,44 +50,46 @@
   -- | Tweak any expressions in the element to account for the
   --   fixities given. Assumes that all operator expressions are
   --   fully left associative chains to begin with.
-  applyFixities :: [Fixity] -- ^ The fixities to account for.
+  applyFixities :: Monad m => [Fixity] -- ^ The fixities to account for.
                     -> ast  -- ^ The element to tweak.
-                    -> ast  -- ^ The same element, but with operator expressions updated.
+                    -> m ast  -- ^ The same element, but with operator expressions updated, or a failure.
 
 
 instance AppFixity Exp where
-  applyFixities fixs = infFix fixs . leafFix fixs
+  applyFixities fixs = infFix fixs <=< leafFix fixs
     where -- This is the real meat case. We can assume a left-associative list to begin with.
-          infFix fixs (InfixApp a op2 z) =
-              let e = infFix fixs a
-               in case e of
-                   InfixApp x op1 y ->
-                      let (a1,p1) = askFixity fixs op1
-                          (a2,p2) = askFixity fixs op2
-                       in if (p1 == p2 && (a1 /= a2 || a1 == AssocNone)) -- Ambiguous infix expression!
-                              || (p1 > p2 || p1 == p2 && (a1 == AssocLeft || a2 == AssocNone)) -- Already right order
-                           then InfixApp e op2 z
-                           else InfixApp x op1 (infFix fixs $ InfixApp y op2 z)
-                   _  -> InfixApp e op2 z
+          infFix fixs (InfixApp a op2 z) = do
+              e <- infFix fixs a
+              case e of
+               InfixApp x op1 y -> do
+                  let (a1,p1) = askFixity fixs op1
+                      (a2,p2) = askFixity fixs op2
+                  when (p1 == p2 && (a1 /= a2 || a1 == AssocNone)) -- Ambiguous infix expression!
+                    $ fail "Ambiguous infix expression"
+                  if (p1 > p2 || p1 == p2 && (a1 == AssocLeft || a2 == AssocNone)) -- Already right order
+                   then return $ InfixApp e op2 z
+                   else liftM (InfixApp x op1) (infFix fixs $ InfixApp y op2 z)
+               _  -> return $ InfixApp e op2 z
 
-          infFix _ e = e
+          infFix _ e = return e
 
 instance AppFixity Pat where
-  applyFixities fixs = infFix fixs . leafFixP fixs
+  applyFixities fixs = infFix fixs <=< leafFixP fixs
     where -- Same for patterns
-          infFix fixs (PInfixApp a op2 z) =
-              let p = infFix fixs a
-               in case p of
-                   PInfixApp x op1 y ->
-                      let (a1,p1) = askFixityP fixs op1
-                          (a2,p2) = askFixityP fixs op2
-                       in if (p1 == p2 && (a1 /= a2 || a1 == AssocNone)) -- Ambiguous infix expression!
-                              || (p1 > p2 || p1 == p2 && (a1 == AssocLeft || a2 == AssocNone)) -- Already right order
-                           then PInfixApp p op2 z
-                           else PInfixApp x op1 (infFix fixs $ PInfixApp y op2 z)
-                   _  -> PInfixApp p op2 z
+          infFix fixs (PInfixApp a op2 z) = do
+              p <- infFix fixs a
+              case p of
+               PInfixApp x op1 y -> do
+                  let (a1,p1) = askFixityP fixs op1
+                      (a2,p2) = askFixityP fixs op2
+                  when (p1 == p2 && (a1 /= a2 || a1 == AssocNone)) -- Ambiguous infix expression!
+                    $ fail "Ambiguous infix expression" 
+                  if (p1 > p2 || p1 == p2 && (a1 == AssocLeft || a2 == AssocNone)) -- Already right order
+                   then return $ PInfixApp p op2 z
+                   else liftM (PInfixApp x op1) (infFix fixs $ PInfixApp y op2 z)
+               _  -> return $ PInfixApp p op2 z
 
-          infFix _ p = p
+          infFix _ p = return p
 
 
 -- Internal: lookup associativity and precedence of an operator
@@ -180,127 +185,127 @@
 
 instance AppFixity Module where
     applyFixities fixs (Module loc n prs mwt ext imp decls) =
-        Module loc n prs mwt ext imp $ appFixDecls fixs decls
+        liftM (Module loc n prs mwt ext imp) $ appFixDecls fixs decls
 
 instance AppFixity Decl where
     applyFixities fixs decl = case decl of
-        ClassDecl loc ctxt n vars deps cdecls   -> ClassDecl loc ctxt n vars deps $ map fix cdecls
-        InstDecl loc ctxt n ts idecls           -> InstDecl loc ctxt n ts $ map fix idecls
-        SpliceDecl loc spl      -> SpliceDecl loc $ fix spl
-        FunBind matches         -> FunBind $ map fix matches
-        PatBind loc p mt rhs bs -> PatBind loc (fix p) mt (fix rhs) (fix bs)
-        _                       -> decl
+        ClassDecl loc ctxt n vars deps cdecls   -> liftM (ClassDecl loc ctxt n vars deps) $ mapM fix cdecls
+        InstDecl loc ctxt n ts idecls           -> liftM (InstDecl loc ctxt n ts) $ mapM fix idecls
+        SpliceDecl loc spl      -> liftM (SpliceDecl loc) $ fix spl
+        FunBind matches         -> liftM FunBind $ mapM fix matches
+        PatBind loc p mt rhs bs -> liftM3 (flip (PatBind loc) mt) (fix p) (fix rhs) (fix bs)
+        _                       -> return decl
       where fix x = applyFixities fixs x
 
-appFixDecls :: [Fixity] -> [Decl] -> [Decl]
+appFixDecls :: Monad m => [Fixity] -> [Decl] -> m [Decl]
 appFixDecls fixs decls =
     let extraFixs = getFixities decls
-     in map (applyFixities (fixs++extraFixs)) decls
+     in mapM (applyFixities (fixs++extraFixs)) decls
   where getFixities = concatMap getFixity
         getFixity (InfixDecl _ a p ops) = map (Fixity a p) ops
         getFixity _ = []
 
 instance AppFixity ClassDecl where
-    applyFixities fixs (ClsDecl decl) = ClsDecl $ applyFixities fixs decl
-    applyFixities _ cdecl = cdecl
+    applyFixities fixs (ClsDecl decl) = liftM ClsDecl $ applyFixities fixs decl
+    applyFixities _ cdecl = return cdecl
 
 instance AppFixity InstDecl where
-    applyFixities fixs (InsDecl decl) = InsDecl $ applyFixities fixs decl
-    applyFixities _ idecl = idecl
+    applyFixities fixs (InsDecl decl) = liftM InsDecl $ applyFixities fixs decl
+    applyFixities _ idecl = return idecl
 
 instance AppFixity Match where
-    applyFixities fixs (Match loc n ps mt rhs bs) = Match loc n (map fix ps) mt (fix rhs) (fix bs)
+    applyFixities fixs (Match loc n ps mt rhs bs) = liftM3 (flip (Match loc n) mt) (mapM fix ps) (fix rhs) (fix bs)
       where fix x = applyFixities fixs x
 
 instance AppFixity Rhs where
     applyFixities fixs rhs = case rhs of
-        UnGuardedRhs e      -> UnGuardedRhs $ fix e
-        GuardedRhss grhss   -> GuardedRhss $ map fix grhss
+        UnGuardedRhs e      -> liftM UnGuardedRhs $ fix e
+        GuardedRhss grhss   -> liftM GuardedRhss $ mapM fix grhss
       where fix x = applyFixities fixs x
 
 instance AppFixity GuardedRhs where
-    applyFixities fixs (GuardedRhs loc stmts e) = GuardedRhs loc (map fix stmts) $ fix e
+    applyFixities fixs (GuardedRhs loc stmts e) = liftM2 (GuardedRhs loc) (mapM fix stmts) $ fix e
       where fix x = applyFixities fixs x
 
 instance AppFixity PatField where
-    applyFixities fixs (PFieldPat n p) = PFieldPat n $ applyFixities fixs p
-    applyFixities _ pf = pf
+    applyFixities fixs (PFieldPat n p) = liftM (PFieldPat n) $ applyFixities fixs p
+    applyFixities _ pf = return pf
 
 instance AppFixity RPat where
     applyFixities fixs rp = case rp of
-        RPOp rp op          -> RPOp (fix rp) op
-        RPEither a b        -> RPEither (fix a) (fix b)
-        RPSeq rps           -> RPSeq $ map fix rps
-        RPGuard p stmts     -> RPGuard (fix p) $ map fix stmts
-        RPCAs n rp          -> RPCAs n $ fix rp
-        RPAs n rp           -> RPAs n $ fix rp
-        RPParen rp          -> RPParen $ fix rp
-        RPPat p             -> RPPat $ fix p
+        RPOp rp op          -> liftM (flip RPOp op) (fix rp)
+        RPEither a b        -> liftM2 RPEither (fix a) (fix b)
+        RPSeq rps           -> liftM RPSeq $ mapM fix rps
+        RPGuard p stmts     -> liftM2 RPGuard (fix p) $ mapM fix stmts
+        RPCAs n rp          -> liftM (RPCAs n) $ fix rp
+        RPAs n rp           -> liftM (RPAs n) $ fix rp
+        RPParen rp          -> liftM RPParen $ fix rp
+        RPPat p             -> liftM RPPat $ fix p
       where fix x = applyFixities fixs x
 
 instance AppFixity PXAttr where
-    applyFixities fixs (PXAttr n p) = PXAttr n $ applyFixities fixs p
+    applyFixities fixs (PXAttr n p) = liftM (PXAttr n) $ applyFixities fixs p
 
 instance AppFixity Stmt where
     applyFixities fixs stmt = case stmt of
-        Generator loc p e   -> Generator loc (fix p) (fix e)
-        Qualifier e         -> Qualifier $ fix e
-        LetStmt bs          -> LetStmt $ fix bs    -- special behavior
-        RecStmt stmts       -> RecStmt $ map fix stmts
+        Generator loc p e   -> liftM2 (Generator loc) (fix p) (fix e)
+        Qualifier e         -> liftM Qualifier $ fix e
+        LetStmt bs          -> liftM LetStmt $ fix bs    -- special behavior
+        RecStmt stmts       -> liftM RecStmt $ mapM fix stmts
       where fix x = applyFixities fixs x
 
 instance AppFixity Binds where
     applyFixities fixs bs = case bs of
-        BDecls decls        -> BDecls $ appFixDecls fixs decls  -- special behavior
-        IPBinds ips         -> IPBinds $ map fix ips
+        BDecls decls        -> liftM BDecls $ appFixDecls fixs decls  -- special behavior
+        IPBinds ips         -> liftM IPBinds $ mapM fix ips
       where fix x = applyFixities fixs x
 
 
 instance AppFixity IPBind where
-    applyFixities fixs (IPBind loc n e) = IPBind loc n $ applyFixities fixs e
+    applyFixities fixs (IPBind loc n e) = liftM (IPBind loc n) $ applyFixities fixs e
 
 instance AppFixity FieldUpdate where
-    applyFixities fixs (FieldUpdate n e) = FieldUpdate n $ applyFixities fixs e
-    applyFixities _ fup = fup
+    applyFixities fixs (FieldUpdate n e) = liftM (FieldUpdate n) $ applyFixities fixs e
+    applyFixities _ fup = return fup
 
 instance AppFixity Alt where
-    applyFixities fixs (Alt loc p galts bs) = Alt loc (fix p) (fix galts) (fix bs)
+    applyFixities fixs (Alt loc p galts bs) = liftM3 (Alt loc) (fix p) (fix galts) (fix bs)
       where fix x = applyFixities fixs x
 
 instance AppFixity GuardedAlts where
     applyFixities fixs galts = case galts of
-        UnGuardedAlt e      -> UnGuardedAlt $ fix e
-        GuardedAlts  galts  -> GuardedAlts $ map fix galts
+        UnGuardedAlt e      -> liftM UnGuardedAlt $ fix e
+        GuardedAlts  galts  -> liftM GuardedAlts $ mapM fix galts
       where fix x = applyFixities fixs x
 
 instance AppFixity GuardedAlt where
-    applyFixities fixs (GuardedAlt loc stmts e) = GuardedAlt loc (map fix stmts) (fix e)
+    applyFixities fixs (GuardedAlt loc stmts e) = liftM2 (GuardedAlt loc) (mapM fix stmts) (fix e)
       where fix x = applyFixities fixs x
 
 instance AppFixity QualStmt where
     applyFixities fixs qstmt = case qstmt of
-        QualStmt     s      -> QualStmt $ fix s
-        ThenTrans    e      -> ThenTrans $ fix e
-        ThenBy       e1 e2  -> ThenBy (fix e1) (fix e2)
-        GroupBy      e      -> GroupBy (fix e)
-        GroupUsing   e      -> GroupUsing (fix e)
-        GroupByUsing e1 e2  -> GroupByUsing (fix e1) (fix e2)
+        QualStmt     s      -> liftM QualStmt $ fix s
+        ThenTrans    e      -> liftM ThenTrans $ fix e
+        ThenBy       e1 e2  -> liftM2 ThenBy (fix e1) (fix e2)
+        GroupBy      e      -> liftM GroupBy (fix e)
+        GroupUsing   e      -> liftM GroupUsing (fix e)
+        GroupByUsing e1 e2  -> liftM2 GroupByUsing (fix e1) (fix e2)
       where fix x = applyFixities fixs x
 
 instance AppFixity Bracket where
     applyFixities fixs br = case br of
-        ExpBracket e    -> ExpBracket $ fix e
-        PatBracket p    -> PatBracket $ fix p
-        DeclBracket ds  -> DeclBracket $ map fix ds
-        _               -> br
+        ExpBracket e    -> liftM ExpBracket $ fix e
+        PatBracket p    -> liftM PatBracket $ fix p
+        DeclBracket ds  -> liftM DeclBracket $ mapM fix ds
+        _               -> return br
       where fix x = applyFixities fixs x
 
 instance AppFixity Splice where
-    applyFixities fixs (ParenSplice e) = ParenSplice $ applyFixities fixs e
-    applyFixities _ s = s
+    applyFixities fixs (ParenSplice e) = liftM ParenSplice $ applyFixities fixs e
+    applyFixities _ s = return s
 
 instance AppFixity XAttr where
-    applyFixities fixs (XAttr n e) = XAttr n $ applyFixities fixs e
+    applyFixities fixs (XAttr n e) = liftM (XAttr n) $ applyFixities fixs e
 
 
 -- the boring boilerplate stuff for expressions too
@@ -308,63 +313,63 @@
 -- without yet touching the chain itself. We assume all chains are
 -- left-associate to begin with.
 leafFix fixs e = case e of
-    InfixApp e1 op e2       -> InfixApp (leafFix fixs e1) op (fix e2)
-    App e1 e2               -> App (fix e1) (fix e2)
-    NegApp e                -> NegApp $ fix e
-    Lambda loc pats e       -> Lambda loc (map fix pats) $ fix e
-    Let bs e                -> Let (fix bs) $ fix e
-    If e a b                -> If (fix e) (fix a) (fix b)
-    Case e alts             -> Case (fix e) $ map fix alts
-    Do stmts                -> Do $ map fix stmts
-    MDo stmts               -> MDo $ map fix stmts
-    Tuple exps              -> Tuple $ map fix exps
-    List exps               -> List $ map fix  exps
-    Paren e                 -> Paren $ fix e
-    LeftSection e op        -> LeftSection (fix e) op
-    RightSection op e       -> RightSection op $ fix e
-    RecConstr n fups        -> RecConstr n $ map fix fups
-    RecUpdate e fups        -> RecUpdate (fix e) $ map fix fups
-    EnumFrom e              -> EnumFrom $ fix e
-    EnumFromTo e1 e2        -> EnumFromTo (fix e1) (fix e2)
-    EnumFromThen e1 e2      -> EnumFromThen (fix e1) (fix e2)
-    EnumFromThenTo e1 e2 e3 -> EnumFromThenTo (fix e1) (fix e2) (fix e3)
-    ListComp e quals        -> ListComp (fix e) $ map fix quals
-    ParComp  e qualss       -> ParComp (fix e) $ map (map fix) qualss
-    ExpTypeSig loc e t      -> ExpTypeSig loc (fix e) t
-    BracketExp b            -> BracketExp $ fix b
-    SpliceExp s             -> SpliceExp $ fix s
-    XTag loc n ats mexp cs  -> XTag loc n (map fix ats) (fmap fix mexp) (map fix cs)
-    XETag loc n ats mexp    -> XETag loc n (map fix ats) (fmap fix mexp)
-    XExpTag e               -> XExpTag $ fix e
-    Proc loc p e            -> Proc loc (fix p) (fix e)
-    LeftArrApp e1 e2        -> LeftArrApp (fix e1) (fix e2)
-    RightArrApp e1 e2       -> RightArrApp (fix e1) (fix e2)
-    LeftArrHighApp e1 e2    -> LeftArrHighApp (fix e1) (fix e2)
-    RightArrHighApp e1 e2   -> RightArrHighApp (fix e1) (fix e2)
-    CorePragma s e          -> CorePragma s (fix e)
-    SCCPragma s e           -> SCCPragma s (fix e)
-    GenPragma s ab cd e     -> GenPragma s ab cd (fix e)
+    InfixApp e1 op e2       -> liftM2 (flip InfixApp op) (leafFix fixs e1) (fix e2)
+    App e1 e2               -> liftM2 App (fix e1) (fix e2)
+    NegApp e                -> liftM NegApp $ fix e
+    Lambda loc pats e       -> liftM2 (Lambda loc) (mapM fix pats) $ fix e
+    Let bs e                -> liftM2 Let (fix bs) $ fix e
+    If e a b                -> liftM3 If (fix e) (fix a) (fix b)
+    Case e alts             -> liftM2 Case (fix e) $ mapM fix alts
+    Do stmts                -> liftM Do $ mapM fix stmts
+    MDo stmts               -> liftM MDo $ mapM fix stmts
+    Tuple exps              -> liftM Tuple $ mapM fix exps
+    List exps               -> liftM List $ mapM fix  exps
+    Paren e                 -> liftM Paren $ fix e
+    LeftSection e op        -> liftM (flip LeftSection op) (fix e)
+    RightSection op e       -> liftM (RightSection op) $ fix e
+    RecConstr n fups        -> liftM (RecConstr n) $ mapM fix fups
+    RecUpdate e fups        -> liftM2 RecUpdate (fix e) $ mapM fix fups
+    EnumFrom e              -> liftM EnumFrom $ fix e
+    EnumFromTo e1 e2        -> liftM2 EnumFromTo (fix e1) (fix e2)
+    EnumFromThen e1 e2      -> liftM2 EnumFromThen (fix e1) (fix e2)
+    EnumFromThenTo e1 e2 e3 -> liftM3 EnumFromThenTo (fix e1) (fix e2) (fix e3)
+    ListComp e quals        -> liftM2 ListComp (fix e) $ mapM fix quals
+    ParComp  e qualss       -> liftM2 ParComp (fix e) $ mapM (mapM fix) qualss
+    ExpTypeSig loc e t      -> liftM (flip (ExpTypeSig loc) t) (fix e)
+    BracketExp b            -> liftM BracketExp $ fix b
+    SpliceExp s             -> liftM SpliceExp $ fix s
+    XTag loc n ats mexp cs  -> liftM3 (XTag loc n) (mapM fix ats) (mapM fix mexp) (mapM fix cs)
+    XETag loc n ats mexp    -> liftM2 (XETag loc n) (mapM fix ats) (mapM fix mexp)
+    XExpTag e               -> liftM XExpTag $ fix e
+    Proc loc p e            -> liftM2 (Proc loc) (fix p) (fix e)
+    LeftArrApp e1 e2        -> liftM2 LeftArrApp (fix e1) (fix e2)
+    RightArrApp e1 e2       -> liftM2 RightArrApp (fix e1) (fix e2)
+    LeftArrHighApp e1 e2    -> liftM2 LeftArrHighApp (fix e1) (fix e2)
+    RightArrHighApp e1 e2   -> liftM2 RightArrHighApp (fix e1) (fix e2)
+    CorePragma s e          -> liftM (CorePragma s) (fix e)
+    SCCPragma s e           -> liftM (SCCPragma s) (fix e)
+    GenPragma s ab cd e     -> liftM (GenPragma s ab cd) (fix e)
 
-    _                       -> e
+    _                       -> return e
   where
     fix x = applyFixities fixs x
 
 leafFixP fixs p = case p of
-        PNeg p                -> PNeg $ fix p
-        PApp n ps             -> PApp n $ map fix ps
-        PTuple ps             -> PTuple $ map fix ps
-        PList ps              -> PList $ map fix ps
-        PParen p              -> PParen $ fix p
-        PRec n pfs            -> PRec n $ map fix pfs
-        PAsPat n p            -> PAsPat n $ fix p
-        PIrrPat p             -> PIrrPat $ fix p
-        PatTypeSig loc p t    -> PatTypeSig loc (fix p) t
-        PViewPat e p          -> PViewPat (fix e) (fix p)
-        PRPat rps             -> PRPat $ map fix rps
-        PXTag loc n ats mp ps -> PXTag loc n (map fix ats) (fmap fix mp) (map fix ps)
-        PXETag loc n ats mp   -> PXETag loc n (map fix ats) (fmap fix mp)
-        PXPatTag p            -> PXPatTag $ fix p
-        PXRPats rps           -> PXRPats $ map fix rps
-        PBangPat p            -> PBangPat $ fix p
-        _                     -> p
+        PNeg p                -> liftM PNeg $ fix p
+        PApp n ps             -> liftM (PApp n) $ mapM fix ps
+        PTuple ps             -> liftM PTuple $ mapM fix ps
+        PList ps              -> liftM PList $ mapM fix ps
+        PParen p              -> liftM PParen $ fix p
+        PRec n pfs            -> liftM (PRec n) $ mapM fix pfs
+        PAsPat n p            -> liftM (PAsPat n) $ fix p
+        PIrrPat p             -> liftM PIrrPat $ fix p
+        PatTypeSig loc p t    -> liftM (flip (PatTypeSig loc) t) (fix p)
+        PViewPat e p          -> liftM2 PViewPat (fix e) (fix p)
+        PRPat rps             -> liftM PRPat $ mapM fix rps
+        PXTag loc n ats mp ps -> liftM3 (PXTag loc n) (mapM fix ats) (mapM fix mp) (mapM fix ps)
+        PXETag loc n ats mp   -> liftM2 (PXETag loc n) (mapM fix ats) (mapM fix mp)
+        PXPatTag p            -> liftM PXPatTag $ fix p
+        PXRPats rps           -> liftM PXRPats $ mapM fix rps
+        PBangPat p            -> liftM PBangPat $ fix p
+        _                     -> return p
       where fix x = applyFixities fixs x
diff --git a/src/Language/Haskell/Exts/InternalParser.ly b/src/Language/Haskell/Exts/InternalParser.ly
--- a/src/Language/Haskell/Exts/InternalParser.ly
+++ b/src/Language/Haskell/Exts/InternalParser.ly
@@ -46,7 +46,7 @@
 > import Language.Haskell.Exts.Comments ( Comment )
 > import Language.Haskell.Exts.Extension
 
-> import Control.Monad ( liftM )
+> import Control.Monad ( liftM, (<=<) )
 import Debug.Trace (trace)
 
 > }
@@ -1780,14 +1780,15 @@
 
 
 > simpleParse :: AppFixity a => P (a L) -> String -> ParseResult (a L)
-> simpleParse p = fmap (applyFixities preludeFixities) . runParser p
+> simpleParse p = applyFixities preludeFixities <=< runParser p
 
 > modeParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L)
-> modeParse p mode = fmap (applyFixities (fixities mode)) . runParserWithMode mode p
+> modeParse p mode = applyFixities (fixities mode) <=< runParserWithMode mode p
 
 > commentParse :: AppFixity a => P (a L) -> ParseMode -> String -> ParseResult (a L, [Comment])
-> commentParse p mode str = runParserWithModeComments mode p str
->                              >>= \(ast, cs) -> return (applyFixities (fixities mode) ast, cs)
+> commentParse p mode str = do (ast, cs) <- runParserWithModeComments mode p str
+>                              ast' <- applyFixities (fixities mode) ast
+>                              return (ast', cs)
 
 > -- | Partial parse of a string starting with a series of top-level option pragmas.
 > getTopPragmas :: String -> ParseResult [OptionPragma SrcSpanInfo]
@@ -1795,16 +1796,17 @@
 
 > -- | Parse of a string, which should contain a complete Haskell module.
 > parseModules :: String -> ParseResult [Module SrcSpanInfo]
-> parseModules = fmap (map (applyFixities preludeFixities)) . runParser mparseModules
+> parseModules = mapM (applyFixities preludeFixities) <=< runParser mparseModules
 
 > -- | Parse of a string containing a complete Haskell module, using an explicit mode.
 > parseModulesWithMode :: ParseMode -> String -> ParseResult [Module SrcSpanInfo]
-> parseModulesWithMode mode = fmap (map (applyFixities (fixities mode))) . runParserWithMode mode mparseModules
+> parseModulesWithMode mode = mapM (applyFixities (fixities mode)) <=< runParserWithMode mode mparseModules
 
 > -- | Parse of a string containing a complete Haskell module, using an explicit mode, retaining comments.
 > parseModulesWithComments :: ParseMode -> String -> ParseResult ([Module SrcSpanInfo], [Comment])
-> parseModulesWithComments mode str = runParserWithModeComments mode mparseModules str
->                              >>= \(ast, cs) -> return (map (applyFixities (fixities mode)) ast, cs)
+> parseModulesWithComments mode str = do (ast,cs) <- runParserWithModeComments mode mparseModules str
+>                                        ast' <- mapM (applyFixities (fixities mode)) ast
+>                                        return (ast', cs)
 >
 
 > }
diff --git a/src/Language/Haskell/Exts/ParseUtils.hs b/src/Language/Haskell/Exts/ParseUtils.hs
--- a/src/Language/Haskell/Exts/ParseUtils.hs
+++ b/src/Language/Haskell/Exts/ParseUtils.hs
@@ -321,7 +321,7 @@
                         _ -> patFail ""
             _ -> patFail ""
     TupleSection l mes    ->
-            if not (any ((=~=) Nothing) mes)
+            if not (any ((==) Nothing) mes)
              then do ps <- mapM (\e -> checkPat e []) (map fromJust mes)
                      return (PTuple l ps)
              else fail "Illegal tuple section in pattern"
@@ -528,7 +528,7 @@
                      return (S.Case l e alts)
     Do l stmts            -> checkDo stmts >> return (S.Do l stmts)
     MDo l stmts           -> checkDo stmts >> return (S.MDo l stmts)
-    TupleSection l mes -> if not (any ((=~=) Nothing) mes)
+    TupleSection l mes -> if not (any ((==) Nothing) mes)
                            then checkManyExprs (map fromJust mes) (S.Tuple l)
                            else do checkEnabled TupleSections
                                    mes' <- mapM mCheckExpr mes