diff --git a/ChangeLog b/ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2018-00-27 v0.5.6.0
+	* Support GHC 8.4 slpha2
+	* Include test examples for GHC 8.2
+	* Fix parseModuleFromString to correctly handle the sheband case (@lspitzner)
 2017-07-23 v0.5.5.0
 	* Support GHC 8.2.1
 2017-05-17 v0.5.4.0
diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal
--- a/ghc-exactprint.cabal
+++ b/ghc-exactprint.cabal
@@ -1,5 +1,5 @@
 name:                ghc-exactprint
-version:             0.5.5.0
+version:             0.5.6.0
 synopsis:            ExactPrint for GHC
 description:         Using the API Annotations available from GHC 7.10.2, this
                      library provides a means to round trip any code that can
@@ -29,13 +29,15 @@
 maintainer:          alan.zimm@gmail.com
 category:            Development
 build-type:          Simple
-tested-with:    GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1
+tested-with:    GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.2
 extra-source-files:  ChangeLog
                      src-ghc710/Language/Haskell/GHC/ExactPrint/*.hs
                      tests/examples/failing/*.hs
                      tests/examples/ghc710/*.hs
                      tests/examples/ghc710-only/*.hs
                      tests/examples/ghc80/*.hs
+                     tests/examples/ghc82/*.hs
+                     tests/examples/ghc84/*.hs
                      tests/examples/transform/*.hs
                      tests/examples/failing/*.hs.bad
                      tests/examples/transform/*.hs.expected
@@ -78,7 +80,7 @@
   -- other-modules:
   -- other-extensions:
   GHC-Options:         -Wall
-  build-depends:       base >=4.7 && <4.11
+  build-depends:       base >=4.7 && <4.12
                      , bytestring >= 0.10.6
                      , containers >= 0.5
                      , directory >= 1.2
@@ -92,13 +94,16 @@
       build-depends: ghc-boot
   hs-source-dirs:      src
 
-  if impl (ghc > 8.0.3)
-      hs-source-dirs: src-ghc82
+  if impl (ghc > 8.2.2)
+      hs-source-dirs: src-ghc84
   else
-    if impl (ghc > 7.10.3)
-        hs-source-dirs: src-ghc80
+    if impl (ghc > 8.0.3)
+        hs-source-dirs: src-ghc82
     else
-        hs-source-dirs: src-ghc710
+      if impl (ghc > 7.10.3)
+          hs-source-dirs: src-ghc80
+      else
+          hs-source-dirs: src-ghc710
 
   default-language:    Haskell2010
   if impl (ghc < 7.10.2)
@@ -112,13 +117,16 @@
   else
     hs-source-dirs:      tests
 
-  if impl (ghc > 8.0.3)
-      hs-source-dirs: src-ghc82
+  if impl (ghc > 8.2.2)
+      hs-source-dirs: src-ghc84
   else
-    if impl (ghc > 7.10.3)
-        hs-source-dirs: src-ghc80
+    if impl (ghc > 8.0.3)
+        hs-source-dirs: src-ghc82
     else
-        hs-source-dirs: src-ghc710
+      if impl (ghc > 7.10.3)
+          hs-source-dirs: src-ghc80
+      else
+          hs-source-dirs: src-ghc710
 
   main-is:             Test.hs
   other-modules:       Test.Common
diff --git a/src-ghc80/Language/Haskell/GHC/ExactPrint/Annotater.hs b/src-ghc80/Language/Haskell/GHC/ExactPrint/Annotater.hs
--- a/src-ghc80/Language/Haskell/GHC/ExactPrint/Annotater.hs
+++ b/src-ghc80/Language/Haskell/GHC/ExactPrint/Annotater.hs
@@ -2152,7 +2152,7 @@
 
       markExpr _ (GHC.HsAppType e ty) = do
         markLocated e
-        mark GHC.AnnAt
+        markInstead GHC.AnnAt AnnTypeApp
         markLHsWcType ty
       markExpr _ (GHC.HsAppTypeOut _ _) =
         traceM "warning: HsAppTypeOut introduced after renaming"
diff --git a/src-ghc82/Language/Haskell/GHC/ExactPrint/Annotater.hs b/src-ghc82/Language/Haskell/GHC/ExactPrint/Annotater.hs
--- a/src-ghc82/Language/Haskell/GHC/ExactPrint/Annotater.hs
+++ b/src-ghc82/Language/Haskell/GHC/ExactPrint/Annotater.hs
@@ -2133,7 +2133,7 @@
 
       markExpr _ (GHC.HsAppType e ty) = do
         markLocated e
-        mark GHC.AnnAt
+        markInstead GHC.AnnAt AnnTypeApp
         markLHsWcType ty
       markExpr _ (GHC.HsAppTypeOut _ _) =
         traceM "warning: HsAppTypeOut introduced after renaming"
diff --git a/src-ghc84/Language/Haskell/GHC/ExactPrint/Annotater.hs b/src-ghc84/Language/Haskell/GHC/ExactPrint/Annotater.hs
new file mode 100644
--- /dev/null
+++ b/src-ghc84/Language/Haskell/GHC/ExactPrint/Annotater.hs
@@ -0,0 +1,2607 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-} -- Needed for the DataId constraint on ResTyGADTHook
+-- | 'annotate' is a function which given a GHC AST fragment, constructs
+-- a syntax tree which indicates which annotations belong to each specific
+-- part of the fragment.
+--
+-- "Delta" and "Print" provide two interpreters for this structure. You
+-- should probably use those unless you know what you're doing!
+--
+-- The functor 'AnnotationF' has a number of constructors which correspond
+-- to different sitations which annotations can arise. It is hoped that in
+-- future versions of GHC these can be simplified by making suitable
+-- modifications to the AST.
+
+module Language.Haskell.GHC.ExactPrint.Annotater
+       (
+         annotate
+       , AnnotationF(..)
+       , Annotated
+       , Annotate(..)
+       , withSortKeyContextsHelper
+       ) where
+
+
+import Language.Haskell.GHC.ExactPrint.AnnotateTypes
+import Language.Haskell.GHC.ExactPrint.Types
+import Language.Haskell.GHC.ExactPrint.Utils
+
+import qualified Bag            as GHC
+import qualified BasicTypes     as GHC
+import qualified BooleanFormula as GHC
+import qualified Class          as GHC
+import qualified CoAxiom        as GHC
+import qualified FastString     as GHC
+import qualified ForeignCall    as GHC
+import qualified GHC            as GHC
+import qualified Name           as GHC
+import qualified RdrName        as GHC
+import qualified Outputable     as GHC
+
+import Control.Monad.Identity
+import Data.Data
+import Data.Maybe
+
+import qualified Data.Set as Set
+
+import Debug.Trace
+
+
+{-# ANN module "HLint: ignore Eta reduce" #-}
+{-# ANN module "HLint: ignore Redundant do" #-}
+{-# ANN module "HLint: ignore Reduce duplication" #-}
+-- ---------------------------------------------------------------------
+
+class Data ast => Annotate ast where
+  markAST :: GHC.SrcSpan -> ast -> Annotated ()
+
+-- ---------------------------------------------------------------------
+
+-- | Construct a syntax tree which represent which KeywordIds must appear
+-- where.
+annotate :: (Annotate ast) => GHC.Located ast -> Annotated ()
+annotate = markLocated
+
+-- ---------------------------------------------------------------------
+
+-- | Constructs a syntax tree which contains information about which
+-- annotations are required by each element.
+markLocated :: (Annotate ast) => GHC.Located ast -> Annotated ()
+markLocated ast =
+  case cast ast :: Maybe (GHC.LHsDecl GHC.GhcPs) of
+    Just d  -> markLHsDecl d
+    Nothing -> withLocated ast markAST
+
+-- ---------------------------------------------------------------------
+
+-- |When adding missing annotations, do not put a preceding space in front of a list
+markListNoPrecedingSpace :: Annotate ast => Bool -> [GHC.Located ast] -> Annotated ()
+markListNoPrecedingSpace intercal ls =
+    case ls of
+      [] -> return ()
+      (l:ls') -> do
+        if intercal
+        then do
+          if null ls'
+            then setContext (Set.fromList [NoPrecedingSpace            ]) $ markLocated l
+            else setContext (Set.fromList [NoPrecedingSpace,Intercalate]) $ markLocated l
+          markListIntercalate ls'
+        else do
+          setContext (Set.singleton NoPrecedingSpace) $ markLocated l
+          mapM_ markLocated ls'
+
+-- ---------------------------------------------------------------------
+
+
+-- |Mark a list, with the given keyword as a list item separator
+markListIntercalate :: Annotate ast => [GHC.Located ast] -> Annotated ()
+markListIntercalate ls = markListIntercalateWithFun markLocated ls
+
+-- ---------------------------------------------------------------------
+
+markListWithContexts :: Annotate ast => Set.Set AstContext -> Set.Set AstContext -> [GHC.Located ast] -> Annotated ()
+markListWithContexts ctxInitial ctxRest ls =
+  case ls of
+    [] -> return ()
+    [x] -> setContextLevel ctxInitial 2 $ markLocated x
+    (x:xs) -> do
+      setContextLevel ctxInitial 2 $ markLocated x
+      setContextLevel ctxRest    2 $ mapM_ markLocated xs
+
+-- ---------------------------------------------------------------------
+
+-- Context for only if just one, else first item, middle ones, and last one
+markListWithContexts' :: Annotate ast
+                      => ListContexts
+                      -> [GHC.Located ast] -> Annotated ()
+markListWithContexts' (LC ctxOnly ctxInitial ctxMiddle ctxLast) ls =
+  case ls of
+    [] -> return ()
+    [x] -> setContextLevel ctxOnly level $ markLocated x
+    (x:xs) -> do
+      setContextLevel ctxInitial level $ markLocated x
+      go xs
+  where
+    level = 2
+    go []  = return ()
+    go [x] = setContextLevel ctxLast level $ markLocated x
+    go (x:xs) = do
+      setContextLevel ctxMiddle level $ markLocated x
+      go xs
+
+
+-- ---------------------------------------------------------------------
+
+markListWithLayout :: Annotate ast => [GHC.Located ast] -> Annotated ()
+markListWithLayout ls =
+  setLayoutFlag $ markList ls
+
+-- ---------------------------------------------------------------------
+
+markList :: Annotate ast => [GHC.Located ast] -> Annotated ()
+markList ls =
+  setContext (Set.singleton NoPrecedingSpace)
+   $ markListWithContexts' listContexts' ls
+
+markLocalBindsWithLayout :: GHC.HsLocalBinds GHC.GhcPs -> Annotated ()
+markLocalBindsWithLayout binds = markHsLocalBinds binds
+
+-- ---------------------------------------------------------------------
+
+-- |This function is used to get around shortcomings in the GHC AST for 7.10.1
+markLocatedFromKw :: (Annotate ast) => GHC.AnnKeywordId -> GHC.Located ast -> Annotated ()
+markLocatedFromKw kw (GHC.L l a) = do
+  -- Note: l is needed so that the pretty printer can make something up
+  ss <- getSrcSpanForKw l kw
+  AnnKey ss' _ <- storeOriginalSrcSpan l (mkAnnKey (GHC.L ss a))
+  markLocated (GHC.L ss' a)
+
+-- ---------------------------------------------------------------------
+
+markMaybe :: (Annotate ast) => Maybe (GHC.Located ast) -> Annotated ()
+markMaybe Nothing    = return ()
+markMaybe (Just ast) = markLocated ast
+
+-- ---------------------------------------------------------------------
+-- Managing lists which have been separated, e.g. Sigs and Binds
+
+prepareListAnnotation :: Annotate a => [GHC.Located a] -> [(GHC.SrcSpan,Annotated ())]
+prepareListAnnotation ls = map (\b -> (GHC.getLoc b,markLocated b)) ls
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsModule GHC.GhcPs) where
+  markAST _ (GHC.HsModule mmn mexp imps decs mdepr _haddock) = do
+
+    case mmn of
+      Nothing -> return ()
+      Just (GHC.L ln mn) -> do
+        mark GHC.AnnModule
+        markExternal ln GHC.AnnVal (GHC.moduleNameString mn)
+
+        forM_ mdepr markLocated
+        forM_ mexp markLocated
+
+        mark GHC.AnnWhere
+
+    markOptional GHC.AnnOpenC -- Possible '{'
+    markManyOptional GHC.AnnSemi -- possible leading semis
+    setContextLevel (Set.singleton TopLevel) 2 $ markListWithLayout imps
+
+    setContextLevel (Set.singleton TopLevel) 2 $ markListWithLayout decs
+
+    markOptional GHC.AnnCloseC -- Possible '}'
+
+    markEOF
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.WarningTxt where
+  markAST _ (GHC.WarningTxt (GHC.L _ txt) lss) = do
+    markAnnOpen txt "{-# WARNING"
+    mark GHC.AnnOpenS
+    markListIntercalate lss
+    mark GHC.AnnCloseS
+    markWithString GHC.AnnClose "#-}"
+
+  markAST _ (GHC.DeprecatedTxt (GHC.L _ txt) lss) = do
+    markAnnOpen txt "{-# DEPRECATED"
+    mark GHC.AnnOpenS
+    markListIntercalate lss
+    mark GHC.AnnCloseS
+    markWithString GHC.AnnClose "#-}"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.StringLiteral where
+  markAST l (GHC.StringLiteral src fs) = do
+    markExternalSourceText l src (show (GHC.unpackFS fs))
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.SourceText,GHC.FastString) where
+  markAST l (src,fs) = do
+    markExternalSourceText l src (show (GHC.unpackFS fs))
+
+-- ---------------------------------------------------------------------
+
+instance Annotate [GHC.LIE GHC.GhcPs] where
+   markAST _ ls = do
+     inContext (Set.singleton HasHiding) $ mark GHC.AnnHiding -- in an import decl
+     mark GHC.AnnOpenP -- '('
+     -- Can't use markListIntercalate, there can be trailing commas, but only in imports.
+     markListIntercalateWithFunLevel markLocated 2 ls
+
+     mark GHC.AnnCloseP -- ')'
+
+instance Annotate (GHC.IE GHC.GhcPs) where
+  markAST _ ie = do
+
+    case ie of
+        GHC.IEVar ln -> markLocated ln
+
+        GHC.IEThingAbs ln -> do
+          setContext (Set.singleton PrefixOp) $ markLocated ln
+
+        GHC.IEThingWith ln wc ns _lfs -> do
+          setContext (Set.singleton PrefixOp) $ markLocated ln
+          mark GHC.AnnOpenP
+          case wc of
+            GHC.NoIEWildcard ->
+              unsetContext Intercalate $ setContext (Set.fromList [PrefixOp])
+                $ markListIntercalate ns
+            GHC.IEWildcard n -> do
+              setContext (Set.fromList [PrefixOp,Intercalate])
+                $ mapM_ markLocated (take n ns)
+              mark GHC.AnnDotdot
+              case drop n ns of
+                [] -> return ()
+                ns' -> do
+                  mark GHC.AnnComma
+                  unsetContext Intercalate $ setContext (Set.fromList [PrefixOp])
+                    $ markListIntercalate ns'
+          mark GHC.AnnCloseP
+
+        (GHC.IEThingAll ln) -> do
+          setContext (Set.fromList [PrefixOp]) $ markLocated ln
+          mark GHC.AnnOpenP
+          mark GHC.AnnDotdot
+          mark GHC.AnnCloseP
+
+        (GHC.IEModuleContents (GHC.L lm mn)) -> do
+          mark GHC.AnnModule
+          markExternal lm GHC.AnnVal (GHC.moduleNameString mn)
+
+        -- Only used in Haddock mode so we can ignore them.
+        (GHC.IEGroup _ _) -> return ()
+
+        (GHC.IEDoc _)     -> return ()
+
+        (GHC.IEDocNamed _)    -> return ()
+    ifInContext (Set.fromList [Intercalate])
+      (mark         GHC.AnnComma)
+      (markOptional GHC.AnnComma)
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.IEWrappedName GHC.RdrName) where
+  markAST _ (GHC.IEName ln) = do
+    unsetContext Intercalate $ setContext (Set.fromList [PrefixOp])
+      $ markLocated ln
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+  markAST _ (GHC.IEPattern ln) = do
+    mark GHC.AnnPattern
+    setContext (Set.singleton PrefixOp) $ markLocated ln
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+  markAST _ (GHC.IEType ln) = do
+    mark GHC.AnnType
+    setContext (Set.singleton PrefixOp) $ markLocated ln
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+isSymRdr :: GHC.RdrName -> Bool
+isSymRdr n = GHC.isSymOcc (GHC.rdrNameOcc n) || rdrName2String n == "."
+
+instance Annotate GHC.RdrName where
+  markAST l n = do
+    let
+      str = rdrName2String n
+      isSym = isSymRdr n
+      canParen = isSym
+      doNormalRdrName = do
+        let str' = case str of
+              -- TODO: unicode support?
+                        "forall" -> if spanLength l == 1 then "∀" else str
+                        _ -> str
+
+        let
+          markParen :: GHC.AnnKeywordId -> Annotated ()
+          markParen pa = do
+            if canParen
+              then ifInContext (Set.singleton PrefixOp)
+                                       (mark         pa) -- '('
+                                       (markOptional pa)
+              else if isSym
+                then ifInContext (Set.singleton PrefixOpDollar)
+                       (mark pa)
+                       (markOptional pa)
+                else markOptional pa
+
+        markParen GHC.AnnOpenP
+        unless isSym $ inContext (Set.fromList [InfixOp]) $ markOffset GHC.AnnBackquote 0
+        cnt  <- countAnns GHC.AnnVal
+        case cnt of
+          0 -> markExternal l GHC.AnnVal str'
+          1 -> markWithString GHC.AnnVal str'
+          _ -> traceM $ "Printing RdrName, more than 1 AnnVal:" ++ showGhc (l,n)
+        unless isSym $ inContext (Set.fromList [InfixOp]) $ markOffset GHC.AnnBackquote 1
+        markParen GHC.AnnCloseP
+
+    case n of
+      GHC.Unqual _ -> doNormalRdrName
+      GHC.Qual _ _ -> doNormalRdrName
+      GHC.Orig _ _ -> if str == "~"
+                        then doNormalRdrName
+                        else markExternal l GHC.AnnVal str
+      GHC.Exact n'  -> do
+       case str of
+         -- Special handling for Exact RdrNames, which are built-in Names
+         "[]" -> do
+           mark GHC.AnnOpenS  -- '['
+           mark GHC.AnnCloseS -- ']'
+         "()" -> do
+           mark GHC.AnnOpenP  -- '('
+           mark GHC.AnnCloseP -- ')'
+         ('(':'#':_) -> do
+           markWithString GHC.AnnOpen  "(#" -- '(#'
+           let cnt = length $ filter (==',') str
+           replicateM_ cnt (mark GHC.AnnCommaTuple)
+           markWithString GHC.AnnClose  "#)"-- '#)'
+         "[::]" -> do
+           markWithString GHC.AnnOpen  "[:" -- '[:'
+           markWithString GHC.AnnClose ":]" -- ':]'
+         "(->)" -> do
+           mark GHC.AnnOpenP -- '('
+           mark GHC.AnnRarrow
+           mark GHC.AnnCloseP -- ')'
+         "~#"  -> do
+           mark GHC.AnnOpenP -- '('
+           mark GHC.AnnTildehsh
+           mark GHC.AnnCloseP
+         "*"  -> do
+           markExternal l GHC.AnnVal str
+         "★"  -> do -- Note: unicode star
+           markExternal l GHC.AnnVal str
+         ":"  -> do
+           -- Note: The OccName for ":" has the following attributes (via occAttributes)
+           -- (d, Data DataSym Sym Val )
+           -- consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
+           doNormalRdrName
+           -- trace ("RdrName.checking :" ++ (occAttributes $ GHC.occName n)) doNormalRdrName
+         ('(':',':_) -> do
+           mark GHC.AnnOpenP
+           let cnt = length $ filter (==',') str
+           replicateM_ cnt (mark GHC.AnnCommaTuple)
+           mark GHC.AnnCloseP -- ')'
+         _ -> do
+            let isSym' = isSymRdr  (GHC.nameRdrName n')
+            when isSym' $ mark GHC.AnnOpenP -- '('
+            markWithString GHC.AnnVal str
+            when isSym $ mark GHC.AnnCloseP -- ')'
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma `debug` ("AnnComma in RdrName")
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.ImportDecl GHC.GhcPs) where
+ markAST _ imp@(GHC.ImportDecl msrc modname mpkg _src safeflag qualFlag _impl _as hiding) = do
+
+   -- 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
+   mark GHC.AnnImport
+
+   -- "{-# SOURCE" and "#-}"
+   case msrc of
+     GHC.SourceText _txt -> do
+       markAnnOpen msrc "{-# SOURCE"
+       markWithString GHC.AnnClose "#-}"
+     GHC.NoSourceText -> return ()
+   when safeflag (mark GHC.AnnSafe)
+   when qualFlag (unsetContext TopLevel $ mark GHC.AnnQualified)
+   case mpkg of
+    Just (GHC.StringLiteral (GHC.SourceText srcPkg) _) ->
+      markWithString GHC.AnnPackageName srcPkg
+    _ -> return ()
+
+   markLocated modname
+
+   case GHC.ideclAs imp of
+      Nothing -> return ()
+      Just mn -> do
+          mark GHC.AnnAs
+          markLocated mn
+
+   case hiding of
+     Nothing -> return ()
+     Just (isHiding,lie) -> do
+       if isHiding
+         then setContext (Set.singleton HasHiding) $
+                markLocated lie
+         else markLocated lie
+   markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.ModuleName where
+   markAST l mname =
+    markExternal l GHC.AnnVal (GHC.moduleNameString mname)
+
+-- ---------------------------------------------------------------------
+
+markLHsDecl :: GHC.LHsDecl GHC.GhcPs -> Annotated ()
+markLHsDecl (GHC.L l decl) =
+    case decl of
+      GHC.TyClD d       -> markLocated (GHC.L l d)
+      GHC.InstD d       -> markLocated (GHC.L l d)
+      GHC.DerivD d      -> markLocated (GHC.L l d)
+      GHC.ValD d        -> markLocated (GHC.L l d)
+      GHC.SigD d        -> markLocated (GHC.L l d)
+      GHC.DefD d        -> markLocated (GHC.L l d)
+      GHC.ForD d        -> markLocated (GHC.L l d)
+      GHC.WarningD d    -> markLocated (GHC.L l d)
+      GHC.AnnD d        -> markLocated (GHC.L l d)
+      GHC.RuleD d       -> markLocated (GHC.L l d)
+      GHC.VectD d       -> markLocated (GHC.L l d)
+      GHC.SpliceD d     -> markLocated (GHC.L l d)
+      GHC.DocD d        -> markLocated (GHC.L l d)
+      GHC.RoleAnnotD d  -> markLocated (GHC.L l d)
+
+instance Annotate (GHC.HsDecl GHC.GhcPs) where
+  markAST l d = markLHsDecl (GHC.L l d)
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.RoleAnnotDecl GHC.GhcPs) where
+  markAST _ (GHC.RoleAnnotDecl ln mr) = do
+    mark GHC.AnnType
+    mark GHC.AnnRole
+    markLocated ln
+    mapM_ markLocated mr
+
+instance Annotate (Maybe GHC.Role) where
+  markAST l Nothing  = markExternal l GHC.AnnVal "_"
+  markAST l (Just r) = markExternal l GHC.AnnVal (GHC.unpackFS $ GHC.fsFromRole r)
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.SpliceDecl GHC.GhcPs) where
+  markAST _ (GHC.SpliceDecl e@(GHC.L _ (GHC.HsQuasiQuote{})) _flag) = do
+    markLocated e
+    markTrailingSemi
+  markAST _ (GHC.SpliceDecl e _flag) = do
+    markLocated e
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.VectDecl GHC.GhcPs) where
+  markAST _ (GHC.HsVect src ln e) = do
+    markAnnOpen src "{-# VECTORISE"
+    markLocated ln
+    mark GHC.AnnEqual
+    markLocated e
+    markWithString GHC.AnnClose "#-}" -- "#-}"
+
+  markAST _ (GHC.HsNoVect src ln) = do
+    markAnnOpen src "{-# NOVECTORISE"
+    markLocated ln
+    markWithString GHC.AnnClose "#-}" -- "#-}"
+
+  markAST _ (GHC.HsVectTypeIn src _b ln mln) = do
+    markAnnOpen src  "{-# VECTORISE"  -- or "{-# VECTORISE SCALAR"
+    mark GHC.AnnType
+    markLocated ln
+    case mln of
+      Nothing -> return ()
+      Just lnn -> do
+        mark GHC.AnnEqual
+        markLocated lnn
+    markWithString GHC.AnnClose "#-}" -- "#-}"
+
+  markAST _ GHC.HsVectTypeOut {} =
+    traceM "warning: HsVectTypeOut appears after renaming"
+
+  markAST _ (GHC.HsVectClassIn src ln) = do
+    markAnnOpen src "{-# VECTORISE"
+    mark GHC.AnnClass
+    markLocated ln
+    markWithString GHC.AnnClose "#-}" -- "#-}"
+
+  markAST _ GHC.HsVectClassOut {} =
+    traceM "warning: HsVecClassOut appears after renaming"
+  markAST _ GHC.HsVectInstIn {}   =
+    traceM "warning: HsVecInstsIn appears after renaming"
+  markAST _ GHC.HsVectInstOut {}   =
+    traceM "warning: HsVecInstOut appears after renaming"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.RuleDecls GHC.GhcPs) where
+   markAST _ (GHC.HsRules src rules) = do
+     markAnnOpen src "{-# RULES"
+     setLayoutFlag $ markListIntercalateWithFunLevel markLocated 2 rules
+     markWithString GHC.AnnClose "#-}"
+     markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.RuleDecl GHC.GhcPs) where
+  markAST l (GHC.HsRule ln act bndrs lhs _ rhs _) = do
+    markLocated ln
+    setContext (Set.singleton ExplicitNeverActive) $ markActivation l act
+
+    unless (null bndrs) $ do
+      mark GHC.AnnForall
+      mapM_ markLocated bndrs
+      mark GHC.AnnDot
+
+    markLocated lhs
+    mark GHC.AnnEqual
+    markLocated rhs
+    inContext (Set.singleton Intercalate) $ mark GHC.AnnSemi
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+markActivation :: GHC.SrcSpan -> GHC.Activation -> Annotated ()
+markActivation _ act = do
+  case act of
+    GHC.ActiveBefore src phase -> do
+      mark GHC.AnnOpenS --  '['
+      mark GHC.AnnTilde -- ~
+      markSourceText src (show phase)
+      mark GHC.AnnCloseS -- ']'
+    GHC.ActiveAfter src phase -> do
+      mark GHC.AnnOpenS --  '['
+      markSourceText src (show phase)
+      mark GHC.AnnCloseS -- ']'
+    GHC.NeverActive -> do
+      inContext (Set.singleton ExplicitNeverActive) $ do
+        mark GHC.AnnOpenS --  '['
+        mark GHC.AnnTilde -- ~
+        mark GHC.AnnCloseS -- ']'
+    _ -> return ()
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.RuleBndr GHC.GhcPs) where
+  markAST _ (GHC.RuleBndr ln) = markLocated ln
+  markAST _ (GHC.RuleBndrSig ln st) = do
+    mark GHC.AnnOpenP -- "("
+    markLocated ln
+    mark GHC.AnnDcolon
+    markLHsSigWcType st
+    mark GHC.AnnCloseP -- ")"
+
+-- ---------------------------------------------------------------------
+
+markLHsSigWcType :: GHC.LHsSigWcType GHC.GhcPs -> Annotated ()
+markLHsSigWcType (GHC.HsWC _ (GHC.HsIB _ ty _)) = do
+  markLocated ty
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.AnnDecl GHC.GhcPs) where
+   markAST _ (GHC.HsAnnotation src prov e) = do
+     markAnnOpen src "{-# ANN"
+     case prov of
+       (GHC.ValueAnnProvenance n) -> markLocated n
+       (GHC.TypeAnnProvenance n) -> do
+         mark GHC.AnnType
+         markLocated n
+       GHC.ModuleAnnProvenance -> mark GHC.AnnModule
+
+     markLocated e
+     markWithString GHC.AnnClose "#-}"
+     markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.WarnDecls GHC.GhcPs) where
+   markAST _ (GHC.Warnings src warns) = do
+     markAnnOpen src "{-# WARNING" -- Note: might be {-# DEPRECATED
+     mapM_ markLocated warns
+     markWithString GHC.AnnClose "#-}"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.WarnDecl GHC.GhcPs) where
+   markAST _ (GHC.Warning lns txt) = do
+     markListIntercalate lns
+     mark GHC.AnnOpenS -- "["
+     case txt of
+       GHC.WarningTxt    _src ls -> markListIntercalate ls
+       GHC.DeprecatedTxt _src ls -> markListIntercalate ls
+     mark GHC.AnnCloseS -- "]"
+
+instance Annotate GHC.FastString where
+  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.
+  markAST l fs = do
+    markExternal l GHC.AnnVal (show (GHC.unpackFS fs))
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.ForeignDecl GHC.GhcPs) where
+  markAST _ (GHC.ForeignImport ln (GHC.HsIB _ typ _) _
+               (GHC.CImport cconv safety@(GHC.L ll _) _mh _imp (GHC.L ls src))) = do
+    mark GHC.AnnForeign
+    mark GHC.AnnImport
+    markLocated cconv
+    unless (ll == GHC.noSrcSpan) $ markLocated safety
+    markExternalSourceText ls src ""
+    markLocated ln
+    mark GHC.AnnDcolon
+    markLocated typ
+    markTrailingSemi
+
+
+  markAST _l (GHC.ForeignExport ln (GHC.HsIB _ typ _) _ (GHC.CExport spec (GHC.L ls src))) = do
+    mark GHC.AnnForeign
+    mark GHC.AnnExport
+    markLocated spec
+    markExternal ls GHC.AnnVal (sourceTextToString src "")
+    setContext (Set.singleton PrefixOp) $ markLocated ln
+    mark GHC.AnnDcolon
+    markLocated typ
+
+
+-- ---------------------------------------------------------------------
+
+instance (Annotate GHC.CExportSpec) where
+  markAST l (GHC.CExportStatic _src _ cconv) = markAST l cconv
+
+-- ---------------------------------------------------------------------
+
+instance (Annotate GHC.CCallConv) where
+  markAST l GHC.StdCallConv        =  markExternal l GHC.AnnVal "stdcall"
+  markAST l GHC.CCallConv          =  markExternal l GHC.AnnVal "ccall"
+  markAST l GHC.CApiConv           =  markExternal l GHC.AnnVal "capi"
+  markAST l GHC.PrimCallConv       =  markExternal l GHC.AnnVal "prim"
+  markAST l GHC.JavaScriptCallConv =  markExternal l GHC.AnnVal "javascript"
+
+-- ---------------------------------------------------------------------
+
+instance (Annotate GHC.Safety) where
+  markAST l GHC.PlayRisky         = markExternal l GHC.AnnVal "unsafe"
+  markAST l GHC.PlaySafe          = markExternal l GHC.AnnVal "safe"
+  markAST l GHC.PlayInterruptible = markExternal l GHC.AnnVal "interruptible"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.DerivDecl GHC.GhcPs) where
+
+  markAST _ (GHC.DerivDecl typ ms mov) = do
+    mark GHC.AnnDeriving
+    markMaybe ms
+    mark GHC.AnnInstance
+    markMaybe mov
+    markLHsSigType typ
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.DerivStrategy where
+
+  markAST _ GHC.StockStrategy    = mark GHC.AnnStock
+  markAST _ GHC.AnyclassStrategy = mark GHC.AnnAnyclass
+  markAST _ GHC.NewtypeStrategy  = mark GHC.AnnNewtype
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.DefaultDecl GHC.GhcPs) where
+
+  markAST _ (GHC.DefaultDecl typs) = do
+    mark GHC.AnnDefault
+    mark GHC.AnnOpenP -- '('
+    markListIntercalate typs
+    mark GHC.AnnCloseP -- ')'
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.InstDecl GHC.GhcPs) where
+
+  markAST l (GHC.ClsInstD      cid) = markAST l  cid
+  markAST l (GHC.DataFamInstD dfid) = markAST l dfid
+  markAST l (GHC.TyFamInstD   tfid) = markAST l tfid
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.OverlapMode where
+
+  -- NOTE: NoOverlap is only used in the typechecker
+  markAST _ (GHC.NoOverlap src) = do
+    markAnnOpen src "{-# NO_OVERLAP"
+    markWithString GHC.AnnClose "#-}"
+
+  markAST _ (GHC.Overlappable src) = do
+    markAnnOpen src "{-# OVERLAPPABLE"
+    markWithString GHC.AnnClose "#-}"
+
+  markAST _ (GHC.Overlapping src) = do
+    markAnnOpen src "{-# OVERLAPPING"
+    markWithString GHC.AnnClose "#-}"
+
+  markAST _ (GHC.Overlaps src) = do
+    markAnnOpen src "{-# OVERLAPS"
+    markWithString GHC.AnnClose "#-}"
+
+  markAST _ (GHC.Incoherent src) = do
+    markAnnOpen src "{-# INCOHERENT"
+    markWithString GHC.AnnClose "#-}"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.ClsInstDecl GHC.GhcPs) where
+
+  markAST _ (GHC.ClsInstDecl (GHC.HsIB _ poly _) binds sigs tyfams datafams mov) = do
+    mark GHC.AnnInstance
+    markMaybe mov
+    markLocated poly
+    mark GHC.AnnWhere
+    markOptional GHC.AnnOpenC -- '{'
+    markInside GHC.AnnSemi
+
+    applyListAnnotationsLayout (prepareListAnnotation (GHC.bagToList binds)
+                             ++ prepareListAnnotation sigs
+                             ++ prepareListAnnotation tyfams
+                             ++ prepareListAnnotation datafams
+                               )
+
+    markOptional GHC.AnnCloseC -- '}'
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.TyFamInstDecl GHC.GhcPs) where
+
+  markAST _ (GHC.TyFamInstDecl (GHC.HsIB _ eqn _)) = do
+    mark GHC.AnnType
+    mark GHC.AnnInstance -- Note: this keyword is optional
+    markFamEqn eqn
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+markFamEqn :: (GHC.HasOccName (GHC.IdP pass),
+               Annotate (GHC.IdP pass), Annotate ast1, Annotate ast2)
+           => GHC.FamEqn pass [GHC.Located ast1] (GHC.Located ast2)
+                    -> Annotated ()
+markFamEqn (GHC.FamEqn ln pats fixity rhs) = do
+  markTyClass fixity ln pats
+  mark GHC.AnnEqual
+  markLocated rhs
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.DataFamInstDecl GHC.GhcPs) where
+
+  markAST l (GHC.DataFamInstDecl (GHC.HsIB _ (GHC.FamEqn ln pats fixity
+             defn@(GHC.HsDataDefn nd ctx typ _mk cons mderivs) ) _ )) = do
+    case GHC.dd_ND defn of
+      GHC.NewType  -> mark GHC.AnnNewtype
+      GHC.DataType -> mark GHC.AnnData
+    mark GHC.AnnInstance
+
+    markLocated ctx
+
+    markTyClass fixity ln pats
+
+    case (GHC.dd_kindSig defn) of
+      Just s -> do
+        mark GHC.AnnDcolon
+        markLocated s
+      Nothing -> return ()
+    if isGadt $ GHC.dd_cons defn
+      then mark GHC.AnnWhere
+      else mark GHC.AnnEqual
+    markDataDefn l (GHC.HsDataDefn nd (GHC.noLoc []) typ _mk cons mderivs)
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsBind GHC.GhcPs) where
+  markAST _ (GHC.FunBind _ (GHC.MG (GHC.L _ matches) _ _ _) _ _ _) = do
+    -- Note: from a layout perspective a FunBind should not exist, so the
+    -- current context is passed through unchanged to the matches.
+    -- TODO: perhaps bring the edp from the first match up to the annotation for
+    -- the FunBind.
+    let
+      tlFun =
+        ifInContext (Set.fromList [CtxOnly,CtxFirst])
+          (markListWithContexts' listContexts matches)
+          (markListWithContexts (lcMiddle listContexts) (lcLast listContexts) matches)
+    ifInContext (Set.singleton TopLevel)
+      (setContextLevel (Set.singleton TopLevel) 2 tlFun)
+      tlFun
+
+  -- -----------------------------------
+
+  markAST _ (GHC.PatBind lhs (GHC.GRHSs grhs (GHC.L _ lb)) _typ _fvs _ticks) = do
+    markLocated lhs
+    case grhs of
+      (GHC.L _ (GHC.GRHS [] _):_) -> mark GHC.AnnEqual -- empty guards
+      _ -> return ()
+    markListIntercalateWithFunLevel markLocated 2 grhs
+
+    -- TODO: extract this common code
+    case lb of
+      GHC.EmptyLocalBinds -> return ()
+      _ -> do
+        mark GHC.AnnWhere
+        markOptional GHC.AnnOpenC -- '{'
+        markInside GHC.AnnSemi
+        markLocalBindsWithLayout lb
+        markOptional GHC.AnnCloseC -- '}'
+    markTrailingSemi
+
+  -- -----------------------------------
+
+  markAST _ (GHC.VarBind _n rhse _) =
+    -- Note: this bind is introduced by the typechecker
+    markLocated rhse
+
+  -- -----------------------------------
+
+  -- Introduced after renaming.
+  markAST _ (GHC.AbsBinds {}) =
+    traceM "warning: AbsBinds introduced after renaming"
+
+  -- -----------------------------------
+
+  markAST l (GHC.PatSynBind (GHC.PSB ln _fvs args def dir)) = do
+    mark GHC.AnnPattern
+    case args of
+      GHC.InfixCon la lb -> do
+        markLocated la
+        setContext (Set.singleton InfixOp) $ markLocated ln
+        markLocated lb
+      GHC.PrefixCon ns -> do
+        markLocated ln
+        mapM_ markLocated ns
+      GHC.RecCon fs -> do
+        markLocated ln
+        mark GHC.AnnOpenC  -- '{'
+        markListIntercalateWithFun (markLocated . GHC.recordPatSynSelectorId) fs
+        mark GHC.AnnCloseC -- '}'
+    case dir of
+      GHC.ImplicitBidirectional -> mark GHC.AnnEqual
+      _                         -> mark GHC.AnnLarrow
+
+    markLocated def
+    case dir of
+      GHC.Unidirectional           -> return ()
+      GHC.ImplicitBidirectional    -> return ()
+      GHC.ExplicitBidirectional mg -> do
+        mark GHC.AnnWhere
+        mark GHC.AnnOpenC  -- '{'
+        markMatchGroup l mg
+        mark GHC.AnnCloseC -- '}'
+
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.IPBind GHC.GhcPs) where
+  markAST _ (GHC.IPBind en e) = do
+    case en of
+      Left n   -> markLocated n
+      Right _i -> return ()
+    mark GHC.AnnEqual
+    markLocated e
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.HsIPName where
+  markAST l (GHC.HsIPName n) = markExternal l GHC.AnnVal ("?" ++ GHC.unpackFS n)
+
+-- ---------------------------------------------------------------------
+
+instance (Annotate body)
+  => Annotate (GHC.Match GHC.GhcPs (GHC.Located body)) where
+
+  markAST _ (GHC.Match mln pats (GHC.GRHSs grhs (GHC.L _ lb))) = do
+    let
+      get_infix (GHC.FunRhs _ f _) = f
+      get_infix _                  = GHC.Prefix
+
+      isFunBind GHC.FunRhs{} = True
+      isFunBind _            = False
+    case (get_infix mln,pats) of
+      (GHC.Infix, a:b:xs) -> do
+        if null xs
+          then markOptional GHC.AnnOpenP
+          else mark         GHC.AnnOpenP
+        markLocated a
+        case mln of
+          GHC.FunRhs n _ _ -> setContext (Set.singleton InfixOp) $ markLocated n
+          _              -> return ()
+        markLocated b
+        if null xs
+         then markOptional GHC.AnnCloseP
+         else mark         GHC.AnnCloseP
+        mapM_ markLocated xs
+      _ -> do
+        annotationsToComments [GHC.AnnOpenP,GHC.AnnCloseP]
+        inContext (Set.fromList [LambdaExpr]) $ do mark GHC.AnnLam -- For HsLam
+        case mln of
+          GHC.FunRhs n _ s -> do
+            setContext (Set.fromList [NoPrecedingSpace,PrefixOp]) $ do
+              when (s == GHC.SrcStrict) $ mark GHC.AnnBang
+              markLocated n
+            mapM_ markLocated pats
+          _  -> markListNoPrecedingSpace False pats
+
+    -- TODO: The AnnEqual annotation actually belongs in the first GRHS value
+    case grhs of
+      (GHC.L _ (GHC.GRHS [] _):_) -> when (isFunBind mln) $ mark GHC.AnnEqual -- empty guards
+      _ -> return ()
+    inContext (Set.fromList [LambdaExpr]) $ mark GHC.AnnRarrow -- For HsLam
+    mapM_ markLocated grhs
+
+    case lb of
+      GHC.EmptyLocalBinds -> return ()
+      _ -> do
+        mark GHC.AnnWhere
+        markOptional GHC.AnnOpenC -- '{'
+        markInside GHC.AnnSemi
+        markLocalBindsWithLayout lb
+        markOptional GHC.AnnCloseC -- '}'
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance (Annotate body)
+  => Annotate (GHC.GRHS GHC.GhcPs (GHC.Located body)) where
+  markAST _ (GHC.GRHS guards expr) = do
+    case guards of
+      [] -> return ()
+      (_:_) -> do
+        mark GHC.AnnVbar
+        unsetContext Intercalate $ setContext (Set.fromList [LeftMost,PrefixOp])
+          $ markListIntercalate guards
+        ifInContext (Set.fromList [CaseAlt])
+          (return ())
+          (mark GHC.AnnEqual)
+
+    markOptional GHC.AnnEqual -- For apply-refact Structure8.hs test
+
+    inContext (Set.fromList [CaseAlt]) $ mark GHC.AnnRarrow -- For HsLam
+    setContextLevel (Set.fromList [LeftMost,PrefixOp]) 2 $ markLocated expr
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.Sig GHC.GhcPs) where
+
+  markAST _ (GHC.TypeSig lns st)  = do
+    setContext (Set.singleton PrefixOp) $ markListNoPrecedingSpace True lns
+    mark GHC.AnnDcolon
+    markLHsSigWcType st
+    markTrailingSemi
+    tellContext (Set.singleton FollowingLine)
+
+  markAST _ (GHC.PatSynSig lns (GHC.HsIB _ typ _)) = do
+    mark GHC.AnnPattern
+    markListIntercalate lns
+    mark GHC.AnnDcolon
+    markLocated typ
+    markTrailingSemi
+
+  markAST _ (GHC.ClassOpSig isDefault ns (GHC.HsIB _ typ _)) = do
+    when isDefault $ mark GHC.AnnDefault
+    setContext (Set.singleton PrefixOp) $ markListIntercalate ns
+    mark GHC.AnnDcolon
+    markLocated typ
+    markTrailingSemi
+
+  markAST _ (GHC.IdSig _) =
+    traceM "warning: Introduced after renaming"
+
+  markAST _ (GHC.FixSig (GHC.FixitySig lns (GHC.Fixity src v fdir))) = do
+    let fixstr = case fdir of
+         GHC.InfixL -> "infixl"
+         GHC.InfixR -> "infixr"
+         GHC.InfixN -> "infix"
+    markWithString GHC.AnnInfix fixstr
+    markSourceText src (show v)
+    setContext (Set.singleton InfixOp) $ markListIntercalate lns
+    markTrailingSemi
+
+  markAST l (GHC.InlineSig ln inl) = do
+    markAnnOpen (GHC.inl_src inl) "{-# INLINE"
+    markActivation l (GHC.inl_act inl)
+    setContext (Set.singleton PrefixOp) $ markLocated ln
+    markWithString GHC.AnnClose "#-}" -- '#-}'
+    markTrailingSemi
+
+  markAST l (GHC.SpecSig ln typs inl) = do
+    markAnnOpen (GHC.inl_src inl) "{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE
+    markActivation l (GHC.inl_act inl)
+    markLocated ln
+    mark GHC.AnnDcolon -- '::'
+    markListIntercalateWithFunLevel markLHsSigType 2 typs
+    markWithString GHC.AnnClose "#-}" -- '#-}'
+    markTrailingSemi
+
+
+  markAST _ (GHC.SpecInstSig src typ) = do
+    markAnnOpen src "{-# SPECIALISE"
+    mark GHC.AnnInstance
+    markLHsSigType typ
+    markWithString GHC.AnnClose "#-}" -- '#-}'
+    markTrailingSemi
+
+
+  markAST _ (GHC.MinimalSig src formula) = do
+    markAnnOpen src "{-# MINIMAL"
+    markLocated formula
+    markWithString GHC.AnnClose "#-}"
+    markTrailingSemi
+
+  markAST _ (GHC.SCCFunSig src ln ml) = do
+    markAnnOpen src "{-# SCC"
+    markLocated ln
+    markMaybe ml
+    markWithString GHC.AnnClose "#-}"
+    markTrailingSemi
+
+  markAST _ (GHC.CompleteMatchSig src (GHC.L _ ns) mlns) = do
+    markAnnOpen src "{-# COMPLETE"
+    markListIntercalate ns
+    case mlns of
+      Nothing -> return ()
+      Just _ -> do
+        mark GHC.AnnDcolon
+        markMaybe mlns
+    markWithString GHC.AnnClose "#-}" -- '#-}'
+    markTrailingSemi
+
+-- --------------------------------------------------------------------
+
+markLHsSigType :: GHC.LHsSigType GHC.GhcPs -> Annotated ()
+markLHsSigType (GHC.HsIB _ typ _) = markLocated typ
+
+instance Annotate [GHC.LHsSigType GHC.GhcPs] where
+  markAST _ ls = do
+    mark GHC.AnnDeriving
+    -- Mote: a single item in parens is parsed as a HsAppsTy. Without parens it
+    -- is a HsTyVar. So for round trip pretty printing we need to take this into
+    -- account.
+    case ls of
+      []  -> markManyOptional GHC.AnnOpenP
+      [GHC.HsIB _ (GHC.L _ GHC.HsAppsTy{}) _] -> markMany GHC.AnnOpenP
+      [_] -> markManyOptional GHC.AnnOpenP
+      _   -> markMany         GHC.AnnOpenP
+    markListIntercalateWithFun markLHsSigType ls
+    case ls of
+      []  -> markManyOptional GHC.AnnCloseP
+      [GHC.HsIB _ (GHC.L _ GHC.HsAppsTy{}) _] -> markMany GHC.AnnCloseP
+      [_] -> markManyOptional GHC.AnnCloseP
+      _   -> markMany         GHC.AnnCloseP
+
+-- --------------------------------------------------------------------
+
+instance  (Annotate name) => Annotate (GHC.BooleanFormula (GHC.Located name)) where
+  markAST _ (GHC.Var x)  = do
+    setContext (Set.singleton PrefixOp) $ markLocated x
+    inContext (Set.fromList [AddVbar]) $ mark GHC.AnnVbar
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+  markAST _ (GHC.Or ls)  = markListIntercalateWithFunLevelCtx markLocated 2 AddVbar ls
+  markAST _ (GHC.And ls) = do
+    markListIntercalateWithFunLevel markLocated 2 ls
+    inContext (Set.fromList [AddVbar]) $ mark GHC.AnnVbar
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+  markAST _ (GHC.Parens x)  = do
+    mark GHC.AnnOpenP -- '('
+    markLocated x
+    mark GHC.AnnCloseP -- ')'
+    inContext (Set.fromList [AddVbar]) $ mark GHC.AnnVbar
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsTyVarBndr GHC.GhcPs) where
+  markAST _l (GHC.UserTyVar n) = do
+    markLocated n
+
+  markAST _ (GHC.KindedTyVar n ty) = do
+    mark GHC.AnnOpenP  -- '('
+    markLocated n
+    mark GHC.AnnDcolon -- '::'
+    markLocated ty
+    mark GHC.AnnCloseP -- '('
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsType GHC.GhcPs) where
+  markAST loc ty = do
+    markType loc ty
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+   where
+
+    -- markType :: GHC.SrcSpan -> ast -> Annotated ()
+    markType _ (GHC.HsForAllTy tvs typ) = do
+      mark GHC.AnnForall
+      mapM_ markLocated tvs
+      mark GHC.AnnDot
+      markLocated typ
+
+    markType _ (GHC.HsQualTy cxt typ) = do
+      markLocated cxt
+      markLocated typ
+
+    markType _ (GHC.HsTyVar promoted name) = do
+      when (promoted == GHC.Promoted) $ mark GHC.AnnSimpleQuote
+      markLocated name
+
+    markType _ (GHC.HsAppsTy ts) = do
+      mapM_ markLocated ts
+      inContext (Set.fromList [AddVbar]) $ mark GHC.AnnVbar
+
+    markType _ (GHC.HsAppTy t1 t2) = do
+      setContext (Set.singleton PrefixOp) $ markLocated t1
+      markLocated t2
+
+    markType _ (GHC.HsFunTy t1 t2) = do
+      markLocated t1
+      mark GHC.AnnRarrow
+      markLocated t2
+
+    markType _ (GHC.HsListTy t) = do
+      mark GHC.AnnOpenS -- '['
+      markLocated t
+      mark GHC.AnnCloseS -- ']'
+
+    markType _ (GHC.HsPArrTy t) = do
+      markWithString GHC.AnnOpen "[:" -- '[:'
+      markLocated t
+      markWithString GHC.AnnClose ":]" -- ':]'
+
+    markType _ (GHC.HsTupleTy tt ts) = do
+      case tt  of
+        GHC.HsBoxedOrConstraintTuple -> mark GHC.AnnOpenP  -- '('
+        _                            -> markWithString GHC.AnnOpen "(#" -- '(#'
+      markListIntercalateWithFunLevel markLocated 2 ts
+      case tt  of
+        GHC.HsBoxedOrConstraintTuple -> mark GHC.AnnCloseP  -- ')'
+        _                            -> markWithString GHC.AnnClose "#)" -- '#)'
+
+    markType _ (GHC.HsSumTy tys) = do
+      markWithString GHC.AnnOpen "(#"
+      markListIntercalateWithFunLevelCtx markLocated 2 AddVbar tys
+      markWithString GHC.AnnClose "#)"
+
+    markType _ (GHC.HsOpTy t1 lo t2) = do
+      markLocated t1
+      if (GHC.isTcOcc $ GHC.occName $ GHC.unLoc lo)
+        then do
+          markOptional GHC.AnnSimpleQuote
+        else do
+          mark GHC.AnnSimpleQuote
+      unsetContext PrefixOp $ setContext (Set.singleton InfixOp) $ markLocated lo
+      markLocated t2
+
+    markType _ (GHC.HsParTy t) = do
+      mark GHC.AnnOpenP  -- '('
+      markLocated t
+      mark GHC.AnnCloseP -- ')'
+
+    markType _ (GHC.HsIParamTy n t) = do
+      markLocated n
+      mark GHC.AnnDcolon
+      markLocated t
+
+    markType _ (GHC.HsEqTy t1 t2) = do
+      markLocated t1
+      mark GHC.AnnTilde
+      markLocated t2
+
+    markType _ (GHC.HsKindSig t k) = do
+      mark GHC.AnnOpenP  -- '('
+      markLocated t
+      mark GHC.AnnDcolon -- '::'
+      markLocated k
+      mark GHC.AnnCloseP -- ')'
+
+    markType l (GHC.HsSpliceTy s _) = do
+      markAST l s
+
+    markType _ (GHC.HsDocTy t ds) = do
+      markLocated t
+      markLocated ds
+
+    markType _ (GHC.HsBangTy (GHC.HsSrcBang mt _up str) t) = do
+      case mt of
+        GHC.NoSourceText -> return ()
+        GHC.SourceText src -> do
+          markWithString GHC.AnnOpen src
+          markWithString GHC.AnnClose "#-}"
+      case str of
+        GHC.SrcLazy     -> mark GHC.AnnTilde
+        GHC.SrcStrict   -> mark GHC.AnnBang
+        GHC.NoSrcStrict -> return ()
+
+      markLocated t
+
+    markType _ (GHC.HsRecTy cons) = do
+      mark GHC.AnnOpenC  -- '{'
+      markListIntercalate cons
+      mark GHC.AnnCloseC -- '}'
+
+    markType _ (GHC.HsCoreTy _t) =
+      traceM "warning: HsCoreTy Introduced after renaming"
+
+    markType _ (GHC.HsExplicitListTy promoted _ ts) = do
+      when (promoted == GHC.Promoted) $ mark GHC.AnnSimpleQuote
+      mark GHC.AnnOpenS  -- "["
+      markListIntercalate ts
+      mark GHC.AnnCloseS -- ']'
+
+    markType _ (GHC.HsExplicitTupleTy _ ts) = do
+      mark GHC.AnnSimpleQuote
+      mark GHC.AnnOpenP
+      markListIntercalate ts
+      mark GHC.AnnCloseP
+
+    markType l (GHC.HsTyLit lit) = do
+      case lit of
+        (GHC.HsNumTy s v) ->
+          markExternalSourceText l s (show v)
+        (GHC.HsStrTy s v) ->
+          markExternalSourceText l s (show v)
+
+    markType l (GHC.HsWildCardTy (GHC.AnonWildCard _)) = do
+      markExternal l GHC.AnnVal "_"
+
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsAppType GHC.GhcPs) where
+  markAST _ (GHC.HsAppInfix n)  = do
+    when (GHC.isDataOcc $ GHC.occName $ GHC.unLoc n) $ mark GHC.AnnSimpleQuote
+    setContext (Set.singleton InfixOp) $ markLocated n
+  markAST _ (GHC.HsAppPrefix t) = do
+    markOptional GHC.AnnTilde
+    setContext (Set.singleton PrefixOp) $ markLocated t
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsSplice GHC.GhcPs) where
+  markAST l c =
+    case c of
+      GHC.HsQuasiQuote _ n _pos fs -> do
+        markExternal l GHC.AnnVal
+              -- Note: Lexer.x does not provide unicode alternative. 2017-02-26
+              ("[" ++ (showGhc n) ++ "|" ++ (GHC.unpackFS fs) ++ "|]")
+
+      GHC.HsTypedSplice hasParens _n b@(GHC.L _ (GHC.HsVar (GHC.L _ n)))  -> do
+        when (hasParens == GHC.HasParens) $ mark GHC.AnnOpenPTE
+        if (hasParens == GHC.HasDollar)
+          then markWithString GHC.AnnThIdTySplice ("$$" ++ (GHC.occNameString (GHC.occName n)))
+          else markLocated b
+        when (hasParens == GHC.HasParens) $ mark GHC.AnnCloseP
+
+      GHC.HsTypedSplice hasParens _n b -> do
+        when (hasParens == GHC.HasParens) $ mark GHC.AnnOpenPTE
+        markLocated b
+        when (hasParens == GHC.HasParens) $ mark GHC.AnnCloseP
+
+      -- -------------------------------
+
+      GHC.HsUntypedSplice hasParens _n b@(GHC.L _ (GHC.HsVar (GHC.L _ n)))  -> do
+        when (hasParens == GHC.HasParens) $  mark GHC.AnnOpenPE
+        if (hasParens == GHC.HasDollar)
+          then markWithString GHC.AnnThIdSplice ("$" ++ (GHC.occNameString (GHC.occName n)))
+          else markLocated b
+        when (hasParens == GHC.HasParens) $ mark GHC.AnnCloseP
+
+      GHC.HsUntypedSplice hasParens _n b  -> do
+        case hasParens of
+          GHC.HasParens -> mark GHC.AnnOpenPE
+          GHC.HasDollar -> mark GHC.AnnThIdSplice
+          GHC.NoParens  -> return ()
+        markLocated b
+        when (hasParens == GHC.HasParens) $ mark GHC.AnnCloseP
+
+      GHC.HsSpliced{} -> error "HsSpliced only exists between renamer and typechecker in GHC"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.ConDeclField GHC.GhcPs) where
+  markAST _ (GHC.ConDeclField ns ty mdoc) = do
+    unsetContext Intercalate $ do
+      markListIntercalate ns
+      mark GHC.AnnDcolon
+      markLocated ty
+      markMaybe mdoc
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance (GHC.DataId name)
+      => Annotate (GHC.FieldOcc name) where
+  markAST _ (GHC.FieldOcc rn _) = do
+    markLocated rn
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.HsDocString where
+  markAST l (GHC.HsDocString s) = do
+    markExternal l GHC.AnnVal (GHC.unpackFS s)
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.Pat GHC.GhcPs) where
+  markAST loc typ = do
+    markPat loc typ
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma `debug` ("AnnComma in Pat")
+    where
+      markPat l (GHC.WildPat _) = markExternal l GHC.AnnVal "_"
+      markPat l (GHC.VarPat n)  = do
+        -- The parser inserts a placeholder value for a record pun rhs. This must be
+        -- filtered out until https://ghc.haskell.org/trac/ghc/ticket/12224 is
+        -- resolved, particularly for pretty printing where annotations are added.
+        let pun_RDR = "pun-right-hand-side"
+        when (showGhc n /= pun_RDR) $
+          unsetContext Intercalate $ setContext (Set.singleton PrefixOp) $ markAST l (GHC.unLoc n)
+      markPat _ (GHC.LazyPat p) = do
+        mark GHC.AnnTilde
+        markLocated p
+
+      markPat _ (GHC.AsPat ln p) = do
+        markLocated ln
+        mark GHC.AnnAt
+        markLocated p
+
+      markPat _ (GHC.ParPat p) = do
+        mark GHC.AnnOpenP
+        markLocated p
+        mark GHC.AnnCloseP
+
+      markPat _ (GHC.BangPat p) = do
+        mark GHC.AnnBang
+        markLocated p
+
+      markPat _ (GHC.ListPat ps _ _) = do
+        mark GHC.AnnOpenS
+        markListIntercalateWithFunLevel markLocated 2 ps
+        mark GHC.AnnCloseS
+
+      markPat _ (GHC.TuplePat pats b _) = do
+        if b == GHC.Boxed then mark GHC.AnnOpenP
+                          else markWithString GHC.AnnOpen "(#"
+        markListIntercalateWithFunLevel markLocated 2 pats
+        if b == GHC.Boxed then mark GHC.AnnCloseP
+                          else markWithString GHC.AnnClose "#)"
+
+      markPat _ (GHC.SumPat pat alt arity _) = do
+        markWithString GHC.AnnOpen "(#"
+        replicateM_ (alt - 1) $ mark GHC.AnnVbar
+        markLocated pat
+        replicateM_ (arity - alt) $ mark GHC.AnnVbar
+        markWithString GHC.AnnClose "#)"
+
+      markPat _ (GHC.PArrPat ps _) = do
+        markWithString GHC.AnnOpen "[:"
+        mapM_ markLocated ps
+        markWithString GHC.AnnClose ":]"
+
+      markPat _ (GHC.ConPatIn n dets) = do
+        markHsConPatDetails n dets
+
+      markPat _ GHC.ConPatOut {} =
+        traceM "warning: ConPatOut Introduced after renaming"
+
+      markPat _ (GHC.ViewPat e pat _) = do
+        markLocated e
+        mark GHC.AnnRarrow
+        markLocated pat
+
+      markPat l (GHC.SplicePat s) = do
+        markAST l s
+
+      markPat l (GHC.LitPat lp) = markAST l lp
+
+      markPat _ (GHC.NPat ol mn _ _) = do
+        when (isJust mn) $ mark GHC.AnnMinus
+        markLocated ol
+
+      markPat _ (GHC.NPlusKPat ln ol _ _ _ _) = do
+        markLocated ln
+        markWithString GHC.AnnVal "+"  -- "+"
+        markLocated ol
+
+
+      markPat _ (GHC.SigPatIn pat ty) = do
+        markLocated pat
+        mark GHC.AnnDcolon
+        markLHsSigWcType ty
+
+      markPat _ GHC.SigPatOut {} =
+        traceM "warning: SigPatOut introduced after renaming"
+
+      markPat _ GHC.CoPat {} =
+        traceM "warning: CoPat introduced after renaming"
+
+-- ---------------------------------------------------------------------
+
+hsLit2String :: GHC.HsLit GHC.GhcPs -> String
+hsLit2String lit =
+  case lit of
+    GHC.HsChar       src v   -> toSourceTextWithSuffix src v ""
+    -- It should be included here
+    -- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x#L1471
+    GHC.HsCharPrim   src p   -> toSourceTextWithSuffix src p "#"
+    GHC.HsString     src v   -> toSourceTextWithSuffix src v ""
+    GHC.HsStringPrim src v   -> toSourceTextWithSuffix src v ""
+    GHC.HsInt        _ (GHC.IL src _ v)   -> toSourceTextWithSuffix src v ""
+    GHC.HsIntPrim    src v   -> toSourceTextWithSuffix src v ""
+    GHC.HsWordPrim   src v   -> toSourceTextWithSuffix src v ""
+    GHC.HsInt64Prim  src v   -> toSourceTextWithSuffix src v ""
+    GHC.HsWord64Prim src v   -> toSourceTextWithSuffix src v ""
+    GHC.HsInteger    src v _ -> toSourceTextWithSuffix src v ""
+    GHC.HsRat        _ (GHC.FL src _ v) _ -> toSourceTextWithSuffix src v ""
+    GHC.HsFloatPrim  _ (GHC.FL src _ v)   -> toSourceTextWithSuffix src v "#"
+    GHC.HsDoublePrim _ (GHC.FL src _ v)   -> toSourceTextWithSuffix src v "##"
+
+toSourceTextWithSuffix :: (Show a) => GHC.SourceText -> a -> String -> String
+toSourceTextWithSuffix (GHC.NoSourceText)    alt suffix = show alt ++ suffix
+toSourceTextWithSuffix (GHC.SourceText txt) _alt suffix = txt ++ suffix
+
+-- --------------------------------------------------------------------
+
+markHsConPatDetails :: GHC.Located GHC.RdrName -> GHC.HsConPatDetails GHC.GhcPs -> Annotated ()
+markHsConPatDetails ln dets = do
+  case dets of
+    GHC.PrefixCon args -> do
+      setContext (Set.singleton PrefixOp) $ markLocated ln
+      mapM_ markLocated args
+    GHC.RecCon (GHC.HsRecFields fs dd) -> do
+      markLocated ln
+      mark GHC.AnnOpenC -- '{'
+      case dd of
+        Nothing ->  markListIntercalateWithFunLevel markLocated 2 fs
+        Just _ -> do
+          setContext (Set.singleton Intercalate) $ mapM_ markLocated fs
+          mark GHC.AnnDotdot
+      mark GHC.AnnCloseC -- '}'
+    GHC.InfixCon a1 a2 -> do
+      markLocated a1
+      unsetContext PrefixOp $ setContext (Set.singleton InfixOp) $ markLocated ln
+      markLocated a2
+
+markHsConDeclDetails ::
+  Bool -> Bool -> [GHC.Located GHC.RdrName] -> GHC.HsConDeclDetails GHC.GhcPs -> Annotated ()
+
+markHsConDeclDetails isDeprecated inGadt lns dets = do
+  case dets of
+    GHC.PrefixCon args ->
+      setContext (Set.singleton PrefixOp) $ mapM_ markLocated args
+    GHC.RecCon fs -> do
+      mark GHC.AnnOpenC
+      if inGadt
+        then do
+          if isDeprecated
+            then setContext (Set.fromList [InGadt]) $ markLocated fs
+            else setContext (Set.fromList [InGadt,InRecCon]) $ markLocated fs
+        else do
+          if isDeprecated
+            then markLocated fs
+            else setContext (Set.fromList [InRecCon]) $ markLocated fs
+    GHC.InfixCon a1 a2 -> do
+      markLocated a1
+      setContext (Set.singleton InfixOp) $ mapM_ markLocated lns
+      markLocated a2
+
+-- ---------------------------------------------------------------------
+
+instance Annotate [GHC.LConDeclField GHC.GhcPs] where
+  markAST _ fs = do
+       markOptional GHC.AnnOpenC -- '{'
+       markListIntercalate fs
+       markOptional GHC.AnnDotdot
+       inContext (Set.singleton InRecCon) $ mark GHC.AnnCloseC -- '}'
+       inContext (Set.singleton InGadt) $ do
+         mark GHC.AnnRarrow
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsOverLit GHC.GhcPs) where
+  markAST l ol =
+    let str = case GHC.ol_val ol of
+                GHC.HsIntegral   (GHC.IL src _ _) -> src
+                GHC.HsFractional (GHC.FL src _ _) -> src
+                GHC.HsIsString src _ -> src
+    in
+    markExternalSourceText l str ""
+
+-- ---------------------------------------------------------------------
+
+instance (GHC.DataId name,Annotate arg)
+    => Annotate (GHC.HsImplicitBndrs name (GHC.Located arg)) where
+  markAST _ (GHC.HsIB _ thing _) = do
+    markLocated thing
+
+-- ---------------------------------------------------------------------
+
+instance (Annotate body) => Annotate (GHC.Stmt GHC.GhcPs (GHC.Located body)) where
+
+  markAST _ (GHC.LastStmt body _ _)
+    = setContextLevel (Set.fromList [LeftMost,PrefixOp]) 2 $ markLocated body
+
+  markAST _ (GHC.BindStmt pat body _ _ _) = do
+    unsetContext Intercalate $ setContext (Set.singleton PrefixOp) $ markLocated pat
+    mark GHC.AnnLarrow
+    unsetContext Intercalate $ setContextLevel (Set.fromList [LeftMost,PrefixOp]) 2 $ markLocated body
+
+    ifInContext (Set.singleton Intercalate)
+      (mark GHC.AnnComma)
+      (inContext (Set.singleton AddVbar) $ mark GHC.AnnVbar)
+    markTrailingSemi
+
+  markAST _ GHC.ApplicativeStmt{}
+    = error "ApplicativeStmt should not appear in ParsedSource"
+
+  markAST _ (GHC.BodyStmt body _ _ _) = do
+    unsetContext Intercalate $ markLocated body
+    inContext (Set.singleton AddVbar)     $ mark GHC.AnnVbar
+    inContext (Set.singleton Intercalate) $ mark GHC.AnnComma
+    markTrailingSemi
+
+  markAST _ (GHC.LetStmt (GHC.L _ lb)) = do
+    mark GHC.AnnLet
+    markOptional GHC.AnnOpenC -- '{'
+    markInside GHC.AnnSemi
+    markLocalBindsWithLayout lb
+    markOptional GHC.AnnCloseC -- '}'
+    ifInContext (Set.singleton Intercalate)
+      (mark GHC.AnnComma)
+      (inContext (Set.singleton AddVbar)     $ mark GHC.AnnVbar)
+    markTrailingSemi
+
+  markAST l (GHC.ParStmt pbs _ _ _) = do
+    -- Within a given parallel list comprehension,one of the sections to be done
+    -- in parallel. It is a normal list comprehension, so has a list of
+    -- ParStmtBlock, one for each part of the sub- list comprehension
+
+
+    ifInContext (Set.singleton Intercalate)
+      (
+
+      unsetContext Intercalate $
+        markListWithContextsFunction
+          (LC (Set.singleton Intercalate)  -- only
+              Set.empty -- first
+              Set.empty -- middle
+              (Set.singleton Intercalate) -- last
+          ) (markAST l) pbs
+         )
+      (
+      unsetContext Intercalate $
+        markListWithContextsFunction
+          (LC Set.empty -- only
+              (Set.fromList [AddVbar]) -- first
+              (Set.fromList [AddVbar]) -- middle
+              Set.empty                -- last
+          ) (markAST l) pbs
+       )
+    markTrailingSemi
+
+  markAST _ (GHC.TransStmt form stmts _b using by _ _ _ _) = do
+    setContext (Set.singleton Intercalate) $ mapM_ markLocated stmts
+    case form of
+      GHC.ThenForm -> do
+        mark GHC.AnnThen
+        unsetContext Intercalate $ markLocated using
+        case by of
+          Just b -> do
+            mark GHC.AnnBy
+            unsetContext Intercalate $ markLocated b
+          Nothing -> return ()
+      GHC.GroupForm -> do
+        mark GHC.AnnThen
+        mark GHC.AnnGroup
+        case by of
+          Just b -> mark GHC.AnnBy >> markLocated b
+          Nothing -> return ()
+        mark GHC.AnnUsing
+        markLocated using
+    inContext (Set.singleton AddVbar)     $ mark GHC.AnnVbar
+    inContext (Set.singleton Intercalate) $ mark GHC.AnnComma
+    markTrailingSemi
+
+  markAST _ (GHC.RecStmt stmts _ _ _ _ _ _ _ _ _) = do
+    mark GHC.AnnRec
+    markOptional GHC.AnnOpenC
+    markInside GHC.AnnSemi
+    mapM_ markLocated stmts
+    markOptional GHC.AnnCloseC
+    inContext (Set.singleton AddVbar)     $ mark GHC.AnnVbar
+    inContext (Set.singleton Intercalate) $ mark GHC.AnnComma
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+-- Note: We never have a located ParStmtBlock, so have nothing to hang the
+-- annotation on. This means there is no pushing of context from the parent ParStmt.
+instance Annotate (GHC.ParStmtBlock GHC.GhcPs GHC.GhcPs) where
+  markAST _ (GHC.ParStmtBlock stmts _ns _) = do
+    markListIntercalate stmts
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsLocalBinds GHC.GhcPs) where
+  markAST _ lb = markHsLocalBinds lb
+
+-- ---------------------------------------------------------------------
+
+markHsLocalBinds :: GHC.HsLocalBinds GHC.GhcPs -> Annotated ()
+markHsLocalBinds (GHC.HsValBinds (GHC.ValBindsIn binds sigs)) =
+    applyListAnnotationsLayout
+       (prepareListAnnotation (GHC.bagToList binds)
+     ++ prepareListAnnotation sigs
+       )
+markHsLocalBinds (GHC.HsValBinds GHC.ValBindsOut {})
+   = traceM "warning: ValBindsOut introduced after renaming"
+
+markHsLocalBinds (GHC.HsIPBinds (GHC.IPBinds binds _)) = markListWithLayout binds
+markHsLocalBinds GHC.EmptyLocalBinds                   = return ()
+
+-- ---------------------------------------------------------------------
+
+markMatchGroup :: (Annotate body)
+                   => GHC.SrcSpan -> GHC.MatchGroup GHC.GhcPs (GHC.Located body)
+                   -> Annotated ()
+markMatchGroup _ (GHC.MG (GHC.L _ matches) _ _ _)
+  = setContextLevel (Set.singleton AdvanceLine) 2 $ markListWithLayout matches
+
+-- ---------------------------------------------------------------------
+
+instance (Annotate body)
+  => Annotate [GHC.Located (GHC.Match GHC.GhcPs (GHC.Located body))] where
+  markAST _ ls = mapM_ markLocated ls
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsExpr GHC.GhcPs) where
+  markAST loc expr = do
+    markExpr loc expr
+    inContext (Set.singleton AddVbar) $ mark GHC.AnnVbar
+    -- TODO: If the AnnComma is not needed, revert to markAST
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+   where
+      markExpr _ (GHC.HsVar n) = unsetContext Intercalate $ do
+        ifInContext (Set.singleton PrefixOp)
+          (setContext (Set.singleton PrefixOp) $ markLocated n)
+          (ifInContext (Set.singleton InfixOp)
+            (setContext (Set.singleton InfixOp) $ markLocated n)
+            (markLocated n)
+            )
+
+      markExpr l (GHC.HsRecFld f) = markAST l f
+
+      markExpr l (GHC.HsOverLabel _ fs)
+        = markExternal l GHC.AnnVal ("#" ++ GHC.unpackFS fs)
+
+
+      markExpr l (GHC.HsIPVar n@(GHC.HsIPName _v))         =
+        markAST l n
+      markExpr l (GHC.HsOverLit ov)     = markAST l ov
+      markExpr l (GHC.HsLit lit)        = markAST l lit
+
+      markExpr _ (GHC.HsLam (GHC.MG (GHC.L _ [match]) _ _ _)) = do
+        setContext (Set.singleton LambdaExpr) $ do
+        -- TODO: Change this, HsLam binds do not need obey layout rules.
+        --       And will only ever have a single match
+          markLocated match
+      markExpr _ (GHC.HsLam _) = error $ "HsLam with other than one match"
+
+      markExpr l (GHC.HsLamCase match) = do
+        mark GHC.AnnLam
+        mark GHC.AnnCase
+        markOptional GHC.AnnOpenC
+        setContext (Set.singleton CaseAlt) $ do
+          markMatchGroup l match
+        markOptional GHC.AnnCloseC
+
+      markExpr _ (GHC.HsApp e1 e2) = do
+        setContext (Set.singleton PrefixOp) $ markLocated e1
+        setContext (Set.singleton PrefixOp) $ markLocated e2
+
+      markExpr _ (GHC.OpApp e1 e2 _ e3) = do
+        let
+          isInfix = case e2 of
+            -- TODO: generalise this. Is it a fixity thing?
+            GHC.L _ (GHC.HsVar _) -> True
+            _                     -> False
+
+          normal =
+            -- When it is the leftmost item in a GRHS, e1 needs to have PrefixOp context
+            ifInContext (Set.singleton LeftMost)
+              (setContextLevel (Set.fromList [LeftMost,PrefixOp]) 2 $ markLocated e1)
+              (markLocated e1)
+
+        if isInfix
+            then setContextLevel (Set.singleton PrefixOp) 2 $ markLocated e1
+            else normal
+
+        unsetContext PrefixOp $ setContext (Set.singleton InfixOp) $ markLocated e2
+
+        if isInfix
+          then setContextLevel (Set.singleton PrefixOp) 2 $ markLocated e3
+          else markLocated e3
+
+      markExpr _ (GHC.NegApp e _) = do
+        mark GHC.AnnMinus
+        markLocated e
+
+      markExpr _ (GHC.HsPar e) = do
+        mark GHC.AnnOpenP -- '('
+        markLocated e
+        mark GHC.AnnCloseP -- ')'
+
+      markExpr _ (GHC.SectionL e1 e2) = do
+        markLocated e1
+        setContext (Set.singleton InfixOp) $ markLocated e2
+
+      markExpr _ (GHC.SectionR e1 e2) = do
+        setContext (Set.singleton InfixOp) $ markLocated e1
+        markLocated e2
+
+      markExpr _ (GHC.ExplicitTuple args b) = do
+        if b == GHC.Boxed then mark GHC.AnnOpenP
+                          else markWithString GHC.AnnOpen "(#"
+
+        setContext (Set.singleton PrefixOp) $ markListIntercalateWithFunLevel markLocated 2 args
+
+        if b == GHC.Boxed then mark GHC.AnnCloseP
+                          else markWithString GHC.AnnClose "#)"
+
+      markExpr _ (GHC.ExplicitSum alt arity e _) = do
+        markWithString GHC.AnnOpen "(#"
+        replicateM_ (alt - 1) $ mark GHC.AnnVbar
+        markLocated e
+        replicateM_ (arity - alt) $ mark GHC.AnnVbar
+        markWithString GHC.AnnClose "#)"
+
+      markExpr l (GHC.HsCase e1 matches) = setRigidFlag $ do
+        mark GHC.AnnCase
+        setContextLevel (Set.singleton PrefixOp) 2 $ markLocated e1
+        mark GHC.AnnOf
+        markOptional GHC.AnnOpenC
+        markInside GHC.AnnSemi
+        setContext (Set.singleton CaseAlt) $ markMatchGroup l matches
+        markOptional GHC.AnnCloseC
+
+      -- We set the layout for HsIf even though it need not obey layout rules as
+      -- when moving these expressions it's useful that they maintain "internal
+      -- integrity", that is to say the subparts remain indented relative to each
+      -- other.
+      markExpr _ (GHC.HsIf _ e1 e2 e3) = setLayoutFlag $ do
+      -- markExpr _ (GHC.HsIf _ e1 e2 e3) = setRigidFlag $ do
+        mark GHC.AnnIf
+        markLocated e1
+        markAnnBeforeAnn GHC.AnnSemi GHC.AnnThen
+        mark GHC.AnnThen
+        setContextLevel (Set.singleton ListStart) 2 $ markLocated e2
+        markAnnBeforeAnn GHC.AnnSemi GHC.AnnElse
+        mark GHC.AnnElse
+        setContextLevel (Set.singleton ListStart) 2 $ markLocated e3
+
+      markExpr _ (GHC.HsMultiIf _ rhs) = do
+        mark GHC.AnnIf
+        markOptional GHC.AnnOpenC
+        setContext (Set.singleton CaseAlt) $ do
+          -- mapM_ markLocated rhs
+          markListWithLayout rhs
+        markOptional GHC.AnnCloseC
+
+      markExpr _ (GHC.HsLet (GHC.L _ binds) e) = do
+        setLayoutFlag (do -- Make sure the 'in' gets indented too
+          mark GHC.AnnLet
+          markOptional GHC.AnnOpenC
+          markInside GHC.AnnSemi
+          markLocalBindsWithLayout binds
+          markOptional GHC.AnnCloseC
+          mark GHC.AnnIn
+          markLocated e)
+
+      -- -------------------------------
+
+      markExpr _ (GHC.HsDo cts (GHC.L _ es) _) = do
+        case cts of
+          GHC.DoExpr  -> mark GHC.AnnDo
+          GHC.MDoExpr -> mark GHC.AnnMdo
+          _           -> return ()
+        let (ostr,cstr) =
+              if isListComp cts
+                then case cts of
+                       GHC.PArrComp -> ("[:",":]")
+                       _            -> ("[",  "]")
+                else ("{","}")
+
+        when (isListComp cts) $ markWithString GHC.AnnOpen ostr
+        markOptional GHC.AnnOpenS
+        markOptional GHC.AnnOpenC
+        markInside GHC.AnnSemi
+        if isListComp cts
+          then do
+            markLocated (last es)
+            mark GHC.AnnVbar
+            setLayoutFlag (markListIntercalate (init es))
+          else do
+           markListWithLayout es
+        markOptional GHC.AnnCloseS
+        markOptional GHC.AnnCloseC
+        when (isListComp cts) $ markWithString GHC.AnnClose cstr
+
+      -- -------------------------------
+
+      markExpr _ (GHC.ExplicitList _ _ es) = do
+        mark GHC.AnnOpenS
+        setContext (Set.singleton PrefixOp) $ markListIntercalateWithFunLevel markLocated 2 es
+        mark GHC.AnnCloseS
+
+      markExpr _ (GHC.ExplicitPArr _ es)   = do
+        markWithString GHC.AnnOpen "[:"
+        markListIntercalateWithFunLevel markLocated 2 es
+        markWithString GHC.AnnClose ":]"
+
+      markExpr _ (GHC.RecordCon n _ _ (GHC.HsRecFields fs dd)) = do
+        markLocated n
+        mark GHC.AnnOpenC
+        case dd of
+          Nothing -> markListIntercalate fs
+          Just _ -> do
+            setContext (Set.singleton Intercalate) $ mapM_ markLocated fs
+            mark GHC.AnnDotdot
+        mark GHC.AnnCloseC
+
+      markExpr _ (GHC.RecordUpd e fs _cons _ _ _) = do
+        markLocated e
+        mark GHC.AnnOpenC
+        markListIntercalate fs
+        mark GHC.AnnCloseC
+
+      markExpr _ (GHC.ExprWithTySig e typ) = do
+        setContextLevel (Set.singleton PrefixOp) 2 $ markLocated e
+        mark GHC.AnnDcolon
+        markLHsSigWcType typ
+
+      markExpr _ (GHC.ExprWithTySigOut _e _typ)
+        = error "ExprWithTySigOut only occurs after renamer"
+
+      markExpr _ (GHC.ArithSeq _ _ seqInfo) = do
+        mark GHC.AnnOpenS -- '['
+        case seqInfo of
+            GHC.From e -> do
+              markLocated e
+              mark GHC.AnnDotdot
+            GHC.FromTo e1 e2 -> do
+              markLocated e1
+              mark GHC.AnnDotdot
+              markLocated e2
+            GHC.FromThen e1 e2 -> do
+              markLocated e1
+              mark GHC.AnnComma
+              markLocated e2
+              mark GHC.AnnDotdot
+            GHC.FromThenTo e1 e2 e3 -> do
+              markLocated e1
+              mark GHC.AnnComma
+              markLocated e2
+              mark GHC.AnnDotdot
+              markLocated e3
+        mark GHC.AnnCloseS -- ']'
+
+      markExpr _ (GHC.PArrSeq _ seqInfo) = do
+        markWithString GHC.AnnOpen "[:" -- '[:'
+        case seqInfo of
+            GHC.From e -> do
+              markLocated e
+              mark GHC.AnnDotdot
+            GHC.FromTo e1 e2 -> do
+              markLocated e1
+              mark GHC.AnnDotdot
+              markLocated e2
+            GHC.FromThen e1 e2 -> do
+              markLocated e1
+              mark GHC.AnnComma
+              markLocated e2
+              mark GHC.AnnDotdot
+            GHC.FromThenTo e1 e2 e3 -> do
+              markLocated e1
+              mark GHC.AnnComma
+              markLocated e2
+              mark GHC.AnnDotdot
+              markLocated e3
+        markWithString GHC.AnnClose ":]" -- ':]'
+
+      markExpr _ (GHC.HsSCC src csFStr e) = do
+        markAnnOpen src "{-# SCC"
+        let txt = sourceTextToString (GHC.sl_st csFStr) (GHC.unpackFS $ GHC.sl_fs csFStr)
+        markWithStringOptional GHC.AnnVal    txt
+        markWithString         GHC.AnnValStr txt
+        markWithString GHC.AnnClose "#-}"
+        markLocated e
+
+      markExpr _ (GHC.HsCoreAnn src csFStr e) = do
+        -- markWithString GHC.AnnOpen src -- "{-# CORE"
+        markAnnOpen src "{-# CORE"
+        -- markWithString GHC.AnnVal (GHC.sl_st csFStr)
+        markSourceText (GHC.sl_st csFStr) (GHC.unpackFS $ GHC.sl_fs csFStr)
+        markWithString GHC.AnnClose "#-}"
+        markLocated e
+      -- TODO: make monomorphic
+      markExpr l (GHC.HsBracket (GHC.VarBr True v)) = do
+        mark GHC.AnnSimpleQuote
+        setContext (Set.singleton PrefixOpDollar) $ markLocatedFromKw GHC.AnnName (GHC.L l v)
+      markExpr l (GHC.HsBracket (GHC.VarBr False v)) = do
+        mark GHC.AnnThTyQuote
+        markLocatedFromKw GHC.AnnName (GHC.L l v)
+      markExpr _ (GHC.HsBracket (GHC.DecBrL ds)) = do
+        markWithString GHC.AnnOpen "[d|"
+        markOptional GHC.AnnOpenC
+        setContext (Set.singleton NoAdvanceLine)
+             $ setContextLevel (Set.singleton TopLevel) 2 $ markListWithLayout ds
+        markOptional GHC.AnnCloseC
+        mark GHC.AnnCloseQ -- "|]"
+      -- Introduced after the renamer
+      markExpr _ (GHC.HsBracket (GHC.DecBrG _)) =
+        traceM "warning: DecBrG introduced after renamer"
+      markExpr _l (GHC.HsBracket (GHC.ExpBr e)) = do
+        mark GHC.AnnOpenEQ -- "[|"
+        markOptional GHC.AnnOpenE  -- "[e|"
+        markLocated e
+        mark GHC.AnnCloseQ -- "|]"
+      markExpr _l (GHC.HsBracket (GHC.TExpBr e)) = do
+        markWithString GHC.AnnOpen  "[||"
+        markWithStringOptional GHC.AnnOpenE "[e||"
+        markLocated e
+        markWithString GHC.AnnClose "||]"
+      markExpr _ (GHC.HsBracket (GHC.TypBr e)) = do
+        markWithString GHC.AnnOpen "[t|"
+        markLocated e
+        mark GHC.AnnCloseQ -- "|]"
+      markExpr _ (GHC.HsBracket (GHC.PatBr e)) = do
+        markWithString GHC.AnnOpen  "[p|"
+        markLocated e
+        mark GHC.AnnCloseQ -- "|]"
+
+      markExpr _ (GHC.HsRnBracketOut _ _) =
+        traceM "warning: HsRnBracketOut introduced after renamer"
+      markExpr _ (GHC.HsTcBracketOut _ _) =
+        traceM "warning: HsTcBracketOut introduced after renamer"
+
+      markExpr l (GHC.HsSpliceE e) = markAST l e
+
+      markExpr _ (GHC.HsProc p c) = do
+        mark GHC.AnnProc
+        markLocated p
+        mark GHC.AnnRarrow
+        markLocated c
+
+      markExpr _ (GHC.HsStatic _ e) = do
+        mark GHC.AnnStatic
+        markLocated e
+
+      markExpr _ (GHC.HsArrApp e1 e2 _ o isRightToLeft) = do
+            -- isRightToLeft True  => right-to-left (f -< arg)
+            --               False => left-to-right (arg >- f)
+        if isRightToLeft
+          then do
+            markLocated e1
+            case o of
+              GHC.HsFirstOrderApp  -> mark GHC.Annlarrowtail
+              GHC.HsHigherOrderApp -> mark GHC.AnnLarrowtail
+          else do
+            markLocated e2
+            case o of
+              GHC.HsFirstOrderApp  -> mark GHC.Annrarrowtail
+              GHC.HsHigherOrderApp -> mark GHC.AnnRarrowtail
+
+        if isRightToLeft
+          then markLocated e2
+          else markLocated e1
+
+      markExpr _ (GHC.HsArrForm e _ cs) = do
+        markWithString GHC.AnnOpenB "(|"
+        markLocated e
+        mapM_ markLocated cs
+        markWithString GHC.AnnCloseB "|)"
+
+      markExpr _ (GHC.HsTick _ _) = return ()
+      markExpr _ (GHC.HsBinTick _ _ _) = return ()
+
+      markExpr _ (GHC.HsTickPragma src (str,(v1,v2),(v3,v4)) ((s1,s2),(s3,s4)) e) = do
+        -- '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
+        markAnnOpen src  "{-# GENERATED"
+        markOffsetWithString GHC.AnnVal 0 (stringLiteralToString str) -- STRING
+
+        let
+          markOne n  v GHC.NoSourceText   = markOffsetWithString GHC.AnnVal n (show v)
+          markOne n _v (GHC.SourceText s) = markOffsetWithString GHC.AnnVal n s
+
+        markOne  1 v1 s1 -- INTEGER
+        markOffset GHC.AnnColon 0 -- ':'
+        markOne  2 v2 s2 -- INTEGER
+        mark   GHC.AnnMinus   -- '-'
+        markOne  3 v3 s3 -- INTEGER
+        markOffset GHC.AnnColon 1 -- ':'
+        markOne  4 v4 s4 -- INTEGER
+        markWithString   GHC.AnnClose  "#-}"
+        markLocated e
+
+      markExpr l GHC.EWildPat = do
+        ifInContext (Set.fromList [InfixOp])
+          (do  mark GHC.AnnBackquote
+               markWithString GHC.AnnVal "_"
+               mark GHC.AnnBackquote)
+          (markExternal l GHC.AnnVal "_")
+
+      markExpr _ (GHC.EAsPat ln e) = do
+        markLocated ln
+        mark GHC.AnnAt
+        markLocated e
+
+      markExpr _ (GHC.EViewPat e1 e2) = do
+        markLocated e1
+        mark GHC.AnnRarrow
+        markLocated e2
+
+      markExpr _ (GHC.ELazyPat e) = do
+        mark GHC.AnnTilde
+        markLocated e
+
+      markExpr _ (GHC.HsAppType e ty) = do
+        markLocated e
+        markInstead GHC.AnnAt AnnTypeApp
+        markLHsWcType ty
+      markExpr _ (GHC.HsAppTypeOut _ _) =
+        traceM "warning: HsAppTypeOut introduced after renaming"
+
+      markExpr _ (GHC.HsWrap _ _) =
+        traceM "warning: HsWrap introduced after renaming"
+      markExpr _ (GHC.HsUnboundVar _) =
+        traceM "warning: HsUnboundVar introduced after renaming"
+
+      markExpr _ (GHC.HsConLikeOut{}) =
+        traceM "warning: HsConLikeOut introduced after type checking"
+
+
+-- ---------------------------------------------------------------------
+
+markLHsWcType :: GHC.LHsWcType GHC.GhcPs -> Annotated ()
+markLHsWcType (GHC.HsWC _ ty) = do
+  markLocated ty
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsLit GHC.GhcPs) where
+  markAST l lit = markExternal l GHC.AnnVal (hsLit2String lit)
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsRecUpdField GHC.GhcPs) where
+  markAST _ (GHC.HsRecField lbl expr punFlag) = do
+    unsetContext Intercalate $ markLocated lbl
+    when (punFlag == False) $ do
+      mark GHC.AnnEqual
+      unsetContext Intercalate $ markLocated expr
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+instance (GHC.DataId name)
+  => Annotate (GHC.AmbiguousFieldOcc name) where
+  markAST _ (GHC.Unambiguous n _) = markLocated n
+  markAST _ (GHC.Ambiguous   n _) = markLocated n
+
+-- ---------------------------------------------------------------------
+
+-- |Used for declarations that need to be aligned together, e.g. in a
+-- do or let .. in statement/expr
+instance Annotate [GHC.ExprLStmt GHC.GhcPs] where
+  markAST _ ls = mapM_ markLocated ls
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsTupArg GHC.GhcPs) where
+  markAST _ (GHC.Present (GHC.L l e)) = do
+    markLocated (GHC.L l e)
+    inContext (Set.fromList [Intercalate]) $ markOutside GHC.AnnComma (G GHC.AnnComma)
+
+  markAST _ (GHC.Missing _) = do
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsCmdTop GHC.GhcPs) where
+  markAST _ (GHC.HsCmdTop cmd _ _ _) = markLocated cmd
+
+instance Annotate (GHC.HsCmd GHC.GhcPs) where
+  markAST _ (GHC.HsCmdArrApp e1 e2 _ o isRightToLeft) = do
+        -- isRightToLeft True  => right-to-left (f -< arg)
+        --               False => left-to-right (arg >- f)
+    if isRightToLeft
+      then do
+        markLocated e1
+        case o of
+          GHC.HsFirstOrderApp  -> mark GHC.Annlarrowtail
+          GHC.HsHigherOrderApp -> mark GHC.AnnLarrowtail
+      else do
+        markLocated e2
+        case o of
+          GHC.HsFirstOrderApp  -> mark GHC.Annrarrowtail
+          GHC.HsHigherOrderApp -> mark GHC.AnnRarrowtail
+
+    if isRightToLeft
+      then markLocated e2
+      else markLocated e1
+
+  markAST _ (GHC.HsCmdArrForm e fixity _mf cs) = do
+    -- The AnnOpen should be marked for a prefix usage, not for a postfix one,
+    -- due to the way checkCmd maps both HsArrForm and OpApp to HsCmdArrForm
+
+    let isPrefixOp = case fixity of
+          GHC.Infix  -> False
+          GHC.Prefix -> True
+    when isPrefixOp $ mark GHC.AnnOpenB -- "(|"
+
+    -- This may be an infix operation
+    applyListAnnotationsContexts (LC (Set.singleton PrefixOp) (Set.singleton PrefixOp)
+                                     (Set.singleton InfixOp) (Set.singleton InfixOp))
+                       (prepareListAnnotation [e]
+                         ++ prepareListAnnotation cs)
+    when isPrefixOp $ mark GHC.AnnCloseB -- "|)"
+
+  markAST _ (GHC.HsCmdApp e1 e2) = do
+    markLocated e1
+    markLocated e2
+
+  markAST l (GHC.HsCmdLam match) = do
+    setContext (Set.singleton LambdaExpr) $ do markMatchGroup l match
+
+  markAST _ (GHC.HsCmdPar e) = do
+    mark GHC.AnnOpenP
+    markLocated e
+    mark GHC.AnnCloseP -- ')'
+
+  markAST l (GHC.HsCmdCase e1 matches) = do
+    mark GHC.AnnCase
+    markLocated e1
+    mark GHC.AnnOf
+    markOptional GHC.AnnOpenC
+    setContext (Set.singleton CaseAlt) $ do
+      markMatchGroup l matches
+    markOptional GHC.AnnCloseC
+
+  markAST _ (GHC.HsCmdIf _ e1 e2 e3) = do
+    mark GHC.AnnIf
+    markLocated e1
+    markOffset GHC.AnnSemi 0
+    mark GHC.AnnThen
+    markLocated e2
+    markOffset GHC.AnnSemi 1
+    mark GHC.AnnElse
+    markLocated e3
+
+  markAST _ (GHC.HsCmdLet (GHC.L _ binds) e) = do
+    mark GHC.AnnLet
+    markOptional GHC.AnnOpenC
+    markLocalBindsWithLayout binds
+    markOptional GHC.AnnCloseC
+    mark GHC.AnnIn
+    markLocated e
+
+  markAST _ (GHC.HsCmdDo (GHC.L _ es) _) = do
+    mark GHC.AnnDo
+    markOptional GHC.AnnOpenC
+    markListWithLayout es
+    markOptional GHC.AnnCloseC
+
+
+  markAST _ (GHC.HsCmdWrap {}) =
+    traceM "warning: HsCmdWrap introduced after renaming"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate [GHC.Located (GHC.StmtLR GHC.GhcPs GHC.GhcPs (GHC.LHsCmd GHC.GhcPs))] where
+  markAST _ ls = mapM_ markLocated ls
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.TyClDecl GHC.GhcPs) where
+
+  markAST l (GHC.FamDecl famdecl) = markAST l famdecl >> markTrailingSemi
+
+  markAST _ (GHC.SynDecl ln (GHC.HsQTvs _ tyvars _) fixity typ _) = do
+    -- There may be arbitrary parens around parts of the constructor that are
+    -- infix.
+    -- Turn these into comments so that they feed into the right place automatically
+    -- annotationsToComments [GHC.AnnOpenP,GHC.AnnCloseP]
+    mark GHC.AnnType
+
+    markTyClass fixity ln tyvars
+    mark GHC.AnnEqual
+    markLocated typ
+    markTrailingSemi
+
+  markAST _ (GHC.DataDecl ln (GHC.HsQTvs _ns tyVars _) fixity
+                (GHC.HsDataDefn nd ctx mctyp mk cons derivs) _ _) = do
+    if nd == GHC.DataType
+      then mark GHC.AnnData
+      else mark GHC.AnnNewtype
+    markMaybe mctyp
+    markLocated ctx
+    markTyClass fixity ln tyVars
+    case mk of
+      Nothing -> return ()
+      Just k -> do
+        mark GHC.AnnDcolon
+        markLocated k
+    if isGadt cons
+      then mark GHC.AnnWhere
+      else unless (null cons) $ mark GHC.AnnEqual
+    markOptional GHC.AnnWhere
+    markOptional GHC.AnnOpenC
+    setLayoutFlag $ setContext (Set.singleton NoPrecedingSpace)
+                  $ markListWithContexts' listContexts cons
+    markOptional GHC.AnnCloseC
+    setContext (Set.fromList [Deriving,NoDarrow]) $ markLocated derivs
+    markTrailingSemi
+
+  -- -----------------------------------
+
+  markAST _ (GHC.ClassDecl ctx ln (GHC.HsQTvs _ns tyVars _) fixity fds
+                          sigs meths ats atdefs docs _) = do
+    mark GHC.AnnClass
+    markLocated ctx
+
+    markTyClass fixity ln tyVars
+
+    unless (null fds) $ do
+      mark GHC.AnnVbar
+      markListIntercalateWithFunLevel markLocated 2 fds
+    mark GHC.AnnWhere
+    markOptional GHC.AnnOpenC -- '{'
+    markInside GHC.AnnSemi
+    -- AZ:TODO: we end up with both the tyVars and the following body of the
+    -- class defn in annSortKey for the class. This could cause problems when
+    -- changing things.
+    setContext (Set.singleton InClassDecl) $
+      applyListAnnotationsLayout
+                           (prepareListAnnotation sigs
+                         ++ prepareListAnnotation (GHC.bagToList meths)
+                         ++ prepareListAnnotation ats
+                         ++ prepareListAnnotation atdefs
+                         ++ prepareListAnnotation docs
+                           )
+    markOptional GHC.AnnCloseC -- '}'
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+markTyClass :: (Annotate a, Annotate ast,GHC.HasOccName a)
+                => GHC.LexicalFixity -> GHC.Located a -> [GHC.Located ast] -> Annotated ()
+markTyClass fixity ln tyVars = do
+    -- There may be arbitrary parens around parts of the constructor
+    -- Turn these into comments so that they feed into the right place automatically
+    annotationsToComments [GHC.AnnOpenP,GHC.AnnCloseP]
+    let markParens = if fixity == GHC.Infix && length tyVars > 2
+          then markMany
+          else markManyOptional
+    if fixity == GHC.Prefix
+      then do
+        markManyOptional GHC.AnnOpenP
+        setContext (Set.singleton PrefixOp) $ markLocated ln
+        -- setContext (Set.singleton PrefixOp) $ mapM_ markLocated tyVars
+        setContext (Set.singleton PrefixOp) $ mapM_ markLocated $ take 2 tyVars
+        when (length tyVars >= 2) $ do
+          markParens GHC.AnnCloseP
+          setContext (Set.singleton PrefixOp) $ mapM_ markLocated $ drop 2 tyVars
+        markManyOptional GHC.AnnCloseP
+      else do
+        case tyVars of
+          (x:y:xs) -> do
+            markParens GHC.AnnOpenP
+            markLocated x
+            setContext (Set.singleton InfixOp) $ markLocated ln
+            markLocated y
+            markParens GHC.AnnCloseP
+            mapM_ markLocated xs
+            markManyOptional GHC.AnnCloseP
+          _ -> error $ "markTyClass: Infix op without operands"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate [GHC.LHsDerivingClause GHC.GhcPs] where
+  markAST _ ds = mapM_ markLocated ds
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsDerivingClause GHC.GhcPs) where
+  markAST _ (GHC.HsDerivingClause mstrategy (GHC.L _ typs)) = do
+    let needsParens = case typs of
+          [(GHC.HsIB _ (GHC.L _ (GHC.HsTyVar _ _)) _)] -> False
+          _                           -> True
+    mark GHC.AnnDeriving
+    markMaybe mstrategy
+    if needsParens then mark         GHC.AnnOpenP
+                   else markOptional GHC.AnnOpenP
+    markListIntercalateWithFunLevel markLHsSigType 2 typs
+    if needsParens then mark         GHC.AnnCloseP
+                   else markOptional GHC.AnnCloseP
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.FamilyDecl GHC.GhcPs) where
+  markAST _ (GHC.FamilyDecl info ln (GHC.HsQTvs _ tyvars _) fixity rsig minj) = do
+    case info of
+      GHC.DataFamily -> mark GHC.AnnData
+      _              -> mark GHC.AnnType
+
+    mark GHC.AnnFamily
+
+    markTyClass fixity ln tyvars
+    case GHC.unLoc rsig of
+      GHC.NoSig -> return ()
+      GHC.KindSig _ -> do
+        mark GHC.AnnDcolon
+        markLocated rsig
+      GHC.TyVarSig _ -> do
+        mark GHC.AnnEqual
+        markLocated rsig
+    case minj of
+      Nothing -> return ()
+      Just inj -> do
+        mark GHC.AnnVbar
+        markLocated inj
+    case info of
+      GHC.ClosedTypeFamily (Just eqns) -> do
+        mark GHC.AnnWhere
+        markOptional GHC.AnnOpenC -- {
+        markListWithLayout eqns
+        markOptional GHC.AnnCloseC -- }
+      GHC.ClosedTypeFamily Nothing -> do
+        mark GHC.AnnWhere
+        mark GHC.AnnOpenC -- {
+        mark GHC.AnnDotdot
+        mark GHC.AnnCloseC -- }
+      _ -> return ()
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.FamilyResultSig GHC.GhcPs) where
+  markAST _ (GHC.NoSig)        = return ()
+  markAST _ (GHC.KindSig k)    = markLocated k
+  markAST _ (GHC.TyVarSig ltv) = markLocated ltv
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.InjectivityAnn GHC.GhcPs) where
+  markAST _ (GHC.InjectivityAnn ln lns) = do
+    markLocated ln
+    mark GHC.AnnRarrow
+    mapM_ markLocated lns
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.TyFamInstEqn GHC.GhcPs) where
+
+  markAST _ (GHC.HsIB _ eqn _) = do
+    markFamEqn eqn
+    markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.TyFamDefltEqn GHC.GhcPs) where
+
+  markAST _ (GHC.FamEqn ln (GHC.HsQTvs _ns bndrs _) fixity typ) = do
+    mark GHC.AnnType
+    mark GHC.AnnInstance
+    markTyClass fixity ln bndrs
+    mark GHC.AnnEqual
+    markLocated typ
+
+-- ---------------------------------------------------------------------
+
+-- TODO: modify lexer etc, in the meantime to not set haddock flag
+instance Annotate GHC.DocDecl where
+  markAST l v =
+    let str =
+          case v of
+            (GHC.DocCommentNext (GHC.HsDocString fs))     -> GHC.unpackFS fs
+            (GHC.DocCommentPrev (GHC.HsDocString fs))     -> GHC.unpackFS fs
+            (GHC.DocCommentNamed _s (GHC.HsDocString fs)) -> GHC.unpackFS fs
+            (GHC.DocGroup _i (GHC.HsDocString fs))        -> GHC.unpackFS fs
+    in
+      markExternal l GHC.AnnVal str >> markTrailingSemi
+
+-- ---------------------------------------------------------------------
+
+markDataDefn :: GHC.SrcSpan -> GHC.HsDataDefn GHC.GhcPs -> Annotated ()
+markDataDefn _ (GHC.HsDataDefn _ ctx typ _mk cons derivs) = do
+  markLocated ctx
+  markMaybe typ
+  if isGadt cons
+    then markListWithLayout cons
+    else markListIntercalateWithFunLevel markLocated 2 cons
+  setContext (Set.singleton Deriving) $ markLocated derivs
+
+-- ---------------------------------------------------------------------
+
+-- Note: GHC.HsContext name aliases to here too
+instance Annotate [GHC.LHsType GHC.GhcPs] where
+  markAST l ts = do
+    -- Mote: A single item in parens in a deriving clause is parsed as a
+    -- HsSigType, which is always a HsForAllTy. Without parens it is always a
+    -- HsVar. So for round trip pretty printing we need to take this into
+    -- account.
+    let
+      parenIfNeeded' pa =
+        case ts of
+          []  -> if l == GHC.noSrcSpan
+            then markManyOptional pa
+            else markMany pa
+          [GHC.L _ GHC.HsForAllTy{}] -> markMany pa
+          [_] -> markManyOptional pa
+          _   -> markMany         pa
+
+      parenIfNeeded'' pa =
+        ifInContext (Set.singleton Parens)
+          (markMany pa)
+          (parenIfNeeded' pa)
+
+      parenIfNeeded pa =
+        case ts of
+          [GHC.L _ GHC.HsParTy{}] -> markOptional pa
+          _ -> parenIfNeeded'' pa
+
+    -- -------------
+
+    parenIfNeeded GHC.AnnOpenP
+
+    unsetContext Intercalate $ markListIntercalateWithFunLevel markLocated 2 ts
+
+    parenIfNeeded GHC.AnnCloseP
+
+    ifInContext (Set.singleton NoDarrow)
+      (return ())
+      (if null ts && (l == GHC.noSrcSpan)
+         then markOptional GHC.AnnDarrow
+         else mark         GHC.AnnDarrow)
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.ConDecl GHC.GhcPs) where
+  markAST _ (GHC.ConDeclH98 ln mqtvs mctx
+                         dets _ ) = do
+    case mqtvs of
+      Nothing -> return ()
+      Just (GHC.HsQTvs _ns bndrs _) -> do
+        mark GHC.AnnForall
+        mapM_ markLocated bndrs
+        mark GHC.AnnDot
+
+    case mctx of
+      Just ctx -> do
+        setContext (Set.fromList [NoDarrow]) $ markLocated ctx
+        unless (null $ GHC.unLoc ctx) $ mark GHC.AnnDarrow
+      Nothing -> return ()
+
+    case dets of
+      GHC.InfixCon _ _ -> return ()
+      _ -> setContext (Set.singleton PrefixOp) $ markLocated ln
+
+    markHsConDeclDetails False False [ln] dets
+
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnVbar
+    markTrailingSemi
+  markAST _ (GHC.ConDeclGADT lns (GHC.HsIB _ typ _) _) = do
+    setContext (Set.singleton PrefixOp) $ markListIntercalate lns
+    mark GHC.AnnDcolon
+    markLocated typ
+    markTrailingSemi
+
+-- ResTyGADT has a SrcSpan for the original sigtype, we need to create
+-- a type for exactPC and annotatePC
+data ResTyGADTHook name = ResTyGADTHook [GHC.LHsTyVarBndr name]
+                   deriving (Typeable)
+deriving instance (GHC.DataId name) => Data (ResTyGADTHook name)
+deriving instance (Show (GHC.LHsTyVarBndr name)) => Show (ResTyGADTHook name)
+
+instance GHC.Outputable (ResTyGADTHook GHC.GhcPs) where
+  ppr (ResTyGADTHook bs) = GHC.text "ResTyGADTHook" GHC.<+> GHC.ppr bs
+
+
+-- WildCardAnon exists because the GHC anonymous wildcard type is defined as
+--      = AnonWildCard (PostRn name Name)
+-- We need to reconstruct this from the typed hole SrcSpan in an HsForAllTy, but
+-- the instance doing this is parameterised on name, so we cannot put a value in
+-- for the (PostRn name Name) field. This is used instead.
+data WildCardAnon = WildCardAnon deriving (Show,Data,Typeable)
+
+instance Annotate WildCardAnon where
+  markAST l WildCardAnon = do
+    markExternal l GHC.AnnVal "_"
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (ResTyGADTHook GHC.GhcPs) where
+  markAST _ (ResTyGADTHook bndrs) = do
+    unless (null bndrs) $ do
+      mark GHC.AnnForall
+      mapM_ markLocated bndrs
+      mark GHC.AnnDot
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.HsRecField GHC.GhcPs (GHC.LPat GHC.GhcPs)) where
+  markAST _ (GHC.HsRecField n e punFlag) = do
+    unsetContext Intercalate $ markLocated n
+    unless punFlag $ do
+      mark GHC.AnnEqual
+      unsetContext Intercalate $ markLocated e
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+
+instance Annotate (GHC.HsRecField GHC.GhcPs (GHC.LHsExpr GHC.GhcPs)) where
+  markAST _ (GHC.HsRecField n e punFlag) = do
+    unsetContext Intercalate $ markLocated n
+    unless punFlag $ do
+      mark GHC.AnnEqual
+      unsetContext Intercalate $ markLocated e
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance Annotate (GHC.FunDep (GHC.Located GHC.RdrName)) where
+
+  markAST _ (ls,rs) = do
+    mapM_ markLocated ls
+    mark GHC.AnnRarrow
+    mapM_ markLocated rs
+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma
+
+-- ---------------------------------------------------------------------
+
+instance Annotate GHC.CType where
+  markAST _ (GHC.CType src mh f) = do
+    -- markWithString GHC.AnnOpen src
+    markAnnOpen src ""
+    case mh of
+      Nothing -> return ()
+      Just (GHC.Header srcH _h) ->
+         -- markWithString GHC.AnnHeader srcH
+         markWithString GHC.AnnHeader (toSourceTextWithSuffix srcH "" "")
+    -- markWithString GHC.AnnVal (fst f)
+    markSourceText  (fst f) (GHC.unpackFS $ snd f)
+    markWithString GHC.AnnClose "#-}"
+
+-- ---------------------------------------------------------------------
+
+stringLiteralToString :: GHC.StringLiteral -> String
+stringLiteralToString (GHC.StringLiteral st fs) =
+  case st of
+    GHC.NoSourceText   -> GHC.unpackFS fs
+    GHC.SourceText src -> src
diff --git a/src/Language/Haskell/GHC/ExactPrint/AnnotateTypes.hs b/src/Language/Haskell/GHC/ExactPrint/AnnotateTypes.hs
--- a/src/Language/Haskell/GHC/ExactPrint/AnnotateTypes.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/AnnotateTypes.hs
@@ -37,22 +37,11 @@
 #endif
 
 import Language.Haskell.GHC.ExactPrint.Types
--- import Language.Haskell.GHC.ExactPrint.Utils
 
--- import qualified Bag            as GHC
 #if __GLASGOW_HASKELL__ > 800
 import qualified BasicTypes     as GHC
 #endif
--- import qualified Class          as GHC
--- import qualified CoAxiom        as GHC
--- import qualified FastString     as GHC
--- import qualified ForeignCall    as GHC
 import qualified GHC            as GHC
-#if __GLASGOW_HASKELL__ > 710
--- import qualified Lexeme         as GHC
-#endif
--- import qualified Name           as GHC
--- import qualified RdrName        as GHC
 #if __GLASGOW_HASKELL__ <= 710
 import qualified BooleanFormula as GHC
 import qualified Outputable     as GHC
@@ -62,7 +51,6 @@
 import Control.Monad.Free.TH (makeFreeCon)
 import Control.Monad.Identity
 import Data.Data
--- import Data.Maybe
 
 import qualified Data.Set as Set
 
@@ -119,6 +107,9 @@
   MarkPPOptional   :: GHC.AnnKeywordId -> Maybe String                     -> next -> AnnotationF next
   MarkEOF          ::                                                         next -> AnnotationF next
   MarkExternal     :: GHC.SrcSpan -> GHC.AnnKeywordId -> String            -> next -> AnnotationF next
+#if __GLASGOW_HASKELL__ >= 800
+  MarkInstead      :: GHC.AnnKeywordId -> KeywordId                        -> next -> AnnotationF next
+#endif
   MarkOutside      :: GHC.AnnKeywordId -> KeywordId                        -> next -> AnnotationF next
   MarkInside       :: GHC.AnnKeywordId                                     -> next -> AnnotationF next
   MarkMany         :: GHC.AnnKeywordId                                     -> next -> AnnotationF next
@@ -165,6 +156,9 @@
 makeFreeCon  'MarkEOF
 makeFreeCon  'MarkPrim
 makeFreeCon  'MarkPPOptional
+#if __GLASGOW_HASKELL__ >= 800
+makeFreeCon  'MarkInstead
+#endif
 makeFreeCon  'MarkOutside
 makeFreeCon  'MarkInside
 makeFreeCon  'MarkExternal
diff --git a/src/Language/Haskell/GHC/ExactPrint/Delta.hs b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Delta.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
@@ -287,6 +287,11 @@
 tellKd :: (KeywordId, DeltaPos) -> Delta ()
 tellKd kd = tell (mempty { annKds = [kd] })
 
+#if __GLASGOW_HASKELL__ >= 804
+instance Semigroup DeltaWriter where
+  (<>) = mappend
+#endif
+
 instance Monoid DeltaWriter where
   mempty = DeltaWriter mempty mempty mempty mempty
   (DeltaWriter a b e g) `mappend` (DeltaWriter c d f h)
@@ -302,6 +307,9 @@
     go (MarkEOF next)                   = addEofAnnotation >> next
     go (MarkPrim kwid _ next)           = addDeltaAnnotation kwid >> next
     go (MarkPPOptional kwid _ next)     = addDeltaAnnotation kwid >> next
+#if __GLASGOW_HASKELL__ >= 800
+    go (MarkInstead akwid kwid next)    = addDeltaAnnotationInstead akwid kwid >> next
+#endif
     go (MarkOutside akwid kwid next)    = addDeltaAnnotationsOutside akwid kwid >> next
     go (MarkInside akwid next)          = addDeltaAnnotationsInside akwid >> next
     go (MarkMany akwid next)            = addDeltaAnnotations akwid >> next
@@ -391,19 +399,17 @@
 -- comments.
 annotationsToCommentsDelta :: [GHC.AnnKeywordId] -> Delta ()
 annotationsToCommentsDelta kws = do
-  ga <- gets apAnns
   ss <- getSrcSpan
   cs <- gets apComments
   let
-    doOne :: GHC.AnnKeywordId -> [Comment]
-    doOne kw = comments
-      where
-        spans = GHC.getAnnotation ga ss kw
-        comments = map (mkKWComment kw) spans
+    doOne :: GHC.AnnKeywordId -> Delta [Comment]
+    doOne kw = do
+      (spans,_) <- getAndRemoveAnnotationDelta ss kw
+      return $ map (mkKWComment kw) spans
     -- TODO:AZ make sure these are sorted/merged properly when the invariant for
     -- allocateComments is re-established.
-    newComments = concatMap doOne kws
-  putUnallocatedComments (cs ++ newComments)
+  newComments <- mapM doOne kws
+  putUnallocatedComments (cs ++ concat newComments)
 
 -- ---------------------------------------------------------------------
 
@@ -783,6 +789,19 @@
                     -- `debug` ("addDeltaAnnotations:do_one:(ap',ann)=" ++ showGhc (ap',ann))
   let filtered = sort $ filter (\s -> GHC.isSubspanOf s ss) ma
   mapM_ do_one filtered
+
+-- ---------------------------------------------------------------------
+#if __GLASGOW_HASKELL__ >= 800
+addDeltaAnnotationInstead :: GHC.AnnKeywordId  -> KeywordId -> Delta ()
+addDeltaAnnotationInstead ann' kw = do
+  ss <- getSrcSpan
+  (ma,ann) <- getOneAnnotationDelta ann'
+  case nub ma of -- ++AZ++ TODO: get rid of duplicates earlier
+    []     -> return () `debug` ("addDeltaAnnotation empty ma for:" ++ show (ss,ann))
+    [pa]   -> addAnnotationWorker kw pa
+    (pa:_) -> addAnnotationWorker kw pa `warn` ("addDeltaAnnotationInstead:(ss,ann,kw,ma)=" ++ showGhc (ss,ann,kw,ma))
+#endif
+-- ---------------------------------------------------------------------
 
 -- | Look up and add possibly multiple Delta annotations not enclosed by
 -- the current SrcSpan at the current position, and advance the
diff --git a/src/Language/Haskell/GHC/ExactPrint/Lookup.hs b/src/Language/Haskell/GHC/ExactPrint/Lookup.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Lookup.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Lookup.hs
@@ -148,6 +148,9 @@
       (G GHC.AnnlarrowtailU) -> "⤙"
       (G GHC.AnnrarrowtailU) -> "⤚"
 #endif
+#if __GLASGOW_HASKELL__ >= 800
+      AnnTypeApp             -> "@"
+#endif
 
 #if __GLASGOW_HASKELL__ <= 710
 -- | Tries to find a unicode equivalent to a 'KeywordId'.
diff --git a/src/Language/Haskell/GHC/ExactPrint/Parsers.hs b/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
@@ -37,6 +37,7 @@
 
         , initDynFlags
         , initDynFlagsPure
+        , parseModuleFromStringInternal
         , parseModuleApiAnnsWithCpp
         , parseModuleApiAnnsWithCppInternal
         , postParseTransform
@@ -86,7 +87,11 @@
           -> Either (GHC.SrcSpan, String) (Anns, GHC.Located w)
 parseWith dflags fileName parser s =
   case runParser parser dflags fileName s of
+#if __GLASGOW_HASKELL__ >= 804
+    GHC.PFailed _ ss m                    -> Left (ss, GHC.showSDoc dflags m)
+#else
     GHC.PFailed ss m                    -> Left (ss, GHC.showSDoc dflags m)
+#endif
     GHC.POk (mkApiAnns -> apianns) pmod -> Right (as, pmod)
       where as = relativiseApiAnns pmod apianns
 
@@ -115,7 +120,7 @@
 
 -- ---------------------------------------------------------------------
 
-parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GHC.RdrName))
+parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GhcPs))
 parseFile = runParser GHC.parseModule
 
 -- ---------------------------------------------------------------------
@@ -124,27 +129,27 @@
                 -> Either (GHC.SrcSpan, String)
                           (Anns, a)
 
-parseExpr :: Parser (GHC.LHsExpr GHC.RdrName)
+parseExpr :: Parser (GHC.LHsExpr GhcPs)
 parseExpr df fp = parseWith df fp GHC.parseExpression
 
-parseImport :: Parser (GHC.LImportDecl GHC.RdrName)
+parseImport :: Parser (GHC.LImportDecl GhcPs)
 parseImport df fp = parseWith df fp GHC.parseImport
 
-parseType :: Parser (GHC.LHsType GHC.RdrName)
+parseType :: Parser (GHC.LHsType GhcPs)
 parseType df fp = parseWith df fp GHC.parseType
 
 -- safe, see D1007
-parseDecl :: Parser (GHC.LHsDecl GHC.RdrName)
+parseDecl :: Parser (GHC.LHsDecl GhcPs)
 #if __GLASGOW_HASKELL__ <= 710
 parseDecl df fp = parseWith df fp (head . OL.fromOL <$> GHC.parseDeclaration)
 #else
 parseDecl df fp = parseWith df fp GHC.parseDeclaration
 #endif
 
-parseStmt :: Parser (GHC.ExprLStmt GHC.RdrName)
+parseStmt :: Parser (GHC.ExprLStmt GhcPs)
 parseStmt df fp = parseWith df fp GHC.parseStatement
 
-parsePattern :: Parser (GHC.LPat GHC.RdrName)
+parsePattern :: Parser (GHC.LPat GhcPs)
 parsePattern df fp = parseWith df fp GHC.parsePattern
 
 -- ---------------------------------------------------------------------
@@ -157,7 +162,7 @@
 -- parseModule = parseModuleWithCpp defaultCppOptions
 -- @
 --
--- Note: 'GHC.ParsedSource' is a synonym for 'GHC.Located' ('GHC.HsModule' 'GHC.RdrName')
+-- Note: 'GHC.ParsedSource' is a synonym for 'GHC.Located' ('GHC.HsModule' 'GhcPs')
 parseModule
   :: FilePath -> IO (Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
 parseModule = parseModuleWithCpp defaultCppOptions normalLayout
@@ -174,8 +179,21 @@
   -> IO (Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
 parseModuleFromString fp s = ghcWrapper $ do
   dflags <- initDynFlagsPure fp s
-  return $ parseWith dflags fp GHC.parseModule s
+  return $ parseModuleFromStringInternal dflags fp s
 
+-- | Internal part of 'parseModuleFromString'.
+parseModuleFromStringInternal
+  :: GHC.DynFlags
+  -> FilePath
+  -> String
+  -> Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource)
+parseModuleFromStringInternal dflags fileName str =
+  let (str1, lp) = stripLinePragmas str
+      res        = case runParser GHC.parseModule dflags fileName str1 of
+        GHC.PFailed ss m    -> Left (ss, GHC.showSDoc dflags m)
+        GHC.POk     x  pmod -> Right $ (mkApiAnns x, lp, dflags, pmod)
+  in  postParseTransform res normalLayout
+
 parseModuleWithOptions :: DeltaOptions
                        -> FilePath
                        -> IO (Either (GHC.SrcSpan, String)
@@ -247,7 +265,11 @@
         return (contents1,lp,dflags)
   return $
     case parseFile dflags' file fileContents of
+#if __GLASGOW_HASKELL__ >= 804
+      GHC.PFailed _ ss m -> Left $ (ss, (GHC.showSDoc dflags m))
+#else
       GHC.PFailed ss m -> Left $ (ss, (GHC.showSDoc dflags m))
+#endif
       GHC.POk (mkApiAnns -> apianns) pmod  ->
         Right $ (apianns, injectedComments, dflags', pmod)
 
diff --git a/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs b/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Preprocess.hs
@@ -121,7 +121,11 @@
 #else
                          $  map (tokComment . commentToAnnotation . fst) cppCommentToks
 #endif
+#if __GLASGOW_HASKELL__ >= 804
+        GHC.PFailed _ sspan err -> parseError flags2 sspan err
+#else
         GHC.PFailed sspan err -> parseError flags2 sspan err
+#endif
 
 goodComment :: Comment -> Bool
 goodComment (Comment "" _ _) = False
@@ -176,7 +180,11 @@
   let src = stripPreprocessorDirectives buf
   case GHC.lexTokenStream src startLoc flags of
     GHC.POk _ ts -> return $ GHC.addSourceToTokens startLoc src ts
+#if __GLASGOW_HASKELL__ >= 804
+    GHC.PFailed _ sspan err -> parseError flags sspan err
+#else
     GHC.PFailed sspan err -> parseError flags sspan err
+#endif
 
 -- ---------------------------------------------------------------------
 
diff --git a/src/Language/Haskell/GHC/ExactPrint/Pretty.hs b/src/Language/Haskell/GHC/ExactPrint/Pretty.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Pretty.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Pretty.hs
@@ -113,6 +113,11 @@
 
        }
 
+#if __GLASGOW_HASKELL__ >= 804
+instance Semigroup PrettyWriter where
+  (<>) = mappend
+#endif
+
 instance Monoid PrettyWriter where
   mempty = PrettyWriter mempty mempty mempty mempty mempty
   (PrettyWriter a b e g i) `mappend` (PrettyWriter c d f h j)
@@ -153,6 +158,9 @@
     go (MarkPPOptional _kwid _ next)    = next
     go (MarkEOF next)                   = addEofAnnotation >> next
     go (MarkExternal _ss akwid _ next)  = addPrettyAnnotation (G akwid) >> next
+#if __GLASGOW_HASKELL__ >= 800
+    go (MarkInstead akwid kwid next)    = addPrettyAnnotationsInstead akwid kwid >> next
+#endif
     go (MarkOutside akwid kwid next)    = addPrettyAnnotationsOutside akwid kwid >> next
     -- go (MarkOutside akwid kwid next)    = addPrettyAnnotation kwid >> next
     go (MarkInside akwid next)          = addPrettyAnnotationsInside akwid >> next
@@ -200,55 +208,68 @@
   _ <- debugP ("Pretty.addPrettyAnnotation:=" ++ showGhc (ann,noPrec,ctx)) $ asks prContext
   let
     dp = case ann of
-           (G GHC.AnnAs)        -> tellKd (ann,DP (0,1))
-           (G GHC.AnnAt)        -> tellKd (ann,DP (0,1))
-           (G GHC.AnnBang)      -> tellKd (ann,DP (0,1))
-           (G GHC.AnnBackquote) -> tellKd (ann,DP (0,1))
-           (G GHC.AnnBy)        -> tellKd (ann,DP (0,1))
-           (G GHC.AnnCase )     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnClass)     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnClose)     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnCloseC)    -> tellKd (ann,DP (0,0))
-           (G GHC.AnnDcolon)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnDeriving)  -> tellKd (ann,DP (0,1))
-           (G GHC.AnnDo)        -> tellKd (ann,DP (0,1))
-           (G GHC.AnnElse)      -> tellKd (ann,DP (1,2))
-           (G GHC.AnnEqual)     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnExport)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnFamily)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnForall)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnGroup)     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnHiding)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnImport)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnIf)        -> tellKd (ann,DP (0,1))
-           (G GHC.AnnIn)        -> tellKd (ann,DP (1,0))
-           (G GHC.AnnInstance)  -> tellKd (ann,DP (0,1))
-           (G GHC.AnnLam)       -> tellKd (ann,DP (0,1))
-           (G GHC.AnnMinus)     -> tellKd (ann,DP (0,1)) -- need to separate from preceding operator
-           (G GHC.AnnModule)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnOf)        -> tellKd (ann,DP (0,1))
-           (G GHC.AnnOpenC)     -> tellKd (ann,DP (0,0))
-           (G GHC.AnnOpenPE)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnQualified) -> tellKd (ann,DP (0,1))
-           (G GHC.AnnRarrow)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnRole)      -> tellKd (ann,DP (0,1))
-           (G GHC.AnnSafe)      -> tellKd (ann,DP (0,1))
-           (G GHC.AnnSimpleQuote) -> tellKd (ann,DP (0,1))
-           (G GHC.AnnThTyQuote) -> tellKd (ann,DP (0,1))
-           (G GHC.AnnThen)      -> tellKd (ann,DP (1,2))
-           (G GHC.AnnTilde)     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnType)      -> tellKd (ann,DP (0,1))
-           (G GHC.AnnUsing)     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnVal)       -> tellKd (ann,DP (0,1))
-           (G GHC.AnnValStr)    -> tellKd (ann,DP (0,1))
-           (G GHC.AnnVbar)      -> tellKd (ann,DP (0,1))
-           -- (G GHC.AnnWhere)     -> tellKd (ann,DP (0,1))
-           (G GHC.AnnWhere)     -> tellKd (ann,DP (1,2))
+           (G GHC.AnnAs)           -> tellKd (ann,DP (0,1))
+           (G GHC.AnnAt)           -> tellKd (ann,DP (0,0))
+           (G GHC.AnnBackquote)    -> tellKd (ann,DP (0,1))
+           (G GHC.AnnBang)         -> tellKd (ann,DP (0,1))
+           (G GHC.AnnBy)           -> tellKd (ann,DP (0,1))
+           (G GHC.AnnCase )        -> tellKd (ann,DP (0,1))
+           (G GHC.AnnClass)        -> tellKd (ann,DP (0,1))
+           (G GHC.AnnClose)        -> tellKd (ann,DP (0,1))
+           (G GHC.AnnCloseC)       -> tellKd (ann,DP (0,0))
+           (G GHC.AnnDcolon)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnDeriving)     -> tellKd (ann,DP (0,1))
+           (G GHC.AnnDo)           -> tellKd (ann,DP (0,1))
+           (G GHC.AnnElse)         -> tellKd (ann,DP (1,2))
+           (G GHC.AnnEqual)        -> tellKd (ann,DP (0,1))
+           (G GHC.AnnExport)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnFamily)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnForall)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnGroup)        -> tellKd (ann,DP (0,1))
+           (G GHC.AnnHiding)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnIf)           -> tellKd (ann,DP (0,1))
+           (G GHC.AnnImport)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnIn)           -> tellKd (ann,DP (1,0))
+           (G GHC.AnnInstance)     -> tellKd (ann,DP (0,1))
+           (G GHC.AnnLam)          -> tellKd (ann,DP (0,1))
+           (G GHC.AnnMinus)        -> tellKd (ann,DP (0,1)) -- need to separate from preceding operator
+           (G GHC.AnnModule)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnOf)           -> tellKd (ann,DP (0,1))
+           (G GHC.AnnOpenC)        -> tellKd (ann,DP (0,0))
+           (G GHC.AnnOpenPE)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnOpenPTE)      -> tellKd (ann,DP (0,1))
+           (G GHC.AnnQualified)    -> tellKd (ann,DP (0,1))
+           (G GHC.AnnRarrow)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnRole)         -> tellKd (ann,DP (0,1))
+           (G GHC.AnnSafe)         -> tellKd (ann,DP (0,1))
+           (G GHC.AnnSimpleQuote)  -> tellKd (ann,DP (0,1))
+           (G GHC.AnnThIdSplice)   -> tellKd (ann,DP (0,1))
+           (G GHC.AnnThIdTySplice) -> tellKd (ann,DP (0,1))
+           (G GHC.AnnThTyQuote)    -> tellKd (ann,DP (0,1))
+           (G GHC.AnnThen)         -> tellKd (ann,DP (1,2))
+           (G GHC.AnnTilde)        -> tellKd (ann,DP (0,1))
+           (G GHC.AnnType)         -> tellKd (ann,DP (0,1))
+           (G GHC.AnnUsing)        -> tellKd (ann,DP (0,1))
+           (G GHC.AnnVal)          -> tellKd (ann,DP (0,1))
+           (G GHC.AnnValStr)       -> tellKd (ann,DP (0,1))
+           (G GHC.AnnVbar)         -> tellKd (ann,DP (0,1))
+           (G GHC.AnnWhere)        -> tellKd (ann,DP (1,2))
+#if __GLASGOW_HASKELL__ >= 800
+           AnnTypeApp              -> tellKd (ann,DP (0,1))
+#endif
            _ ->                tellKd (ann,DP (0,0))
   fromNoPrecedingSpace (tellKd (ann,DP (0,0))) dp
 
 -- ---------------------------------------------------------------------
 
+#if __GLASGOW_HASKELL__ >= 800
+addPrettyAnnotationsInstead :: GHC.AnnKeywordId -> KeywordId -> Pretty ()
+addPrettyAnnotationsInstead _akwid AnnSemiSep = return ()
+addPrettyAnnotationsInstead _akwid kwid = addPrettyAnnotation kwid
+#endif
+
+-- ---------------------------------------------------------------------
+
 addPrettyAnnotationsOutside :: GHC.AnnKeywordId -> KeywordId -> Pretty ()
 addPrettyAnnotationsOutside _akwid AnnSemiSep = return ()
 addPrettyAnnotationsOutside _akwid kwid = addPrettyAnnotation kwid
@@ -321,7 +342,6 @@
     let cs = []
 #endif
 
-    -- uncs <- getUnallocatedComments
     -- ctx <- debugP ("Pretty.withAST:cs:(ss,cs,uncs)=" ++ showGhc (ss,cs,uncs)) $ asks prContext
     ctx <- asks prContext
 
@@ -379,7 +399,6 @@
               && not (inAcs (Set.singleton TopLevel) ctx)
     inList = inAcs (Set.singleton ListItem) ctx
     inLambda = inAcs (Set.singleton LambdaExpr) ctx
-
 
     grhs :: GHC.GRHS GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Pretty DeltaPos
     grhs _ = do
diff --git a/src/Language/Haskell/GHC/ExactPrint/Print.hs b/src/Language/Haskell/GHC/ExactPrint/Print.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Print.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Print.hs
@@ -30,7 +30,6 @@
 import Language.Haskell.GHC.ExactPrint.Annotate
 import Language.Haskell.GHC.ExactPrint.Lookup
 
--- import Control.Exception
 import Control.Monad.Identity
 import Control.Monad.RWS
 import Control.Monad.Trans.Free
@@ -105,6 +104,11 @@
 data EPWriter a = EPWriter
               { output :: !a }
 
+#if __GLASGOW_HASKELL__ >= 804
+instance Monoid w => Semigroup (EPWriter w) where
+  (<>) = mappend
+#endif
+
 instance Monoid w => Monoid (EPWriter w) where
   mempty = EPWriter mempty
   (EPWriter a) `mappend` (EPWriter b) = EPWriter (a <> b)
@@ -156,6 +160,10 @@
       markPrim (G kwid) mstr >> next
     go (MarkPPOptional kwid mstr next) =
       markPrim (G kwid) mstr >> next
+#if __GLASGOW_HASKELL__ >= 800
+    go (MarkInstead _ kwid next) =
+      printStringAtMaybeAnnAll kwid Nothing  >> next
+#endif
     go (MarkOutside _ kwid next) =
       printStringAtMaybeAnnAll kwid Nothing  >> next
     go (MarkInside akwid next) =
diff --git a/src/Language/Haskell/GHC/ExactPrint/Transform.hs b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Transform.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Transform.hs
@@ -263,13 +263,13 @@
 -- ---------------------------------------------------------------------
 
 -- |Convert a 'GHC.LSig' into a 'GHC.LHsDecl'
-wrapSig :: GHC.LSig GHC.RdrName -> GHC.LHsDecl GHC.RdrName
+wrapSig :: GHC.LSig GhcPs -> GHC.LHsDecl GhcPs
 wrapSig (GHC.L l s) = GHC.L l (GHC.SigD s)
 
 -- ---------------------------------------------------------------------
 
 -- |Convert a 'GHC.LHsBind' into a 'GHC.LHsDecl'
-wrapDecl :: GHC.LHsBind GHC.RdrName -> GHC.LHsDecl GHC.RdrName
+wrapDecl :: GHC.LHsBind GhcPs -> GHC.LHsDecl GhcPs
 wrapDecl (GHC.L l s) = GHC.L l (GHC.ValD s)
 
 -- ---------------------------------------------------------------------
@@ -322,7 +322,7 @@
 -- ---------------------------------------------------------------------
 
 -- |'Transform' monad version of 'setPrecedingLinesDecl'
-setPrecedingLinesDeclT :: (Monad m) => GHC.LHsDecl GHC.RdrName -> Int -> Int -> TransformT m ()
+setPrecedingLinesDeclT :: (Monad m) => GHC.LHsDecl GhcPs -> Int -> Int -> TransformT m ()
 setPrecedingLinesDeclT ld n c =
   modifyAnnsT (setPrecedingLinesDecl ld n c)
 
@@ -349,7 +349,7 @@
 
 -- |Unwrap a HsDecl and call setPrecedingLines on it
 -- ++AZ++ TODO: get rid of this, it is a synonym only
-setPrecedingLinesDecl :: GHC.LHsDecl GHC.RdrName -> Int -> Int -> Anns -> Anns
+setPrecedingLinesDecl :: GHC.LHsDecl GhcPs -> Int -> Int -> Anns -> Anns
 setPrecedingLinesDecl ld n c ans = setPrecedingLines ld n c ans
 
 -- ---------------------------------------------------------------------
@@ -457,10 +457,10 @@
   -- ++AZ++ : replace the nested casts with appropriate SYB.gmapM
   -- logTr $ "balanceComments entered"
   -- logDataWithAnnsTr "first" first
-  case cast first :: Maybe (GHC.LHsDecl GHC.RdrName) of
+  case cast first :: Maybe (GHC.LHsDecl GhcPs) of
     Just (GHC.L l (GHC.ValD fb@(GHC.FunBind{}))) -> do
       balanceCommentsFB (GHC.L l fb) second
-    _ -> case cast first :: Maybe (GHC.LHsBind GHC.RdrName) of
+    _ -> case cast first :: Maybe (GHC.LHsBind GhcPs) of
       Just fb'@(GHC.L _ (GHC.FunBind{})) -> do
         balanceCommentsFB fb' second
       _ -> balanceComments' first second
@@ -492,7 +492,7 @@
 -- |Once 'balanceComments' has been called to move trailing comments to a
 -- 'GHC.FunBind', these need to be pushed down from the top level to the last
 -- 'GHC.Match' if that 'GHC.Match' needs to be manipulated.
-balanceCommentsFB :: (Data b,Monad m) => GHC.LHsBind GHC.RdrName -> GHC.Located b -> TransformT m ()
+balanceCommentsFB :: (Data b,Monad m) => GHC.LHsBind GhcPs -> GHC.Located b -> TransformT m ()
 #if __GLASGOW_HASKELL__ <= 710
 balanceCommentsFB (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) second = do
 #else
@@ -559,11 +559,11 @@
 -- |Insert a declaration into an AST element having sub-declarations
 -- (@HasDecls@) according to the given location function.
 insertAt :: (HasDecls (GHC.Located ast))
-              => (GHC.LHsDecl GHC.RdrName
-                  -> [GHC.LHsDecl GHC.RdrName]
-                  -> [GHC.LHsDecl GHC.RdrName])
+              => (GHC.LHsDecl GhcPs
+                  -> [GHC.LHsDecl GhcPs]
+                  -> [GHC.LHsDecl GhcPs])
               -> GHC.Located ast
-              -> GHC.LHsDecl GHC.RdrName
+              -> GHC.LHsDecl GhcPs
               -> Transform (GHC.Located ast)
 insertAt f t decl = do
   oldDecls <- hsDecls t
@@ -573,7 +573,7 @@
 -- AST item
 insertAtStart, insertAtEnd :: (HasDecls (GHC.Located ast))
               => GHC.Located ast
-              -> GHC.LHsDecl GHC.RdrName
+              -> GHC.LHsDecl GhcPs
               -> Transform (GHC.Located ast)
 
 insertAtStart = insertAt (:)
@@ -584,7 +584,7 @@
 insertAfter, insertBefore :: (HasDecls (GHC.Located ast))
                           => GHC.Located old
                           -> GHC.Located ast
-                          -> GHC.LHsDecl GHC.RdrName
+                          -> GHC.LHsDecl GhcPs
                           -> Transform (GHC.Located ast)
 insertAfter (GHC.getLoc -> k) = insertAt findAfter
   where
@@ -610,7 +610,7 @@
     -- given syntax phrase. They are always returned in the wrapped 'GHC.HsDecl'
     -- form, even if orginating in local decls. This is safe, as annotations
     -- never attach to the wrapper, only to the wrapped item.
-    hsDecls :: (Monad m) => t -> TransformT m [GHC.LHsDecl GHC.RdrName]
+    hsDecls :: (Monad m) => t -> TransformT m [GHC.LHsDecl GhcPs]
 
     -- | Replace the directly enclosed decl list by the given
     --  decl list. Runs in the 'Transform' monad to be able to update list order
@@ -631,7 +631,7 @@
     --   where
     --     nn = 2
     -- @
-    replaceDecls :: (Monad m) => t -> [GHC.LHsDecl GHC.RdrName] -> TransformT m t
+    replaceDecls :: (Monad m) => t -> [GHC.LHsDecl GhcPs] -> TransformT m t
 
 -- ---------------------------------------------------------------------
 
@@ -645,16 +645,24 @@
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where
-#if __GLASGOW_HASKELL__ <= 710
+instance HasDecls (GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)) where
+#if __GLASGOW_HASKELL__ >= 804
+  hsDecls d@(GHC.L _ (GHC.Match _ _ (GHC.GRHSs _ (GHC.L _ lb)))) = do
+#elif __GLASGOW_HASKELL__ >= 800
+  hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ (GHC.L _ lb)))) = do
+#elif __GLASGOW_HASKELL__ >= 710
   hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ lb))) = do
 #else
-  hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ (GHC.L _ lb)))) = do
+  hsDecls d@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ lb))) = do
 #endif
     decls <- hsDeclsValBinds lb
     orderedDecls d decls
 
+#if __GLASGOW_HASKELL__ >= 804
+  replaceDecls m@(GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds))) []
+#else
   replaceDecls m@(GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds))) []
+#endif
     = do
         logTr "replaceDecls LMatch"
         let
@@ -676,9 +684,17 @@
         binds'' <- replaceDeclsValbinds (GHC.unLoc binds) []
         let binds' = GHC.L (GHC.getLoc binds) binds''
 #endif
+#if __GLASGOW_HASKELL__ >= 804
+        return (GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds')))
+#else
         return (GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds')))
+#endif
 
+#if __GLASGOW_HASKELL__ >= 804
+  replaceDecls m@(GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds))) newBinds
+#else
   replaceDecls m@(GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds))) newBinds
+#endif
     = do
         logTr "replaceDecls LMatch"
         -- Need to throw in a fresh where clause if the binds were empty,
@@ -713,11 +729,15 @@
         let binds' = GHC.L (GHC.getLoc binds) binds''
 #endif
         -- logDataWithAnnsTr "Match.replaceDecls:binds'" binds'
+#if __GLASGOW_HASKELL__ >= 804
+        return (GHC.L l (GHC.Match c p (GHC.GRHSs rhs binds')))
+#else
         return (GHC.L l (GHC.Match mf p t (GHC.GRHSs rhs binds')))
+#endif
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.LHsExpr GHC.RdrName) where
+instance HasDecls (GHC.LHsExpr GhcPs) where
 #if __GLASGOW_HASKELL__ <= 710
   hsDecls ls@(GHC.L _ (GHC.HsLet decls _ex)) = do
 #else
@@ -743,7 +763,7 @@
         logTr "replaceDecls HsPar"
         e' <- replaceDecls e newDecls
         return (GHC.L l (GHC.HsPar e'))
-  replaceDecls old _new = error $ "replaceDecls (GHC.LHsExpr GHC.RdrName) undefined for:" ++ showGhc old
+  replaceDecls old _new = error $ "replaceDecls (GHC.LHsExpr GhcPs) undefined for:" ++ showGhc old
 
 -- ---------------------------------------------------------------------
 
@@ -751,7 +771,7 @@
 -- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
 -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
 -- idempotent.
-hsDeclsPatBindD :: (Monad m) => GHC.LHsDecl GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+hsDeclsPatBindD :: (Monad m) => GHC.LHsDecl GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
 hsDeclsPatBindD (GHC.L l (GHC.ValD d)) = hsDeclsPatBind (GHC.L l d)
 hsDeclsPatBindD x = error $ "hsDeclsPatBindD called for:" ++ showGhc x
 
@@ -759,7 +779,7 @@
 -- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
 -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
 -- idempotent.
-hsDeclsPatBind :: (Monad m) => GHC.LHsBind GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+hsDeclsPatBind :: (Monad m) => GHC.LHsBind GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
 #if __GLASGOW_HASKELL__ <= 710
 hsDeclsPatBind d@(GHC.L _ (GHC.PatBind _ (GHC.GRHSs _grhs lb) _ _ _)) = do
 #else
@@ -775,8 +795,8 @@
 -- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
 -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBindD' \/ 'replaceDeclsPatBindD' is
 -- idempotent.
-replaceDeclsPatBindD :: (Monad m) => GHC.LHsDecl GHC.RdrName -> [GHC.LHsDecl GHC.RdrName]
-                     -> TransformT m (GHC.LHsDecl GHC.RdrName)
+replaceDeclsPatBindD :: (Monad m) => GHC.LHsDecl GhcPs -> [GHC.LHsDecl GhcPs]
+                     -> TransformT m (GHC.LHsDecl GhcPs)
 replaceDeclsPatBindD (GHC.L l (GHC.ValD d)) newDecls = do
   (GHC.L _ d') <- replaceDeclsPatBind (GHC.L l d) newDecls
   return (GHC.L l (GHC.ValD d'))
@@ -786,8 +806,8 @@
 -- cannot be a member of 'HasDecls' because a 'GHC.FunBind' is not idempotent
 -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is
 -- idempotent.
-replaceDeclsPatBind :: (Monad m) => GHC.LHsBind GHC.RdrName -> [GHC.LHsDecl GHC.RdrName]
-                    -> TransformT m (GHC.LHsBind GHC.RdrName)
+replaceDeclsPatBind :: (Monad m) => GHC.LHsBind GhcPs -> [GHC.LHsDecl GhcPs]
+                    -> TransformT m (GHC.LHsBind GhcPs)
 replaceDeclsPatBind p@(GHC.L l (GHC.PatBind a (GHC.GRHSs rhss binds) b c d)) newDecls
     = do
         logTr "replaceDecls PatBind"
@@ -824,7 +844,7 @@
 
 -- ---------------------------------------------------------------------
 
-instance HasDecls (GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where
+instance HasDecls (GHC.LStmt GhcPs (GHC.LHsExpr GhcPs)) where
 #if __GLASGOW_HASKELL__ <= 710
   hsDecls ls@(GHC.L _ (GHC.LetStmt lb))       = do
 #else
@@ -897,7 +917,7 @@
 hasDeclsSybTransform :: (SYB.Data t2,Monad m)
        => (forall t. HasDecls t => t -> m t)
              -- ^Worker function for the general case
-       -> (GHC.LHsBind GHC.RdrName -> m (GHC.LHsBind GHC.RdrName))
+       -> (GHC.LHsBind GhcPs -> m (GHC.LHsBind GhcPs))
              -- ^Worker function for FunBind/PatBind
        -> t2 -- ^Item to be updated
        -> m t2
@@ -912,16 +932,16 @@
 
     parsedSource (p::GHC.ParsedSource) = workerHasDecls p
 
-    lmatch (lm::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
+    lmatch (lm::GHC.LMatch GhcPs (GHC.LHsExpr GhcPs))
       = workerHasDecls lm
 
-    lexpr (le::GHC.LHsExpr GHC.RdrName)
+    lexpr (le::GHC.LHsExpr GhcPs)
       = workerHasDecls le
 
-    lstmt (d::GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName))
+    lstmt (d::GHC.LStmt GhcPs (GHC.LHsExpr GhcPs))
       = workerHasDecls d
 
-    lhsbind (b@(GHC.L _ GHC.FunBind{}):: GHC.LHsBind GHC.RdrName)
+    lhsbind (b@(GHC.L _ GHC.FunBind{}):: GHC.LHsBind GhcPs)
       = workerBind b
     lhsbind b@(GHC.L _ GHC.PatBind{})
       = workerBind b
@@ -938,7 +958,7 @@
 -- return anything for these as there is not meaningful 'replaceDecls' for it.
 -- This function provides a version of 'hsDecls' that returns the 'GHC.FunBind'
 -- decls too, where they are needed for analysis only.
-hsDeclsGeneric :: (SYB.Data t,Monad m) => t -> TransformT m [GHC.LHsDecl GHC.RdrName]
+hsDeclsGeneric :: (SYB.Data t,Monad m) => t -> TransformT m [GHC.LHsDecl GhcPs]
 hsDeclsGeneric t = q t
   where
     q = return []
@@ -953,15 +973,15 @@
 
     parsedSource (p::GHC.ParsedSource) = hsDecls p
 
-    lmatch (lm::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = hsDecls lm
+    lmatch (lm::GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)) = hsDecls lm
 
-    lexpr (le::GHC.LHsExpr GHC.RdrName) = hsDecls le
+    lexpr (le::GHC.LHsExpr GhcPs) = hsDecls le
 
-    lstmt (d::GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = hsDecls d
+    lstmt (d::GHC.LStmt GhcPs (GHC.LHsExpr GhcPs)) = hsDecls d
 
     -- ---------------------------------
 
-    lhsbind :: (Monad m) => GHC.LHsBind GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+    lhsbind :: (Monad m) => GHC.LHsBind GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
 #if __GLASGOW_HASKELL__ <= 710
     lhsbind (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) = do
 #else
@@ -980,18 +1000,18 @@
 
     -- ---------------------------------
 
-    llocalbinds :: (Monad m) => GHC.Located (GHC.HsLocalBinds GHC.RdrName) -> TransformT m [GHC.LHsDecl GHC.RdrName]
+    llocalbinds :: (Monad m) => GHC.Located (GHC.HsLocalBinds GhcPs) -> TransformT m [GHC.LHsDecl GhcPs]
     llocalbinds (GHC.L _ ds) = localbinds ds
 
     -- ---------------------------------
 
-    localbinds :: (Monad m) => GHC.HsLocalBinds GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+    localbinds :: (Monad m) => GHC.HsLocalBinds GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
     localbinds d = hsDeclsValBinds d
 
 -- ---------------------------------------------------------------------
 
 -- |Look up the annotated order and sort the decls accordingly
-orderedDecls :: (Data a,Monad m) => GHC.Located a -> [GHC.LHsDecl GHC.RdrName] -> TransformT m [GHC.LHsDecl GHC.RdrName]
+orderedDecls :: (Data a,Monad m) => GHC.Located a -> [GHC.LHsDecl GhcPs] -> TransformT m [GHC.LHsDecl GhcPs]
 orderedDecls parent decls = do
   ans <- getAnnsT
   case getAnnotationEP parent ans of
@@ -1010,7 +1030,7 @@
 -- care, as this does not necessarily return the declarations in order, the
 -- ordering should be done by the calling function from the 'GHC.HsLocalBinds'
 -- context in the AST.
-hsDeclsValBinds :: (Monad m) => GHC.HsLocalBinds GHC.RdrName -> TransformT m [GHC.LHsDecl GHC.RdrName]
+hsDeclsValBinds :: (Monad m) => GHC.HsLocalBinds GhcPs -> TransformT m [GHC.LHsDecl GhcPs]
 hsDeclsValBinds lb = case lb of
     GHC.HsValBinds (GHC.ValBindsIn bs sigs) -> do
       let
@@ -1026,8 +1046,8 @@
 -- ordering should be done by the calling function from the 'GHC.HsLocalBinds'
 -- context in the AST.
 replaceDeclsValbinds :: (Monad m)
-                     => GHC.HsLocalBinds GHC.RdrName -> [GHC.LHsDecl GHC.RdrName]
-                     -> TransformT m (GHC.HsLocalBinds GHC.RdrName)
+                     => GHC.HsLocalBinds GhcPs -> [GHC.LHsDecl GhcPs]
+                     -> TransformT m (GHC.HsLocalBinds GhcPs)
 replaceDeclsValbinds _ [] = do
   return (GHC.EmptyLocalBinds)
 replaceDeclsValbinds (GHC.HsValBinds _b) new
@@ -1048,8 +1068,8 @@
 
 -- ---------------------------------------------------------------------
 
-type Decl  = GHC.LHsDecl GHC.RdrName
-type Match = GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)
+type Decl  = GHC.LHsDecl GhcPs
+type Match = GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)
 
 -- |Modify a 'GHC.LHsBind' wrapped in a 'GHC.ValD'. For a 'GHC.PatBind' the
 -- declarations are extracted and returned after modification. For a
@@ -1097,7 +1117,7 @@
 
 -- | Apply a transformation to the decls contained in @t@
 modifyDeclsT :: (HasDecls t,HasTransform m)
-             => ([GHC.LHsDecl GHC.RdrName] -> m [GHC.LHsDecl GHC.RdrName])
+             => ([GHC.LHsDecl GhcPs] -> m [GHC.LHsDecl GhcPs])
              -> t -> m t
 modifyDeclsT action t = do
   decls <- liftT $ hsDecls t
diff --git a/src/Language/Haskell/GHC/ExactPrint/Types.hs b/src/Language/Haskell/GHC/ExactPrint/Types.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Types.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Types.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -32,11 +33,15 @@
   , ACS'(..)
   , ListContexts(..)
 
+  -- * GHC version compatibility
+  , GhcPs
+  , GhcRn
+  , GhcTc
+
   -- * Internal Types
   , LayoutStartCol(..)
   , declFun
 
-
   ) where
 
 import Data.Data (Data, Typeable, toConstr,cast)
@@ -154,10 +159,21 @@
 mkAnnKeyPrim :: (Data a) => GHC.Located a -> AnnKey
 mkAnnKeyPrim (GHC.L l a) = AnnKey l (annGetConstr a)
 
+
+#if __GLASGOW_HASKELL__ <= 802
+type GhcPs = GHC.RdrName
+type GhcRn = GHC.Name
+type GhcTc = GHC.Id
+#else
+type GhcPs = GHC.GhcPs
+type GhcRn = GHC.GhcRn
+type GhcTc = GHC.GhcTc
+#endif
+
 -- |Make an unwrapped @AnnKey@ for the @LHsDecl@ case, a normal one otherwise.
 mkAnnKey :: (Data a) => GHC.Located a -> AnnKey
 mkAnnKey ld =
-  case cast ld :: Maybe (GHC.LHsDecl GHC.RdrName) of
+  case cast ld :: Maybe (GHC.LHsDecl GhcPs) of
     Just d -> declFun mkAnnKeyPrim d
     Nothing -> mkAnnKeyPrim ld
 
@@ -175,7 +191,10 @@
 -- | The different syntactic elements which are not represented in the
 -- AST.
 data KeywordId = G GHC.AnnKeywordId  -- ^ A normal keyword
-               | AnnSemiSep          -- ^ A seperating comma
+               | AnnSemiSep          -- ^ A separating comma
+#if __GLASGOW_HASKELL__ >= 800
+               | AnnTypeApp          -- ^ Visible type application annotation
+#endif
                | AnnComment Comment
                | AnnString String    -- ^ Used to pass information from
                                      -- Delta to Print when we have to work
@@ -189,6 +208,9 @@
 instance Show KeywordId where
   show (G gc)          = "(G " ++ show gc ++ ")"
   show AnnSemiSep      = "AnnSemiSep"
+#if __GLASGOW_HASKELL__ >= 800
+  show AnnTypeApp      = "AnnTypeApp"
+#endif
   show (AnnComment dc) = "(AnnComment " ++ show dc ++ ")"
   show (AnnString s)   = "(AnnString " ++ s ++ ")"
 #if __GLASGOW_HASKELL__ <= 710
@@ -259,6 +281,11 @@
                             -- propagate down the AST. Removed when it hits zero
   } deriving (Show)
 
+#if __GLASGOW_HASKELL__ >= 804
+instance Semigroup (ACS' AstContext) where
+  (<>) = mappend
+#endif
+
 instance Monoid (ACS' AstContext) where
   mempty = ACS mempty
   -- ACS a `mappend` ACS b = ACS (a `mappend` b)
@@ -327,7 +354,7 @@
 
 -- ---------------------------------------------------------------------
 
-declFun :: (forall a . Data a => GHC.Located a -> b) -> GHC.LHsDecl GHC.RdrName -> b
+declFun :: (forall a . Data a => GHC.Located a -> b) -> GHC.LHsDecl GhcPs -> b
 declFun f (GHC.L l de) =
   case de of
       GHC.TyClD d       -> f (GHC.L l d)
diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
--- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
@@ -538,11 +538,11 @@
         -- overLit :: GHC.HsOverLit GHC.RdrName -> String
         -- overLit    = ("{HsOverLit:"++) . (++"}") . showSDoc_ . GHC.ppr
 
-        bagRdrName:: GHC.Bag (GHC.Located (GHC.HsBind GHC.RdrName)) -> String
+        bagRdrName:: GHC.Bag (GHC.Located (GHC.HsBind GhcPs)) -> String
         bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}") . list . GHC.bagToList
-        bagName   :: GHC.Bag (GHC.Located (GHC.HsBind GHC.Name)) -> String
+        bagName   :: GHC.Bag (GHC.Located (GHC.HsBind GhcRn)) -> String
         bagName    = ("{Bag(Located (HsBind Name)): "++) . (++"}") . list . GHC.bagToList
-        bagVar    :: GHC.Bag (GHC.Located (GHC.HsBind GHC.Var)) -> String
+        bagVar    :: GHC.Bag (GHC.Located (GHC.HsBind GhcTc)) -> String
         bagVar     = ("{Bag(Located (HsBind Var)): "++) . (++"}") . list . GHC.bagToList
 
 #if __GLASGOW_HASKELL__ > 800
diff --git a/tests/Static.hs b/tests/Static.hs
--- a/tests/Static.hs
+++ b/tests/Static.hs
@@ -69,7 +69,7 @@
       writeFile (failuresHtmlDir </> out) (mkPage fname (ppDiff diff) prev next original res)
   where
     tokenize :: String -> [[String]]
-    tokenize s = map (:[]) . lines $ s
+    -- tokenize s = map (:[]) . lines $ s
 
 mkPage :: FilePath -> String -> String -> String -> String -> String -> String
 mkPage filename diff prev next original printed  =
diff --git a/tests/Test.hs b/tests/Test.hs
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -28,11 +28,13 @@
 
 -- ---------------------------------------------------------------------
 
-data GHCVersion = GHC710 | GHC80 | GHC82 deriving (Eq, Ord, Show)
+data GHCVersion = GHC710 | GHC80 | GHC82 | GHC84 deriving (Eq, Ord, Show)
 
 ghcVersion :: GHCVersion
 ghcVersion =
-#if __GLASGOW_HASKELL__ > 800
+#if __GLASGOW_HASKELL__ > 802
+  GHC84
+#elif __GLASGOW_HASKELL__ > 800
   GHC82
 #elif __GLASGOW_HASKELL__ >= 711
   GHC80
@@ -47,9 +49,10 @@
     GHC710 -> ["ghc710-only","ghc710"]
     GHC80  -> ["ghc710", "ghc80"]
     GHC82  -> ["ghc710", "ghc80", "ghc82"]
-    -- GHC82  -> ["ghc82-ghc-test"]
-    -- GHC82  -> ["ghc82-ghc-backups-rename"]
-    -- GHC82  -> ["ghc82"]
+    GHC84  -> ["ghc710", "ghc80", "ghc82", "ghc84" ]
+    -- GHC84  -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc84-copied"]
+    -- GHC84  -> ["ghc84-copied"]
+    -- GHC84  -> ["ghc84"]
 
 -- ---------------------------------------------------------------------
 
@@ -129,8 +132,13 @@
   roundTripTests <- findTests
   prettyRoundTripTests <- findPrettyTests
   return $ TestList [
-                      internalTests, roundTripTests, transformTests, failingTests, noAnnotationTests
+                      internalTests,
+                      roundTripTests
                     ,
+                      transformTests
+                    , failingTests
+                    , noAnnotationTests
+                    ,
                       prettyRoundTripTests
                     ]
 
@@ -141,15 +149,16 @@
   [
   -- Tests requiring future GHC modifications
     mkTestModBad "InfixOperator.hs"
-  , mkTestModBad "CtorOp.hs" -- Should be fixed in GHC 8.4
 
-#if __GLASGOW_HASKELL__ > 800
+#if __GLASGOW_HASKELL__ > 802
+#elif __GLASGOW_HASKELL__ > 800
   , mkTestModBad "overloadedlabelsrun04.hs"
 #elif __GLASGOW_HASKELL__ > 710
   , mkTestModBad "overloadedlabelsrun04.hs"
   , mkTestModBad "TensorTests.hs" -- Should be fixed in GHC 8.2
   , mkTestModBad "List2.hs"       -- Should be fixed in GHC 8.2
 #else
+  , mkTestModBad "CtorOp.hs" -- Should be fixed in GHC 8.4
   , mkTestModBad "UnicodeSyntax.hs"
   , mkTestModBad "UnicodeRules.hs"
   , mkTestModBad "Deprecation.hs"
@@ -187,9 +196,31 @@
       -- mkPrettyRoundtrip "ghc80" "pmc007.hs"
       -- mkPrettyRoundtrip "ghc80" "MultiQuote.hs"
       -- mkPrettyRoundtrip "ghc80" "T10689a.hs"
-      -- mkPrettyRoundtrip "ghc710" "Ann01.hs"
 
-       mkParserTest "ghc82" "T13594.hs"
+      -- mkPrettyRoundtrip "ghc82" "TensorTests.hs"
+
+   --    mkParserTest      "ghc84" "Main.hs"
+      -- mkParserTest      "ghc84" "Types.hs"
+    -- , mkPrettyRoundtrip "ghc80" "BundleExport.hs"
+    -- , mkPrettyRoundtrip "ghc80" "ExportSyntax.hs"
+    -- , mkPrettyRoundtrip "ghc80" "export-class.hs"
+    -- , mkPrettyRoundtrip "ghc80" "export-syntax.hs"
+    -- , mkPrettyRoundtrip "ghc80" "export-type.hs"
+
+      -- mkPrettyRoundtrip "ghc84" "Main.hs"
+      -- mkPrettyRoundtrip "ghc84" "Types.hs"
+
+      mkPrettyRoundtrip "ghc80" "Vta1.hs"
+    , mkPrettyRoundtrip "ghc80" "Vta2.hs"
+
+      -- mkParserTest      "ghc80" "BundleExport.hs"
+
+    -- , mkParserTest      "ghc710" "TypeOperators.hs"
+    -- , mkParserTest      "ghc80" "TestUtils.hs"
+
+     --   mkParserTest "ghc84" "Functors.hs"
+     -- , mkParserTest "ghc80" "MonadT.hs"
+
       -- mkParserTest "ghc80" "SemicolonIf.hs"
       -- mkParserTest "ghc80" "T10689a.hs"
       -- mkParserTest "ghc80" "MonadT.hs"
diff --git a/tests/Test/Common.hs b/tests/Test/Common.hs
--- a/tests/Test/Common.hs
+++ b/tests/Test/Common.hs
@@ -29,6 +29,7 @@
 import Language.Haskell.GHC.ExactPrint.Utils
 import Language.Haskell.GHC.ExactPrint.Parsers (parseModuleApiAnnsWithCpp)
 import Language.Haskell.GHC.ExactPrint.Preprocess
+import Language.Haskell.GHC.ExactPrint.Types
 
 
 import qualified ApiAnnotation as GHC
@@ -92,7 +93,7 @@
       buffer = GHC.stringToStringBuffer str
       parseState = GHC.mkPState flags buffer location
 
-parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GHC.RdrName))
+parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GhcPs))
 parseFile = runParser GHC.parseModule
 
 mkApiAnns :: GHC.PState -> GHC.ApiAnns
@@ -177,7 +178,7 @@
 
 
 runRoundTrip :: Changer
-             -> GHC.ApiAnns -> GHC.Located (GHC.HsModule GHC.RdrName)
+             -> GHC.ApiAnns -> GHC.Located (GHC.HsModule GhcPs)
              -> [Comment]
              -> IO (String, Anns, GHC.ParsedSource)
 runRoundTrip f !anns !parsedOrig cs = do
@@ -209,7 +210,11 @@
   cfileName <- GHC.liftIO $ canonicalizePath fileName
 
   graph <- GHC.getModuleGraph
+#if __GLASGOW_HASKELL__ >= 804
+  cgraph <- GHC.liftIO $ canonicalizeGraph (GHC.mgModSummaries graph)
+#else
   cgraph <- GHC.liftIO $ canonicalizeGraph graph
+#endif
 
   let mm = filter (\(mfn,_ms) -> mfn == Just cfileName) cgraph
   case mm of
diff --git a/tests/Test/NoAnnotations.hs b/tests/Test/NoAnnotations.hs
--- a/tests/Test/NoAnnotations.hs
+++ b/tests/Test/NoAnnotations.hs
@@ -70,7 +70,7 @@
 
 noAnnTests :: [Test]
 noAnnTests = [
-  
+
         ]
 
 -- ---------------------------------------------------------------------
@@ -93,7 +93,8 @@
                 roundtripStructure = astStructure parsed' []
                 (status,debugTxt') = if roundtripStructure == originalStructure
                   then (Success, "ok")
-                  else (RoundTripFailure,diffText originalStructure roundtripStructure)
+                  else (RoundTripFailure,diffText originalStructure roundtripStructure
+                         ++ sep ++ originalStructure ++ sep ++ roundtripStructure)
                 cppStatus = Nothing
                 inconsistent = Nothing
                 !annsOrig = relativiseApiAnnsWithComments injectedComments parsed apianns
@@ -109,7 +110,7 @@
 
 runPrettyRoundTrip :: FilePath -> GHC.ApiAnns -> GHC.ParsedSource
                    -> [Comment]
-                   -> IO (Either (GHC.SrcSpan, String)(Anns, GHC.ParsedSource))
+                   -> IO (Either (GHC.SrcSpan, String) (Anns, GHC.ParsedSource))
 runPrettyRoundTrip origFile !anns !parsedOrig _cs = do
   let !newAnns = addAnnotationsForPretty [] parsedOrig mempty
   let comments = case Map.lookup GHC.noSrcSpan (snd anns) of
@@ -192,14 +193,14 @@
         var        = ("{Var: "++) . (++"}") . showSDocDebug_ . GHC.ppr :: GHC.Var -> String
         dataCon    = ("{DataCon: "++) . (++"}") . showSDoc_ . GHC.ppr :: GHC.DataCon -> String
 
-        overLit :: GHC.HsOverLit GHC.RdrName -> String
+        overLit :: GHC.HsOverLit GhcPs -> String
         overLit    = ("{HsOverLit:"++) . (++"}") . showSDoc_ . GHC.ppr
 
-        bagRdrName:: GHC.Bag (GHC.Located (GHC.HsBind GHC.RdrName)) -> String
+        bagRdrName:: GHC.Bag (GHC.Located (GHC.HsBind GhcPs)) -> String
         bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}") . list . GHC.bagToList
-        bagName   :: GHC.Bag (GHC.Located (GHC.HsBind GHC.Name)) -> String
+        bagName   :: GHC.Bag (GHC.Located (GHC.HsBind GhcRn)) -> String
         bagName    = ("{Bag(Located (HsBind Name)): "++) . (++"}") . list . GHC.bagToList
-        bagVar    :: GHC.Bag (GHC.Located (GHC.HsBind GHC.Var)) -> String
+        bagVar    :: GHC.Bag (GHC.Located (GHC.HsBind GhcTc)) -> String
         bagVar     = ("{Bag(Located (HsBind Var)): "++) . (++"}") . list . GHC.bagToList
 
 #if __GLASGOW_HASKELL__ > 800
diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs
--- a/tests/Test/Transform.hs
+++ b/tests/Test/Transform.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
 module Test.Transform where
 
 import Language.Haskell.GHC.ExactPrint
@@ -103,12 +104,14 @@
   -- putStrLn $ "\nchangeLocalDecls:sigAnns'=" ++ show sigAnns'
   let (p',(ans',_),_w) = runTransform ans doAddLocal
       doAddLocal = SYB.everywhereM (SYB.mkM replaceLocalBinds) p
-      replaceLocalBinds :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)
-                        -> Transform (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
+      replaceLocalBinds :: GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)
+                        -> Transform (GHC.LMatch GhcPs (GHC.LHsExpr GhcPs))
 #if __GLASGOW_HASKELL__ <= 710
       replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.EmptyLocalBinds)))) = do
-#else
+#elif __GLASGOW_HASKELL__ <= 802
       replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L _ GHC.EmptyLocalBinds)))) = do
+#else
+      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L _ GHC.EmptyLocalBinds)))) = do
 #endif
         newSpan <- uniqueSrcSpanT
         let
@@ -133,9 +136,12 @@
                                     [GHC.L ls sig]))
 #if __GLASGOW_HASKELL__ <= 710
         return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs binds)))
-#else
+#elif __GLASGOW_HASKELL__ <= 802
         bindSpan <- uniqueSrcSpanT
         return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L bindSpan binds))))
+#else
+        bindSpan <- uniqueSrcSpanT
+        return (GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L bindSpan binds))))
 #endif
       replaceLocalBinds x = return x
   -- putStrLn $ "log:" ++ intercalate "\n" w
@@ -155,12 +161,14 @@
   -- putStrLn $ "\nchangeLocalDecls:sigAnns'=" ++ show sigAnns'
   let (p',(ans',_),_w) = runTransform ans doAddLocal
       doAddLocal = SYB.everywhereM (SYB.mkM replaceLocalBinds) p
-      replaceLocalBinds :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)
-                        -> Transform (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
+      replaceLocalBinds :: GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)
+                        -> Transform (GHC.LMatch GhcPs (GHC.LHsExpr GhcPs))
 #if __GLASGOW_HASKELL__ <= 710
       replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.HsValBinds (GHC.ValBindsIn binds sigs))))) = do
-#else
+#elif __GLASGOW_HASKELL__ <= 802
       replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L lb (GHC.HsValBinds (GHC.ValBindsIn binds sigs)))))) = do
+#else
+      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L lb (GHC.HsValBinds (GHC.ValBindsIn binds sigs)))))) = do
 #endif
         a1 <- getAnnsT
         a' <- case sigs of
@@ -178,8 +186,10 @@
                                           (GHC.L ls sig:sigs)))
 #if __GLASGOW_HASKELL__ <= 710
         return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs binds')))
-#else
+#elif __GLASGOW_HASKELL__ <= 802
         return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L lb binds'))))
+#else
+        return (GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L lb binds'))))
 #endif
       replaceLocalBinds x = return x
   -- putStrLn $ "log:" ++ intercalate "\n" w
@@ -278,7 +288,7 @@
         | cond ln = GHC.L ln newName
     replaceRdr x = x
 
-    replaceHsVar :: GHC.LHsExpr GHC.RdrName -> GHC.LHsExpr GHC.RdrName
+    replaceHsVar :: GHC.LHsExpr GhcPs -> GHC.LHsExpr GhcPs
     replaceHsVar (GHC.L ln (GHC.HsVar _))
 #if __GLASGOW_HASKELL__ <= 710
         | cond ln = GHC.L ln (GHC.HsVar newName)
@@ -287,6 +297,9 @@
 #endif
     replaceHsVar x = x
 
+#if __GLASGOW_HASKELL__ > 802
+    replacePat :: GHC.LPat GhcPs -> GHC.LPat GhcPs
+#endif
     replacePat (GHC.L ln (GHC.VarPat _))
 #if __GLASGOW_HASKELL__ <= 710
         | cond ln = GHC.L ln (GHC.VarPat newName)
@@ -318,7 +331,7 @@
 changeLetIn1 ans parsed
   = return (ans,SYB.everywhere (SYB.mkT replace) parsed)
   where
-    replace :: GHC.HsExpr GHC.RdrName -> GHC.HsExpr GHC.RdrName
+    replace :: GHC.HsExpr GhcPs -> GHC.HsExpr GhcPs
 #if __GLASGOW_HASKELL__ <= 710
     replace (GHC.HsLet localDecls expr@(GHC.L _ _))
 #else
@@ -526,7 +539,7 @@
   let
       doRmDecl = do
         let
-          go :: GHC.LHsExpr GHC.RdrName -> Transform (GHC.LHsExpr GHC.RdrName)
+          go :: GHC.LHsExpr GhcPs -> Transform (GHC.LHsExpr GhcPs)
           go e@(GHC.L _ (GHC.HsLet{})) = do
             decs <- hsDecls e
             e' <- replaceDecls e (init decs)
@@ -585,7 +598,7 @@
   let
       doRmDecl = do
         let
-          go :: GHC.HsExpr GHC.RdrName -> Transform (GHC.HsExpr GHC.RdrName)
+          go :: GHC.HsExpr GhcPs -> Transform (GHC.HsExpr GhcPs)
 #if __GLASGOW_HASKELL__ <= 710
           go (GHC.HsLet lb expr) = do
 #else
diff --git a/tests/examples/ghc82/Completesig03A.hs b/tests/examples/ghc82/Completesig03A.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/Completesig03A.hs
@@ -0,0 +1,6 @@
+module Completesig03A where
+
+data A = A | B
+
+{-# COMPLETE A #-}
+
diff --git a/tests/examples/ghc82/Lib.hs b/tests/examples/ghc82/Lib.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/Lib.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE UnboxedSums, MagicHash #-}
+
+module Lib (flip, getInt) where
+
+import GHC.Exts
+import Prelude (Int)
+
+{-# NOINLINE flip #-}
+flip :: (# Int | Int# #) -> (# Int# | Int #)
+flip (# i | #) = (# | i #)
+flip (# | i #) = (# i | #)
+
+{-# NOINLINE getInt #-}
+getInt :: (# Int# | Int #) -> Int
+getInt (# i | #) = I# i
+getInt (# | i #) = i
+
diff --git a/tests/examples/ghc82/List2.hs b/tests/examples/ghc82/List2.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/List2.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE GADTs #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Type.Family.List
+-- Copyright   :  Copyright (C) 2015 Kyle Carter
+-- License     :  BSD3
+--
+-- Maintainer  :  Kyle Carter <kylcarte@indiana.edu>
+-- Stability   :  experimental
+-- Portability :  RankNTypes
+--
+-- Convenient aliases and type families for working with
+-- type-level lists.
+----------------------------------------------------------------------------
+
+module Type.Family.List where
+
+import Type.Family.Constraint
+import Type.Family.Monoid
+import Type.Family.Tuple hiding (type (<$>),type (<*>),type (<&>))
+import Type.Class.Witness
+
+type Ø    = '[]
+type (:<) = '(:)
+infixr 5 :<
+
diff --git a/tests/examples/ghc82/Ppr048.hs b/tests/examples/ghc82/Ppr048.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/Ppr048.hs
@@ -0,0 +1,10 @@
+module Ppr048 where
+
+{-# SCc foo #-}
+foo :: Int -> Int
+foo       x = x
+
+{-# SCc foo2 "label" #-}
+foo2 :: ()
+foo2 = ()
+
diff --git a/tests/examples/ghc82/T11727.hs b/tests/examples/ghc82/T11727.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/T11727.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module T11727 where
+
+pattern A,B :: Int
+pattern A = 5
+pattern B = 5
+
diff --git a/tests/examples/ghc82/T13050.hs b/tests/examples/ghc82/T13050.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/T13050.hs
@@ -0,0 +1,7 @@
+module HolesInfix where
+
+f, g, q :: Int -> Int -> Int
+f x y = _ x y
+g x y = x `_` y
+q x y = x `_a` y
+
diff --git a/tests/examples/ghc82/T13594.hs b/tests/examples/ghc82/T13594.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/T13594.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Bug where
+
+x :: forall a b. (a ~ Integer, b ~ Integer) => (a, b)
+!x = (1, 2)
+~y = (1, 2)
diff --git a/tests/examples/ghc82/TensorTests.hs b/tests/examples/ghc82/TensorTests.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/TensorTests.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, DataKinds, NoImplicitPrelude,
+             RebindableSyntax, ScopedTypeVariables, TypeFamilies, TypeOperators,
+             UndecidableInstances #-}
+
+module TensorTests (tensorTests) where
+
+import Apply.Cyc
+import Tests
+import Utils
+
+import TestTypes
+
+import Crypto.Lol
+import Crypto.Lol.CRTrans
+import Crypto.Lol.Cyclotomic.Tensor
+import Crypto.Lol.Types
+
+import Control.Applicative
+
+import Data.Maybe
+
+import Data.Singletons
+import Data.Promotion.Prelude.Eq
+import Data.Singletons.TypeRepStar ()
+
+import qualified Test.Framework as TF
+
+type TMRParams = ( '(,) <$> Tensors) <*> MRCombos
+tmrParams :: Proxy TMRParams
+tmrParams = Proxy
+
+--type ExtParams = ( '(,) <$> Tensors) <*> MRExtCombos
+type TrEmParams = ( '(,) <$> Tensors) <*> MM'RCombos
+tremParams :: Proxy TrEmParams
+tremParams = Proxy
+
+type NormParams = ( '(,) <$> '[RT]) <*> (Filter Liftable MRCombos)
+
+data Liftable :: TyFun (Factored, *) Bool -> *
+type instance Apply Liftable '(m,zq) = Int64 :== (LiftOf zq)
+
diff --git a/tests/examples/ghc82/brackets.hs b/tests/examples/ghc82/brackets.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/brackets.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE Arrows          #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnicodeSyntax   #-}
+
+-- See Trac #10162 and #11743 for details
+
+module ShouldCompile where
+
+import Control.Arrow
+import Language.Haskell.TH
+
+handle :: ArrowPlus a => a (b,s) c -> a (b,(String,s)) c -> a (b,s) c
+handle f h = proc (b,s) -> (f -< (b,s)) <+> (h -< (b,("FAIL",s)))
+
+f :: ArrowPlus a => a (Int,Int) String
+f = proc (x,y) ->
+  ⦇handle
+    (returnA -< show y)
+    (\s -> returnA -< s ++ show x)
+  ⦈
+
+g :: ArrowPlus a => a (Int,Int) String
+g = proc (x,y) ->
+  ⦇handle
+    (\msg -> returnA -< msg ++ show y)
+    (\s msg -> returnA -< s ++ show x)
+  ⦈ ("hello " ++ show x)
+
+h :: ArrowPlus a => a (Int,Int) Int
+h = proc (x,y) ->
+  (
+    (\z -> returnA -< x + z)
+    <+>
+    (\z -> returnA -< y + z)
+  ) (x*y)
+
+
+matches :: PatQ -> ExpQ
+matches pat = ⟦\x ->
+  case x of
+    $pat -> True
+    _    -> False
+  ⟧
+
diff --git a/tests/examples/ghc82/completesig01.hs b/tests/examples/ghc82/completesig01.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc82/completesig01.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -Wall #-}
+module Simple where
+
+pattern Foo :: ()
+pattern Foo = ()
+
+a :: () -> ()
+a Foo = ()
+
+data A = B | C | D
+
+{-# COMPLETE Foo #-}
+{-# COMPLETE B,C #-}
+{-# COMPLETE B #-}
+
+b :: A -> A
+b B = B
+b C = C
+
diff --git a/tests/examples/ghc84/Functors.hs b/tests/examples/ghc84/Functors.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc84/Functors.hs
@@ -0,0 +1,530 @@
+-- | Types are great. Lifting them into some sort of applicative functor makes
+-- them even better. This module is an homage to our favorite applicatives, and
+-- to the semigroups with which they are instrinsically connected.
+
+{-# LANGUAGE NoImplicitPrelude #-} -- Prelude is bad
+{-# LANGUAGE DeriveFunctor     #-} -- Writing Functor instances is boring
+
+module Acme.Functors
+    (
+    -- * Lifted-but-why
+      LiftedButWhy (..)
+
+    -- * Or-not
+    , OrNot (..)
+
+    -- * Two
+    , Two (..)
+
+    -- * Any-number-of
+    , AnyNumberOf (..), (~~)
+
+    -- * One-or-more
+    , OneOrMore (..)
+
+    -- * Also-extra-thing
+    , Also (..)
+
+    -- * Or-instead-other-thing
+    , OrInstead (..)
+
+    -- * Or-instead-other-thing ("first" variant)
+    , OrInsteadFirst (..)
+
+    -- * Determined-by-parameter
+    , DeterminedBy (..)
+
+    ) where
+
+import Acme.Functors.Classes
+
+
+--------------------------------------------------------------------------------
+--  Lifted-but-why
+--------------------------------------------------------------------------------
+
+-- | __@LiftedButWhy@__ is a boring functor that just has one value and no other
+-- structure or interesting properties.
+
+data LiftedButWhy a =
+
+    LiftedButWhy a
+    -- ^ A value that has been lifted for some damned reason.
+    --
+    -- ... Okay, to be honest, this one is /nobody's/ favorite, but it is
+    -- included here for completeness.
+
+    deriving (Eq, Functor, Show)
+
+-- | > pure = LiftedButWhy
+-- >
+-- > LiftedButWhy f <*> LiftedButWhy a = LiftedButWhy (f a)
+
+instance Applicative LiftedButWhy where
+
+    pure = LiftedButWhy
+
+    LiftedButWhy f <*> LiftedButWhy a = LiftedButWhy (f a)
+
+-- | > LiftedButWhy a >>= f = f a
+instance Monad LiftedButWhy where
+
+    LiftedButWhy a >>= f = f a
+
+-- | > LiftedButWhy x <> LiftedButWhy y = LiftedButWhy (x <> y)
+
+instance Semigroup a => Semigroup (LiftedButWhy a) where
+
+    LiftedButWhy x <> LiftedButWhy y = LiftedButWhy (x <> y)
+
+-- | > mempty = LiftedButWhy mempty
+
+instance Monoid a => Monoid (LiftedButWhy a) where
+
+    mempty = LiftedButWhy mempty
+
+
+--------------------------------------------------------------------------------
+--  Or-not
+--------------------------------------------------------------------------------
+
+-- | __@OrNot@__ is somehow slightly more interesting than @LiftedButWhy@, even
+-- though it may actually contain /less/. Instead of a value, there might /not/
+-- be a value.
+--
+-- When you combine stuff with @(\<*\>)@ or @(\<\>)@, all of the values need to
+-- be present. If any of them are absent, the whole expression evaluates to
+-- @Nope@.
+
+data OrNot a = ActuallyYes a -- ^ Some normal value.
+             | Nope          -- ^ Chuck Testa.
+    deriving (Eq, Functor, Show)
+
+-- | If you have a function @f@ that might not actually be there, and a value
+-- @a@ that might not actually be there, lifted application @(\<*\>)@ gives you
+-- @f a@ only if both of them are actually there.
+--
+-- > pure = ActuallyYes
+-- >
+-- > ActuallyYes f <*> ActuallyYes a = ActuallyYes (f a)
+-- > _             <*> _             = Nope
+
+instance Applicative OrNot where
+
+    pure = ActuallyYes
+
+    ActuallyYes f <*> ActuallyYes a = ActuallyYes (f a)
+    _             <*> _             = Nope
+
+instance Monad OrNot where
+
+    ActuallyYes a  >>= f = f a
+    Nope           >>= _ = Nope
+
+-- | If you have value @a@ that may not actually be there, and another value
+-- @a'@ that might not actually be there, the lifted semigroup operation
+-- @(\<\>)@ gives you @a \<\> a'@ only if both of them are actually there.
+--
+-- > ActuallyYes a <> ActuallyYes a' = ActuallyYes (a <> a')
+-- > _             <> _              = Nope
+
+instance Semigroup a => Semigroup (OrNot a) where
+
+    ActuallyYes a <> ActuallyYes a' = ActuallyYes (a <> a')
+    _             <> _              = Nope
+
+-- | > mempty = ActuallyYes mempty
+
+instance Monoid a => Monoid (OrNot a) where
+
+    mempty = ActuallyYes mempty
+
+
+--------------------------------------------------------------------------------
+--  Two
+--------------------------------------------------------------------------------
+
+-- | __@Two@__ is /two/ values. Yep. Just two values.
+
+data Two a = Two { firstOfTwo  :: a -- ^ One value.
+                 , secondOfTwo :: a -- ^ Another value.
+                 }
+    deriving (Eq, Functor, Show)
+
+-- | If you have two functions @f@ and @g@ and two values @a@ and @a'@, then you
+-- can apply them with @(\<*\>)@ to get two results @f a@ and @g a'@.
+--
+-- > pure a = Two a a
+-- >
+-- > Two f g <*> Two a a' = Two (f a) (g a')
+
+instance Applicative Two where
+
+    pure a = Two a a
+
+    Two f g <*> Two a a' = Two (f a) (g a')
+
+-- | > Two x y <> Two x' y' = Two (x <> x') (y <> y')
+
+instance Semigroup a => Semigroup (Two a) where
+
+    Two x y <> Two x' y' = Two (x <> x') (y <> y')
+
+-- | > mempty = Two mempty mempty
+
+instance Monoid a => Monoid (Two a) where
+
+    mempty = Two mempty mempty
+
+
+--------------------------------------------------------------------------------
+--  Any-number-of
+--------------------------------------------------------------------------------
+
+-- | __@AnyNumberOf@__ starts to get exciting. Any number of values you want.
+-- Zero... one ... two ... three ... four ... five ... The possibilities are
+-- /truly/ endless.
+
+data AnyNumberOf a =
+
+    OneAndMaybeMore a (AnyNumberOf a)
+    -- ^ One value, and maybe even more after that!
+
+    | ActuallyNone -- ^ Oh. Well this is less fun.
+
+    deriving (Eq, Functor, Show)
+
+-- | Alias for 'OneAndMaybeMore' which provides some brevity.
+
+(~~) :: a -> AnyNumberOf a -> AnyNumberOf a
+(~~) = OneAndMaybeMore
+
+infixr 5 ~~
+
+-- | You can use this to apply any number of functions to any number of
+-- arguments.
+--
+-- > pure a = OneAndMaybeMore a ActuallyNone
+-- >
+-- > OneAndMaybeMore f fs <*> OneAndMaybeMore x xs =
+-- >     OneAndMaybeMore (f x) (fs <*> xs)
+-- > _ <*> _ = ActuallyNone
+--
+-- Example:
+--
+-- >     ( (+ 1) ~~ (* 2) ~~ (+ 5) ~~       ActuallyNone )
+-- > <*> (    1  ~~    6  ~~    4  ~~ 37 ~~ ActuallyNone )
+-- >  =  (    7  ~~   12  ~~    9  ~~       ActuallyNone )
+--
+-- This example demonstrates how when there are more arguments than functions,
+-- any excess arguments (in this case, the @37@) are ignored.
+
+instance Applicative AnyNumberOf where
+
+    pure a = OneAndMaybeMore a ActuallyNone
+
+    OneAndMaybeMore f fs <*> OneAndMaybeMore x xs =
+        OneAndMaybeMore (f x) (fs <*> xs)
+    _ <*> _ = ActuallyNone
+
+-- | The operation of combining some number of @a@ with some other number of @a@
+-- is sometimes referred to as /zipping/.
+--
+-- > OneAndMaybeMore x xs <> OneAndMaybeMore y ys =
+-- >     OneAndMaybeMore (x <> y) (xs <> ys)
+-- > _ <> _ = ActuallyNone
+
+instance Semigroup a => Semigroup (AnyNumberOf a) where
+
+    OneAndMaybeMore x xs <> OneAndMaybeMore y ys =
+        OneAndMaybeMore (x <> y) (xs <> ys)
+    _ <> _ = ActuallyNone
+
+-- | > mempty = mempty ~~ mempty
+
+instance Monoid a => Monoid (AnyNumberOf a) where
+
+    mempty = mempty ~~ mempty
+
+
+--------------------------------------------------------------------------------
+--  One-or-more
+--------------------------------------------------------------------------------
+
+-- | __@OneOrMore@__ is more restrictive than AnyNumberOf, yet somehow actually
+-- /more/ interesting, because it excludes that dull situation where there
+-- aren't any values at all.
+
+data OneOrMore a = OneOrMore
+    { theFirstOfMany :: a -- ^ Definitely at least this one.
+    , possiblyMore :: AnyNumberOf a -- ^ And perhaps others.
+    } deriving (Eq, Functor, Show)
+
+-- | > pure a = OneOrMore a ActuallyNone
+-- >
+-- > OneOrMore f fs <*> OneOrMore x xs = OneOrMore (f x) (fs <*> xs)
+
+instance Applicative OneOrMore where
+
+    pure a = OneOrMore a ActuallyNone
+
+    OneOrMore f fs <*> OneOrMore x xs = OneOrMore (f x) (fs <*> xs)
+
+-- |
+-- > OneOrMore a more <> OneOrMore a' more' =
+-- >     OneOrMore a (more <> OneAndMaybeMore a' more')
+
+instance Semigroup a => Semigroup (OneOrMore a) where
+
+    OneOrMore a more <> OneOrMore a' more' =
+        OneOrMore a (more <> OneAndMaybeMore a' more')
+
+-- | > mempty = OneOrMore mempty ActuallyNone
+
+instance Monoid a => Monoid (OneOrMore a) where
+
+    mempty = OneOrMore mempty ActuallyNone
+
+
+--------------------------------------------------------------------------------
+--  Also-extra-thing
+--------------------------------------------------------------------------------
+
+-- | __@Also extraThing@__ is a functor in which each value has an @extraThing@
+-- of some other type that tags along with it.
+
+data (Also extraThing) a = Also
+    { withoutExtraThing :: a          -- ^ A value.
+    , theExtraThing     :: extraThing -- ^ An additional thing that tags along.
+    }
+    deriving (Eq, Functor, Show)
+
+-- | Dragging the @extraThing@ along can be a bit of a burden. It prevents @Also
+-- extraThing@ from being an applicative functor — unless the @extraThing@ can
+-- pull its weight by bringing a monoid to the table.
+--
+-- > pure = (`Also` mempty)
+-- >
+-- > (f `Also` extra1) <*> (a `Also` extra2) = f a
+-- >                                           `Also` (extra1 <> extra2)
+
+instance Monoid extraThing => Applicative (Also extraThing) where
+
+    pure = (`Also` mempty)
+
+    (f `Also` extra1) <*> (a `Also` extra2) = f a
+                                              `Also` (extra1 <> extra2)
+
+-- |
+-- > (a `Also` extra1) <> (a' `Also` extra2) = (a <> a')
+-- >                                           `Also` (extra1 <> extra2)
+
+instance (Semigroup extraThing, Semigroup a) => Semigroup ((Also extraThing) a)
+  where
+
+    (a `Also` extra1) <> (a' `Also` extra2) = (a <> a')
+                                              `Also` (extra1 <> extra2)
+
+-- | > mempty = Also mempty mempty
+
+instance (Monoid extraThing, Monoid a) => Monoid ((Also extraThing) a)
+  where
+
+    mempty = Also mempty mempty
+
+
+--------------------------------------------------------------------------------
+--  Or-instead-other-thing
+--------------------------------------------------------------------------------
+
+-- | __@OrInstead otherThing@__ is a functor in which, instead of having a
+-- value, can actually just have some totally unrelated @otherThing@ instead.
+--
+-- When you combine stuff with @(\<*\>)@ or @(\<\>)@, all of the values need to
+-- be present. If any of them are the @otherThing@ instead, then the whole
+-- expression evaluates to the combination of the @otherThing@s.
+
+data (OrInstead otherThing) a =
+      NotInstead a       -- ^ Some normal value.
+    | Instead otherThing -- ^ Some totally unrelated other thing.
+    deriving (Eq, Functor, Show)
+
+-- | The possibility of having an @otherThing@ obstructs this functor's ability
+-- to be applicative, much like the extra thing in @Also extraThing@ does. In
+-- this case, since we do not need an empty value for the @otherThing@, it needs
+-- only a semigroup to be in compliance.
+--
+-- > pure = NotInstead
+-- >
+-- > NotInstead f   <*> NotInstead a   = NotInstead (f a)
+-- > Instead other1 <*> Instead other2 = Instead (other1 <> other2)
+-- > Instead other  <*> _              = Instead other
+-- > _              <*> Instead other  = Instead other
+
+instance Semigroup otherThing => Applicative (OrInstead otherThing) where
+
+    pure = NotInstead
+
+    NotInstead f   <*> NotInstead a   = NotInstead (f a)
+    Instead other1 <*> Instead other2 = Instead (other1 <> other2)
+    Instead other  <*> _              = Instead other
+    _              <*> Instead other  = Instead other
+
+-- |
+-- > NotInstead a   <> NotInstead a'  = NotInstead (a <> a')
+-- > Instead other1 <> Instead other2 = Instead (other1 <> other2)
+-- > Instead other  <> _              = Instead other
+-- > _              <> Instead other  = Instead other
+
+instance (Semigroup otherThing, Semigroup a) =>
+  Semigroup ((OrInstead otherThing) a) where
+
+    NotInstead a   <> NotInstead a'  = NotInstead (a <> a')
+    Instead other1 <> Instead other2 = Instead (other1 <> other2)
+    Instead other  <> _              = Instead other
+    _              <> Instead other  = Instead other
+
+-- > mempty = NotInstead mempty
+
+instance (Semigroup otherThing, Monoid a) => Monoid ((OrInstead otherThing) a)
+  where
+
+    mempty = NotInstead mempty
+
+
+--------------------------------------------------------------------------------
+--  Or-instead-first-thing
+--------------------------------------------------------------------------------
+
+-- | __@OrInsteadFirst otherThing@__ looks a lot like @OrInstead otherThing@,
+-- but it manages to always be an applicative functor — and even a monad too —
+-- by handling the @otherThing@s a bit more hamfistedly.
+--
+-- When you combine stuff with @(\<*\>)@ or @(\<\>)@, all of the values need to
+-- be present. If any of them are the @otherThing@ instead, then the whole
+-- expression evaluates to the /first/ @otherThing@ encountered, ignoring any
+-- additional @otherThings@ that may subsequently pop up
+
+data (OrInsteadFirst otherThing) a =
+      NotInsteadFirst a       -- ^ Some normal value.
+    | InsteadFirst otherThing -- ^ Some totally unrelated other thing.
+    deriving (Eq, Functor, Show)
+
+-- |
+-- > pure = NotInsteadFirst
+-- >
+-- > NotInsteadFirst f  <*> NotInsteadFirst a  = NotInsteadFirst (f a)
+-- > InsteadFirst other <*> _                  = InsteadFirst other
+-- > _                  <*> InsteadFirst other = InsteadFirst other
+
+instance Applicative (OrInsteadFirst otherThing) where
+
+    pure = NotInsteadFirst
+
+    NotInsteadFirst f  <*> NotInsteadFirst a  = NotInsteadFirst (f a)
+    InsteadFirst other <*> _                  = InsteadFirst other
+    _                  <*> InsteadFirst other = InsteadFirst other
+
+-- |
+-- > InsteadFirst other >>= _ = InsteadFirst other
+-- > NotInsteadFirst a  >>= f = f a
+
+instance Monad (OrInsteadFirst otherThing) where
+
+    InsteadFirst other >>= _ = InsteadFirst other
+    NotInsteadFirst a  >>= f = f a
+
+-- |
+-- > NotInsteadFirst a  <> NotInsteadFirst a' = NotInsteadFirst (a <> a')
+-- > InsteadFirst other <> _                  = InsteadFirst other
+-- > _                  <> InsteadFirst other = InsteadFirst other
+
+instance (Semigroup otherThing, Semigroup a) =>
+  Semigroup ((OrInsteadFirst otherThing) a) where
+
+    NotInsteadFirst a  <> NotInsteadFirst a' = NotInsteadFirst (a <> a')
+    InsteadFirst other <> _                  = InsteadFirst other
+    _                  <> InsteadFirst other = InsteadFirst other
+
+-- | > mempty = NotInsteadFirst mempty
+
+instance (Semigroup otherThing, Monoid a) =>
+  Monoid ((OrInsteadFirst otherThing) a) where
+
+    mempty = NotInsteadFirst mempty
+
+
+--------------------------------------------------------------------------------
+--  Determined-by-parameter
+--------------------------------------------------------------------------------
+
+-- | __@DeterminedBy parameter@__ is a value that... well, we're not really sure
+-- what it is. We'll find out once a @parameter@ is provided.
+--
+-- The mechanism for deciding /how/ the value is determined from the
+-- @parameter@ is opaque; all you can do is test it with different parameters
+-- and see what results. There aren't even @Eq@ or @Show@ instances, which is
+-- annoying.
+
+data DeterminedBy parameter a = Determination ((->) parameter a)
+    deriving (Functor)
+
+-- |
+-- > pure a = Determination (\_ -> a)
+-- >
+-- > Determination f <*> Determination a = Determination (\x -> f x (a x))
+
+instance Applicative (DeterminedBy parameter) where
+
+    pure a = Determination (\_ -> a)
+
+    Determination f <*> Determination a = Determination (\x -> f x (a x))
+
+-- |
+-- > Determination fa >>= ff =
+-- >     Determination (\x -> let Determination f = ff (fa x) in f x)
+
+instance Monad (DeterminedBy parameter) where
+
+    Determination fa >>= ff =
+        Determination (\x -> let Determination f = ff (fa x) in f x)
+
+-- | > Determination f <> Determination g = Determination (\x -> f x <> g x)
+
+instance Semigroup a => Semigroup ((DeterminedBy parameter) a) where
+
+    Determination f <> Determination g = Determination (\x -> f x <> g x)
+
+-- | > mempty = Determination (\_ -> mempty)
+
+instance Monoid a => Monoid ((DeterminedBy parameter) a) where
+
+    mempty = Determination (\_ -> mempty)
+
+
+{-
+
+--------------------------------------------------------------------------------
+--  Notes
+--------------------------------------------------------------------------------
+
+LiftedButWhy is Identity.
+
+OrNot is Maybe, but with a different semigroup and monoid.
+
+Two doesn't have an analogue in the standard library as far as I know.
+
+AnyNumberOf is ZipList.
+
+OneOrMore is NonEmpty.
+
+Also is (,), the 2-tuple.
+
+OrInstead is AccValidation from the 'validation' package.
+
+OrInsteadFirst is Either.
+
+DeterminedBy is (->) also known as a function, whose functor is also known as
+Reader.
+
+-}
diff --git a/tests/examples/ghc84/Main.hs b/tests/examples/ghc84/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc84/Main.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE ScopedTypeVariables, TemplateHaskell, StandaloneDeriving, TypeFamilies, GADTs
+           , ViewPatterns, TypeOperators, TypeApplications, StandaloneDeriving
+           , UnicodeSyntax, PatternSynonyms, FlexibleContexts, DataKinds, UndecidableInstances
+           , TypeFamilyDependencies #-}
+
+-- invoke as: ghci Main.hs -ddump-parsed -ddump-rn
+-- or in GHCi: :set -ddump-parsed -ddump-rn
+
+import TyFamWitnesses
+import Language.Haskell.TH hiding (Type)
+import Data.Type.Equality hiding (apply)
+import Type.Reflection
+import Unsafe.Coerce (unsafeCoerce)
+import Data.Char (ord)
+import GHC.TypeLits
+
+
+stuffhave = [d| type family Foo a b where
+                  Foo a a = Int
+                  Foo (IO a) a = Float
+                  Foo (IO a) b = Bool
+                  Foo a Char = String
+                  Foo a b = Char |]
+
+stuffhave1 = [d| type family Bar a where Bar Bool = Bool; Bar a = IO a |]
+
+stuffhave2 = [d| type family Elim a b where Elim a (a -> b) = b; Elim a (c -> b) = c -> Elim a b |]
+
+
+witnesses [d| type family Foo a b where
+                Foo a a = Int
+                Foo (IO a) a = Float
+                Foo (IO a) b = Bool
+                Foo a Char = String
+                Foo a b = Char |]
+
+deriving instance Show (FooRefl a b)
+
+-- now you can:
+--
+-- >>> :info FooRefl
+-- type role FooRefl nominal nominal
+-- data FooRefl a b where
+--   Foo0 :: (Foo a a ~ Int) => FooRefl a a
+--   Foo1 :: (Foo (IO b) b ~ Float) => FooRefl (IO b) b
+--   Foo2 :: (Foo (IO a1) b ~ Bool) => FooRefl (IO a1) b
+--   Foo3 :: (Foo a Char ~ String) => FooRefl a Char
+--   Foo4 :: (Foo a b ~ Char) => FooRefl a b
+--      -- Defined at Main.hs:13:1
+-- instance Show (FooRefl a b) -- Defined at Main.hs:14:1
+--
+-- >>> :info reify_Foo
+-- reify_Foo :: TypeRep a -> TypeRep b -> Maybe (FooRefl a b)
+--      -- Defined at Main.hs:13:1
+--
+-- >>> reify_Foo (typeOf getChar) (typeRep @Char)
+-- Just Foo1
+--
+
+witnesses [d| type family Bar a where Bar Bool = Bool; Bar a = IO a |]
+deriving instance Show (BarRefl a)
+
+witnesses [d| type family Elim a b where Elim a (a -> b) = b; Elim a (c -> b) = c -> Elim a b |]
+deriving instance Show (ElimRefl a b)
+
+pure []
+
+stuffwant2 = [d|
+  fooRefl :: forall a b . TypeRep a -> TypeRep b -> Maybe (FooRefl a b)
+  fooRefl a b | Just HRefl <- eqTypeRep a b = pure Foo0
+  fooRefl a b | Refl <- unsafeCoerce Refl :: Foo a b :~: Char = pure Foo1
+  |]
+
+stuffhave3 = [d| data Peano = Z | S Peano
+                 type family ToPeano (n :: Nat) :: Peano where ToPeano 0 = Z; ToPeano n = S (ToPeano (n-1))
+                 type family FromPeano (p :: Peano) :: Nat where FromPeano Z = 0; FromPeano (S n) = 1 + FromPeano n
+               |]
+
+
+witnesses [d| data Peano = Z | S Peano
+              type family ToPeano (n :: Nat) :: Peano where ToPeano 0 = Z; ToPeano n = S (ToPeano (n-1))
+              type family FromPeano (p :: Peano) :: Nat where FromPeano Z = 0; FromPeano (S n) = 1 + FromPeano n
+            |]
+
+
+deriving instance Show (ToPeanoRefl n)
+deriving instance Show (FromPeanoRefl p)
+
+witnesses [d| type family Unspell (w :: Symbol) = (r :: Nat) | r -> w where
+                          Unspell "zero" = 0
+                          Unspell "one" = 1
+                          Unspell "two" = 2
+                          Unspell "three" = 3
+            |]
+deriving instance Show (UnspellRefl w)
+
+main = runQ (witnesses stuffhave2) >>= print
+
+test@Just{} = reify_Elim (typeRep @Integer) (typeOf ((+1)::Integer->Integer))
+
+lemma :: v -> TypeRep f -> TypeRep v
+      -> Maybe (TypeRep (v `Elim` f), f -> v `Elim` f)
+lemma w f v = do d `Fun'` c <- pure f
+                 witness <- v `reify_Elim` f
+                 case witness of
+                   Elim0 -> pure (c, ($ w))
+                   Elim1 -> do (e, g) <- lemma w c v
+                               pure (d `Fun` e, (g.))
+
+data Tag = Source | Destination | CheckSource Bool | CheckDest Bool | Cut Bool
+
+newtype TaggedAction (t :: Tag) = Tagged (IO ())
+
+data Action where
+  Action :: Typeable t ⇒ TaggedAction t → Action
+  Catalyst :: Typeable (c → d) ⇒ (c → d) → Action
+
+pattern A :: forall k a. () => forall b. (TaggedAction b ~~ a) => TypeRep b → TypeRep a
+pattern A b ← (eqTypeRep (typeRep @TaggedAction) → Just HRefl) `App` b
+
+
+reaction :: Action → Action → Maybe Action
+reaction (Catalyst f) (Action v) = do (rep, f') ← lemma v (typeOf f) (typeOf v)
+                                      pure $ case rep of
+                                        _ `Fun'` _ → withTypeable rep (Catalyst $ f' f)
+                                        A indx → withTypeable indx (Action $ f' f)
+
+
+member :: Eq a => a -> [a] -> Bool
+member = elem
+
+y $$ x = ($ y).($ x)
+
+--Just (t3r, (($ elem) -> t3)) = lemma 'j' (typeOf $ member @Char) (typeOf 'j') -- https://ghc.haskell.org/trac/ghc/ticket/14293
+Just (t3r, (($ "joe").($ elem) -> t3@True)) = lemma 'j' (typeOf $ member @Char) (typeOf 'j')
+Just (t4r, (($ 'o').($ elem) -> t4@True)) = lemma "joe" (typeOf $ member @Char) (typeOf "joe")
+-- Just (t4'r, ('x' $$ elem -> t4'@False)) = lemma "joe" (typeOf $ member @Char) (typeOf "joe") -- Same bug
+Just (t4'r, (($ 'x').($ elem) -> t4'@False)) = lemma "joe" (typeOf $ member @Char) (typeOf "joe")
+
+t0@Nothing = lemma "joe" (typeOf ord) (typeOf "joe")
+
+
+Just u0 = reify_FromPeano (typeRep @Z)
+Just u1 = reify_FromPeano (typeRep @(S Z))
+Just u2 = reify_FromPeano (typeRep @(S (S Z)))
+
+Just un0 = reify_Unspell (typeRep @"zero")
+Just un1 = reify_Unspell (typeRep @"one")
+Just un2 = reify_Unspell (typeRep @"two")
+
diff --git a/tests/examples/ghc84/T13747.hs b/tests/examples/ghc84/T13747.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc84/T13747.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GADTs #-}
+
+module T13747 where
+
+class C a where
+  type family TC a :: *
+
+class D a where
+  data family TD a :: *
+
+instance C Int where
+  type instance TC Int = Int
+
+instance D Double where
+  data instance TD Double = TDDouble
+
+instance D Int where
+  newtype instance TD Int = TDInt Int
+
+instance D Char where
+    data instance TD Char where
+        C1 :: TD Char
+        C2 :: TD Char
+
diff --git a/tests/examples/ghc84/Types.hs b/tests/examples/ghc84/Types.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc84/Types.hs
@@ -0,0 +1,392 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveFunctor       #-}
+{-# LANGUAGE PatternSynonyms     #-}
+{-# LANGUAGE RecursiveDo         #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections       #-}
+{-# LANGUAGE ViewPatterns        #-}
+{-# OPTIONS_GHC -Wno-name-shadowing     #-}
+{-# OPTIONS_GHC -Wno-duplicate-exports  #-}
+
+module Graphics.UI.Threepenny.Editors.Types
+  (
+  -- * GenericWidgets
+    GenericWidget(..)
+  , edited
+  , contents
+  , widgetControl
+  , widgetTidings
+  -- * Editors
+  , Editor(.., Horizontally, horizontally, Vertically, vertically)
+  , liftElement
+  , dimapE
+  , applyE
+    -- ** Editor composition
+  , (|*|), (|*), (*|)
+  , (-*-), (-*), (*-)
+  , field
+  , fieldLayout
+    -- ** Editor constructors
+  , editorUnit
+  , editorIdentity
+  , editorString
+  , editorText
+  , editorCheckBox
+  , editorReadShow
+  , editorEnumBounded
+  , editorSelection
+  , editorSum
+  , editorJust
+  , EditorCollection(..)
+  , editorCollection
+  , editorList
+  , EditorCollectionConfig(..)
+  , defaultEditorCollectionConfig
+  -- ** Representation of empty values
+  , HasEmpty(..)
+  ) where
+
+import           Control.Monad
+import           Data.Biapplicative
+import           Data.Maybe
+import           Data.HasEmpty
+import qualified Data.Foldable as F
+import           Data.Functor.Compose
+import           Data.Functor.Identity
+import           Data.Map (Map)
+import qualified Data.Map as Map
+import           Data.Set (Set)
+import qualified Data.Set as Set
+import           Data.Profunctor
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import           Graphics.UI.Threepenny.Attributes
+import           Graphics.UI.Threepenny.Core           as UI hiding (empty)
+import           Graphics.UI.Threepenny.Editors.Layout
+import           Graphics.UI.Threepenny.Editors.Utils
+import           Graphics.UI.Threepenny.Elements
+import           Graphics.UI.Threepenny.Events
+import           Graphics.UI.Threepenny.Widgets
+import           Text.Read
+
+data GenericWidget control a = GenericWidget
+  { widgetTidings :: Tidings a -- ^ The dynamic contents of the widget.
+  , widgetControl :: control   -- ^ The actual widget.
+  }
+  deriving Functor
+
+instance Bifunctor GenericWidget where
+  bimap f g (GenericWidget t e) = GenericWidget (g <$> t) (f e)
+
+traverseControl :: Applicative f => (control -> f control') -> GenericWidget control a -> f (GenericWidget control' a)
+traverseControl f (GenericWidget t e) = GenericWidget t <$> f e
+
+edited :: GenericWidget el a -> Event a
+edited = rumors . widgetTidings
+
+contents :: GenericWidget el a -> Behavior a
+contents = facts . widgetTidings
+
+instance Widget el => Widget (GenericWidget el a) where
+  getElement = getElement . widgetControl
+
+instance Renderable el => Renderable (GenericWidget el a) where
+  render = render . widgetControl
+
+renderEditor :: Renderable w => GenericWidget w a -> UI (GenericWidget Element a)
+renderEditor = traverseControl render
+
+-- | An editor for values of type @inner@ inside a datatype @outer@ realized by a @widget@.
+--
+--   All the three type arguments are functorial, but @outer@ is contravariant, so @Editor@ is a 'Biapplicative' functor and a 'Profunctor' (via 'dimapE').
+--
+--  'Biapplicative' allows to compose editors on both their @widget@ and @inner@ structure. When @widget@ is monoidal, widget composition is implicit and 'Applicative' suffices.
+--
+--  'Profunctor' allows to apply an @inner@ editor to an @outer@ datatype.
+--
+--   Once 'create'd, an 'Editor' yields a tuple of an @widget@ and a @Tidings inner@ which can be integrated in a threepenny app.
+--
+
+newtype Editor outer widget inner = Editor {
+  create :: Behavior outer -> UI (GenericWidget widget inner)
+  }
+
+-- | Lift an HTML element into a vacuous editor.
+liftElement :: UI el -> Editor a el ()
+liftElement el = Editor $ \_ -> GenericWidget (pure ()) <$> el
+
+bimapEditor :: (el -> el') -> (b -> b') -> Editor a el b -> Editor a el' b'
+bimapEditor g h = Editor . fmap (fmap (bimap g h)) . create
+
+dimapE :: (a' -> a) -> (b -> b') -> Editor a el b -> Editor a' el b'
+dimapE g h  = unCoer . dimap (fmap g) h . coer
+  where
+    coer   = Star . (Compose .) . create
+    unCoer = Editor . fmap getCompose . runStar
+
+applyE :: (el1 -> el2 -> el) -> Editor in_ el1 (a -> b) -> Editor in_ el2 a -> Editor in_ el b
+applyE combineElements a b = Editor $ \s -> do
+    a <- create a s
+    b <- create b s
+    return $ GenericWidget (widgetTidings a <*> widgetTidings b) (widgetControl a `combineElements` widgetControl b)
+
+instance Functor (Editor a el) where
+  fmap = dimapE id
+
+instance Bifunctor (Editor a) where
+  bimap = bimapEditor
+
+instance Biapplicative (Editor a) where
+  bipure w o = Editor $ \_ -> return $ GenericWidget (pure o) w
+  (<<*>>) = applyE ($)
+
+instance Monoid el => Applicative (Editor a el) where
+  pure = bipure mempty
+  (<*>) = applyE mappend
+
+-- | Applicative modifier for vertical composition of editor factories.
+--   This can be used in conjunction with ApplicativeDo as:
+--
+-- > editorPerson = vertically $ do
+-- >       firstName <- Vertically $ field "First:" firstName editor
+-- >       lastName  <- Vertically $ field "Last:"  lastName editor
+-- >       age       <- Vertically $ field "Age:"   age editor
+-- >       return Person{..}
+--
+-- DEPRECATED: Use the 'Vertical' layout builder instead
+pattern Vertically :: Editor a Layout b -> Editor a Vertical b
+pattern Vertically {vertically} <- (withLayout getVertical -> vertically) where Vertically a = withLayout Vertical a
+
+-- | Applicative modifier for horizontal composition of editor factories.
+--   This can be used in conjunction with ApplicativeDo as:
+--
+-- > editorPerson = horizontally $ do
+-- >       firstName <- Horizontally $ field "First:" firstName editor
+-- >       lastName  <- Horizontally $ field "Last:"  lastName editor
+-- >       age       <- Horizontally $ field "Age:"   age editor
+-- >       return Person{..}
+--
+-- DEPRECATED: Use the 'Horizontal' layout builder instead
+pattern Horizontally :: Editor a Layout b -> Editor a Horizontal b
+pattern Horizontally {horizontally} <- (withLayout getHorizontal -> horizontally) where Horizontally a = withLayout Horizontal a
+
+infixl 4 |*|, -*-
+infixl 5 |*, *|, -*, *-
+
+-- | Apply a layout builder.
+withLayout :: (layout -> layout') -> Editor a layout b -> Editor a layout' b
+withLayout f = bimap f id
+
+-- | Left-right editor composition
+(|*|) :: Editor s Layout (b -> a) -> Editor s Layout b -> Editor s Layout a
+a |*| b = withLayout getHorizontal $ withLayout Horizontal a <*> withLayout Horizontal b
+
+-- | Left-right composition of an element with a editor
+(*|) :: UI Element -> Editor s Layout a -> Editor s Layout a
+e *| a = withLayout getHorizontal $ liftElement(return $ horizontal e) *> withLayout Horizontal a
+
+-- | Left-right composition of an element with a editor
+(|*) :: Editor s Layout a -> UI Element -> Editor s Layout a
+a |* e = withLayout getHorizontal $ withLayout Horizontal a <* liftElement(return $ horizontal e)
+
+-- | Left-right editor composition
+(-*-) :: Editor s Layout (b -> a) -> Editor s Layout b -> Editor s Layout a
+a -*- b = withLayout getVertical $ withLayout Vertical a <*> withLayout Vertical b
+
+-- | Left-right composition of an element with a editor
+(*-) :: UI Element -> Editor s Layout a -> Editor s Layout a
+e *- a = withLayout getVertical $ liftElement(return $ vertical e) *> withLayout Vertical a
+
+-- | Left-right composition of an element with a editor
+(-*) :: Editor s Layout a -> UI Element -> Editor s Layout a
+a -* e = withLayout getVertical $ withLayout Vertical a <* liftElement(return $ vertical e)
+
+-- | A helper that arranges a label and an editor horizontally,
+--   wrapped in the given monoidal layout builder.
+fieldLayout :: (Renderable m, Renderable m') => (Layout -> m') -> String -> (out -> inn) -> Editor inn m a -> Editor out m' a
+fieldLayout l name f e = withLayout l (string name *| first getLayout (dimapE f id e))
+
+-- | A helper that arranges a label
+--   and an editor horizontally.
+field :: Renderable m => String -> (out -> inn) -> Editor inn m a -> Editor out Layout a
+field name f e = string name *| first getLayout (dimapE f id e)
+
+editorUnit :: Editor b Element b
+editorUnit = Editor $ \b -> do
+    t <- new
+    return $ GenericWidget (tidings b never) t
+
+editorCheckBox :: Editor Bool Element Bool
+editorCheckBox = Editor $ \b -> do
+    t <- sink checked b $ input # set type_ "checkbox"
+    return $ GenericWidget (tidings b $ checkedChange t) t
+
+editorString :: Editor String TextEntry String
+editorString = Editor $ \b -> do
+    w <- askWindow
+    t <- entry b
+    liftIOLater $ do
+      initialValue <- currentValue b
+      _ <- runUI w $ set value initialValue (element t)
+      return ()
+    return $ GenericWidget (userText t) t
+
+editorText :: Editor Text TextEntry Text
+editorText = dimapE Text.unpack Text.pack editorString
+
+editorReadShow :: (Read a, Show a) => Editor (Maybe a) TextEntry (Maybe a)
+editorReadShow = Editor $ \b -> do
+    e <- create editorString (maybe "" show <$> b)
+    let readIt "" = Nothing
+        readIt x  = readMaybe x
+    let t = tidings b (readIt <$> edited e)
+    return $ GenericWidget t (widgetControl e)
+
+-- An editor that presents a choice of values.
+editorEnumBounded
+  :: (Bounded a, Enum a, Ord a, Show a)
+  => Behavior(a -> UI Element) -> Editor (Maybe a) (ListBox a) (Maybe a)
+editorEnumBounded = editorSelection (pure $ enumFrom minBound)
+
+-- | An editor that presents a dynamic choice of values.
+editorSelection
+  :: Ord a
+  => Behavior [a] -> Behavior(a -> UI Element) -> Editor (Maybe a) (ListBox a) (Maybe a)
+editorSelection options display = Editor $ \b -> do
+  l <- listBox options b display
+  return $ GenericWidget (tidings b (rumors $ userSelection l)) l
+
+-- | Ignores 'Nothing' values and only updates for 'Just' values
+editorJust :: Editor (Maybe b) el (Maybe b) -> Editor b el b
+editorJust (Editor editor) = Editor $ \b -> do
+  e <- editor (Just <$> b)
+  let ev = filterJust (edited e)
+  return $ GenericWidget (tidings b ev) (widgetControl e)
+
+-- | An editor for union types, built from editors for its constructors.
+editorSum
+  :: (Ord tag, Show tag, Renderable el)
+  => (Layout -> Layout -> Layout) -> [(tag, Editor a el a)] -> (a -> tag) -> Editor a Layout a
+editorSum combineLayout options selector = Editor $ \ba -> do
+  options <- mapM (\(tag, Editor mk) -> (tag,) <$> (mk ba >>= renderEditor)) options
+  let tag = selector <$> ba
+  tag' <- calmB tag
+  let build a = lookup a options
+  -- build a tag selector following the current tag
+  l <- listBox (pure $ fmap fst options) (Just <$> tag) (pure (string . show))
+  -- a placeholder for the constructor editor
+  nestedEditor <-
+    new # sink children ((\x -> [maybe (error "editorSum") widgetControl (build x)]) <$> tag')
+  --
+  let composed = combineLayout (Single (return $ getElement l)) (Single $ return nestedEditor)
+  -- the result event fires when any of the nested editors or the tag selector fire.
+  let editedEvents = fmap (edited . snd) options
+      eTag = filterJust $ rumors (userSelection l)
+      taggedOptions = sequenceA [(tag, ) <$> contents e | (tag, e) <- options]
+      editedTag = filterJust $ flip lookup <$> taggedOptions <@> eTag
+      editedE = head <$> unions (editedTag : editedEvents)
+  return $ GenericWidget (tidings ba editedE) composed
+
+editorIdentity :: Editor a el a -> Editor (Identity a) el (Identity a)
+editorIdentity = dimapE runIdentity Identity
+
+--------------------------
+-- EditorCollection
+
+data EditorCollection k w = EditorCollection
+  { selector :: ListBox k
+  , add, remove :: Element
+  , selected :: w
+  }
+
+instance Renderable w => Renderable (EditorCollection k w) where
+  render EditorCollection{..} =
+    column
+    [row [ element selector, element add, element remove]
+    ,render selected]
+
+data EditorCollectionConfig k v = EditorCollectionConfig
+  { eccNewKey      :: Behavior k                 -- ^ Current value to use for creating a new key
+  , eccAfterDelKey :: Behavior (Maybe k)         -- ^ Current value to use if the selected key is deleted
+  , eccTemplate    :: v                          -- ^ Value to use for creating new items
+  , eccOptions     :: Behavior (Set k)           -- ^ Currently user select able keys
+  , eccDisplay     :: Behavior (k -> UI Element) -- ^ How to render a key
+  }
+
+defaultEditorCollectionConfig
+  :: (Enum k, Ord k, Show k, HasEmpty v)
+  => Behavior (Maybe k, Map k v) -> EditorCollectionConfig k v
+defaultEditorCollectionConfig db = EditorCollectionConfig
+  { eccTemplate = emptyValue
+  , eccOptions  = options
+  , eccDisplay  = pure (UI.string . show)
+  , eccNewKey   = maybe (toEnum 0) succ . Set.lookupMax <$> options
+  , eccAfterDelKey = deletedKey <$> (fst <$> db) <*> options
+  }
+  where
+    options = Map.keysSet . snd <$> db
+
+    deletedKey Nothing  _  = Nothing
+    deletedKey (Just k) kk = Set.lookupLT k kk `mplus` Set.lookupGT k kk
+
+-- | A barebones editor for collections of editable items.
+--   Displays an index selector, add and delete buttons, and an editor for the selected item.
+--   Limitations:
+--     - Won't work with recursive data structures, due to the lack of FRP switch.
+editorCollection
+  :: forall k v w.
+     (Ord k, Renderable w)
+  => (Behavior (Maybe k, Map k v) -> EditorCollectionConfig k v)
+  -> Editor v w v
+  -> Editor (Maybe k, Map k v) (EditorCollection k w) (Maybe k, Map k v)
+editorCollection mkConfig editorOne = Editor $ \(ba :: Behavior (Maybe k, Map k v)) -> mdo
+  let EditorCollectionConfig{..} = mkConfig ba
+      (selectedKey, db) = (fst <$> ba, snd <$> ba)
+  sel  <- create (editorSelection (Set.toList <$> eccOptions) eccDisplay) (fst <$> ba)
+  one  <- create editorOne $ (\(k, db) -> fromMaybe eccTemplate (k >>= (`Map.lookup` db))) <$> ba
+  addB <- button #+ [string "+"]
+  remB <- button #+ [string "-"]
+  let insert i = Map.insert i eccTemplate
+      editsDb = head <$> unions
+                [ replace <$> ba <@> edited one
+                , insert  <$> eccNewKey <*> db <@ click addB
+                , delete  <$> ba <@ click remB
+                ]
+      editsKey = head <$> unions
+                [ edited sel
+                , Just <$> eccNewKey <@ click addB
+                , eccAfterDelKey <@ click remB
+                ]
+      tids = (,) <$> tidings selectedKey editsKey <*> tidings db editsDb
+  return $ GenericWidget tids (EditorCollection (widgetControl sel) addB remB (widgetControl one))
+ where
+   replace (Just i,xx) x = Map.alter (const $ Just x) i xx
+   replace (Nothing,x) _ = x
+   delete  (Just i,xx)   = Map.delete i xx
+   delete  (_,xx)        = xx
+
+-- | A barebones editor for collections of editable items.
+--   Displays an index selector, add and delete buttons, and an editor for the selected item.
+--   Limitations:
+--     - Won't work with recursive data structures, due to the lack of FRP switch.
+editorList
+  :: (HasEmpty a, Renderable w)
+  => Editor a w a -> Editor (Maybe Int, [a]) (EditorCollection Int w) (Maybe Int, [a])
+editorList e =
+  dimapE (second (Map.fromAscList . zip [0 ..])) (second F.toList) $
+  editorCollection config e
+  where
+    (<&>) = flip (<$>)
+    infixl 1 <&>
+    config ba =
+      (defaultEditorCollectionConfig ba)
+      { eccAfterDelKey =
+        ba <&> (\(i,m) ->
+             i >>= (\i ->
+                      if Map.member (i + 1) m
+                      then return i
+                      else let i' = max 0 (i - 1)
+                           in guard(i'>=0) >> return i'))
+      }
+
diff --git a/tests/examples/ghc84/arrowfail003.hs b/tests/examples/ghc84/arrowfail003.hs
new file mode 100644
--- /dev/null
+++ b/tests/examples/ghc84/arrowfail003.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE Arrows #-}
+-- Arrow commands where an expression is expected
+
+module ShouldFail where
+
+import Control.Arrow
+
+foo = returnA -< []
+bar = (|zeroArrow|)
+
diff --git a/tests/examples/transform/Brittany1.hs b/tests/examples/transform/Brittany1.hs
deleted file mode 100644
--- a/tests/examples/transform/Brittany1.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-
--- From https://github.com/alanz/ghc-exactprint/issues/53#issuecomment-306839162
-
-blah = func
-  where
---                       status   standard   previous
---                       quo      layouting  /associated
---                                rule only  ast item
- func =
-  -- mercury             (1, 1)   (1,1)      (1,1)
-    [
-        -- venus         (1, 7)   (1, 7)     (1, 7) or (1, 2) if connected to "foo x"
-      foo x
-         -- earth        (1, 8)   (1, 8)     (1, 3)
-     |   y <- z
-       -- pluto          (1, -2)  (1, 6)     (1, -2)
-      -- saturn          (1, -3)  (1, 5)     (1, -3)
-     ,    x <- y
-           -- jupiter    (1, 2)   (1, 10)    (1, 1)
-     ,      pred x
-  -- nepturn             (1, 1)   (1, 1)     (1, -10)
-      ]
diff --git a/tests/examples/transform/Brittany1.hs.expected b/tests/examples/transform/Brittany1.hs.expected
deleted file mode 100644
--- a/tests/examples/transform/Brittany1.hs.expected
+++ /dev/null
@@ -1,22 +0,0 @@
-
--- From https://github.com/alanz/ghc-exactprint/issues/53#issuecomment-306839162
-
-blah = func
-  where
---                       status   standard   previous
---                       quo      layouting  /associated
---                                rule only  ast item
- func =
-  -- mercury             (1, 1)   (1,1)      (1,1)
-    [
-        -- venus         (1, 7)   (1, 7)     (1, 7) or (1, 2) if connected to "foo x"
-      foo x
-         -- earth        (1, 8)   (1, 8)     (1, 3)
-     |   y <- z
-       -- pluto          (1, -2)  (1, 6)     (1, -2)
-      -- saturn          (1, -3)  (1, 5)     (1, -3)
-     ,    x <- y
-           -- jupiter    (1, 2)   (1, 10)    (1, 1)
-     ,      pred x
-  -- nepturn             (1, 1)   (1, 1)     (1, -10)
-      ]