ghc-exactprint 0.5.3.1 → 0.5.4.0

raw patch · 22 files changed

+8886/−3728 lines, 22 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog +2/−0
• ghc-exactprint.cabal +33/−9
• src-ghc710/Language/Haskell/GHC/ExactPrint/Annotater.hs +2555/−0
• src-ghc80/Language/Haskell/GHC/ExactPrint/Annotater.hs +2750/−0
• src-ghc82/Language/Haskell/GHC/ExactPrint/Annotater.hs +2660/−0
• src/Language/Haskell/GHC/ExactPrint/Annotate.hs +5/−3658
• src/Language/Haskell/GHC/ExactPrint/AnnotateTypes.hs +370/−0
• src/Language/Haskell/GHC/ExactPrint/Delta.hs +82/−13
• src/Language/Haskell/GHC/ExactPrint/GhcInterim.hs +7/−0
• src/Language/Haskell/GHC/ExactPrint/Lookup.hs +25/−1
• src/Language/Haskell/GHC/ExactPrint/Preprocess.hs +7/−0
• src/Language/Haskell/GHC/ExactPrint/Pretty.hs +17/−16
• src/Language/Haskell/GHC/ExactPrint/Print.hs +2/−2
• src/Language/Haskell/GHC/ExactPrint/Utils.hs +24/−5
• tests/Test.hs +57/−23
• tests/Test/NoAnnotations.hs +6/−1
• tests/Test/Transform.hs +10/−0
• tests/examples/ghc710/DiophantineVect.hs +40/−0
• tests/examples/ghc710/ExplicitNamespaces.hs +1/−0
• tests/examples/ghc710/read018.hs +17/−0
• tests/examples/ghc80/MonadT.hs +48/−0
• tests/examples/ghc80/Zwaluw.hs +168/−0

@@ -1,3 +1,5 @@+2017-05-17 v0.5.4.0+	* Support GHC 8.2 (rc2) 2017-05-05 v0.5.3.1 	* Fix bug roundtripping optional semicolons on if statements. 2017-02-07 v0.5.3.0

@@ -1,5 +1,5 @@ name:                ghc-exactprint-version:             0.5.3.1+version:             0.5.4.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@@ -17,7 +17,10 @@                         * Print - converts an AST and its annotations to                           properly formatted source text.                      .+                        * Pretty - adds annotations to an AST (fragment) so that+                          the output can be parsed back to the same AST.                      .+                     .                      Note: requires GHC 7.10.2 or later  license:             BSD3@@ -26,8 +29,9 @@ maintainer:          alan.zimm@gmail.com category:            Development build-type:          Simple-tested-with:    GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2+tested-with:    GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2, GHC == 8.2.1 extra-source-files:  ChangeLog+                     src-ghc710/Language/Haskell/GHC/ExactPrint/*.hs                      tests/examples/failing/*.hs                      tests/examples/ghc710/*.hs                      tests/examples/ghc710-only/*.hs@@ -56,22 +60,25 @@ library   exposed-modules:     Language.Haskell.GHC.ExactPrint                      , Language.Haskell.GHC.ExactPrint.Annotate+                     , Language.Haskell.GHC.ExactPrint.AnnotateTypes+                     , Language.Haskell.GHC.ExactPrint.Annotater                      , Language.Haskell.GHC.ExactPrint.Delta-                     , Language.Haskell.GHC.ExactPrint.GhcInterim                      , Language.Haskell.GHC.ExactPrint.Lookup+                     , Language.Haskell.GHC.ExactPrint.Parsers                      , Language.Haskell.GHC.ExactPrint.Preprocess                      , Language.Haskell.GHC.ExactPrint.Pretty                      , Language.Haskell.GHC.ExactPrint.Print                      , Language.Haskell.GHC.ExactPrint.Transform                      , Language.Haskell.GHC.ExactPrint.Types                      , Language.Haskell.GHC.ExactPrint.Utils-                     , Language.Haskell.GHC.ExactPrint.Parsers +  if impl (ghc <= 8.0.2)+      exposed-modules: Language.Haskell.GHC.ExactPrint.GhcInterim    -- other-modules:   -- other-extensions:   GHC-Options:         -Wall-  build-depends:       base >=4.7 && <5.0+  build-depends:       base >=4.7 && <4.11                      , bytestring >= 0.10.6                      , containers >= 0.5                      , directory >= 1.2@@ -84,6 +91,15 @@   if impl (ghc >= 7.11)       build-depends: ghc-boot   hs-source-dirs:      src++  if impl (ghc > 8.0.3)+      hs-source-dirs: src-ghc82+  else+    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)       buildable: False@@ -96,17 +112,25 @@   else     hs-source-dirs:      tests +  if impl (ghc > 8.0.3)+      hs-source-dirs: src-ghc82+  else+    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                      , Test.Consistency                      , Test.NoAnnotations                      , Test.Transform-  GHC-Options:         -threaded+  GHC-Options:         -threaded -Wall   Default-language:    Haskell2010   if impl (ghc < 7.10.2)       buildable: False   Build-depends:       HUnit >= 1.2-                     , base < 5+                     , base < 4.11                      , bytestring                      , containers >= 0.5                      , Diff@@ -152,7 +176,7 @@   else     buildable: False   ghc-options:-    -threaded+    -threaded -Wall  executable static   main-is: Static.hs@@ -171,7 +195,7 @@   else     buildable: False   ghc-options:-    -threaded+    -threaded -Wall  executable prepare-hackage   main-is: PrepareHackage.hs

@@ -0,0 +1,2555 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# 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.RdrName) 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.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => GHC.HsLocalBinds name -> 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.RdrName) 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 ls txt) lss) = do+    markExternal ls GHC.AnnOpen txt+    mark GHC.AnnOpenS+    markListIntercalate lss+    mark GHC.AnnCloseS+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.DeprecatedTxt (GHC.L ls txt) lss) = do+    markExternal ls GHC.AnnOpen txt+    mark GHC.AnnOpenS+    markListIntercalate lss+    mark GHC.AnnCloseS+    markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------++instance Annotate (GHC.SourceText,GHC.FastString) where+  markAST l (src,_fs) = do+    markExternal l GHC.AnnVal src++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.HasOccName name,Annotate name)+  => Annotate [GHC.LIE name] 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 (GHC.DataId name,GHC.HasOccName name, Annotate name)+  => Annotate (GHC.IE name) where+  markAST _ ie = do++    case ie of+        (GHC.IEVar ln) -> do+          -- TODO: I am pretty sure this criterion is inadequate+          if GHC.isDataOcc $ GHC.occName $ GHC.unLoc ln+            then mark GHC.AnnPattern+            else markOptional GHC.AnnPattern+          setContext (Set.fromList [PrefixOp,InIE]) $ markLocated ln++        (GHC.IEThingAbs ln@(GHC.L _ n)) -> do+          {-+          At the moment (7.10.2) GHC does not cleanly represent an export of the form+           "type Foo"+          and it only captures the name "Foo".++          The Api Annotations workaround is to have the IEThingAbs SrcSpan+          extend across both the "type" and "Foo", and then to capture the+          individual item locations in an AnnType and AnnVal annotation.++          This need to be fixed for 7.12.++          -}++          if GHC.isTcOcc (GHC.occName n) && GHC.isSymOcc (GHC.occName n)+            then do+              mark GHC.AnnType+              setContext (Set.singleton PrefixOp) $ markLocatedFromKw GHC.AnnVal ln+            else setContext (Set.singleton PrefixOp) $ markLocated ln++        (GHC.IEThingWith ln ns) -> do+          setContext (Set.singleton PrefixOp) $ markLocated ln+          mark GHC.AnnOpenP+          setContext (Set.singleton 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)++-- ---------------------------------------------------------------------+{-+-- For details on above see note [Api annotations] in ApiAnnotation+data RdrName+  = Unqual OccName+        -- ^ Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.+        -- Create such a 'RdrName' with 'mkRdrUnqual'++  | Qual ModuleName OccName+        -- ^ A qualified name written by the user in+        -- /source/ code.  The module isn't necessarily+        -- the module where the thing is defined;+        -- just the one from which it is imported.+        -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.+        -- Create such a 'RdrName' with 'mkRdrQual'++  | Orig Module OccName+        -- ^ An original name; the module is the /defining/ module.+        -- This is used when GHC generates code that will be fed+        -- into the renamer (e.g. from deriving clauses), but where+        -- we want to say \"Use Prelude.map dammit\". One of these+        -- can be created with 'mkOrig'++  | Exact Name+        -- ^ We know exactly the 'Name'. This is used:+        --+        --  (1) When the parser parses built-in syntax like @[]@+        --      and @(,)@, but wants a 'RdrName' from it+        --+        --  (2) By Template Haskell, when TH has generated a unique name+        --+        -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'+  deriving (Data, Typeable)+-}++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 && rdrName2String n /= "$"+      doNormalRdrName = do+        let str' = case str of+              -- TODO: unicode support?+                        "forall" -> if spanLength l == 1 then "∀" else str+                        _ -> str+        when (GHC.isTcClsNameSpace $ GHC.rdrNameSpace n) $ inContext (Set.singleton InIE) $ mark GHC.AnnType+        markOptional GHC.AnnType++        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 _ _ -> 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+           mark GHC.AnnOpenP+           mark GHC.AnnTilde+           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")++-- ---------------------------------------------------------------------++-- TODO: What is this used for? Not in ExactPrint+instance Annotate GHC.Name where+  markAST l n = do+    markExternal l GHC.AnnVal (showGhc n)++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.ImportDecl name) 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 "#-}"+   when src (markWithString GHC.AnnOpen (fromMaybe "{-# SOURCE" msrc)+             >> markWithString GHC.AnnClose "#-}")+   when safeflag (mark GHC.AnnSafe)+   when qualFlag (unsetContext TopLevel $ mark GHC.AnnQualified)+   case mpkg of+    Nothing -> return ()+    Just pkg -> markWithString GHC.AnnPackageName (show (GHC.unpackFS pkg))++   markLocated modname++   case GHC.ideclAs imp of+      Nothing -> return ()+      Just mn -> do+          mark GHC.AnnAs+          markWithString GHC.AnnVal (GHC.moduleNameString 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.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+            => GHC.LHsDecl name -> 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)+      GHC.QuasiQuoteD d -> markLocated (GHC.L l d)++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+            => Annotate (GHC.HsDecl name) where+  markAST l d = markLHsDecl (GHC.L l d)++-- ---------------------------------------------------------------------++instance (Annotate name)+   => Annotate (GHC.RoleAnnotDecl name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.SpliceDecl name) where+  markAST _ (GHC.SpliceDecl e flag) = do+    case flag of+      GHC.ExplicitSplice -> mark GHC.AnnOpenPE+      GHC.ImplicitSplice -> return ()++    setContext (Set.singleton InSpliceDecl) $ markLocated e++    case flag of+      GHC.ExplicitSplice -> mark GHC.AnnCloseP+      GHC.ImplicitSplice -> return ()++    markTrailingSemi++{-+- data SpliceExplicitFlag = ExplicitSplice | -- <=> $(f x y)+-                           ImplicitSplice   -- <=> f x y,  i.e. a naked+-                           top level expression+-+-}++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.VectDecl name) where+  markAST _ (GHC.HsVect src ln e) = do+    markWithString GHC.AnnOpen src -- "{-# VECTORISE"+    markLocated ln+    mark GHC.AnnEqual+    markLocated e+    markWithString GHC.AnnClose "#-}" -- "#-}"++  markAST _ (GHC.HsNoVect src ln) = do+    markWithString GHC.AnnOpen src -- "{-# NOVECTORISE"+    markLocated ln+    markWithString GHC.AnnClose "#-}" -- "#-}"++  markAST _ (GHC.HsVectTypeIn src _b ln mln) = do+    markWithString GHC.AnnOpen 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+    markWithString GHC.AnnOpen 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.RuleDecls name) where+   markAST _ (GHC.HsRules src rules) = do+     markWithString GHC.AnnOpen src+     setLayoutFlag $ markListIntercalateWithFunLevel markLocated 2 rules+     markWithString GHC.AnnClose "#-}"+     markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.RuleDecl name) where+  markAST _ (GHC.HsRule ln act bndrs lhs _ rhs _) = do+    markLocated ln+    setContext (Set.singleton ExplicitNeverActive) $ markActivation 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.Activation -> Annotated ()+markActivation act = do+  case act of+    GHC.ActiveBefore n -> do+      mark GHC.AnnOpenS --  '['+      mark GHC.AnnTilde -- ~+      markWithString GHC.AnnVal (show n)+      mark GHC.AnnCloseS -- ']'+    GHC.ActiveAfter n -> do+      mark GHC.AnnOpenS --  '['+      markWithString GHC.AnnVal (show n)+      mark GHC.AnnCloseS -- ']'+    GHC.NeverActive -> do+      inContext (Set.singleton ExplicitNeverActive) $ do+        mark GHC.AnnOpenS --  '['+        mark GHC.AnnTilde -- ~+        mark GHC.AnnCloseS -- ']'+    _ -> return ()++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.RuleBndr name) where+  markAST _ (GHC.RuleBndr ln) = markLocated ln+  markAST _ (GHC.RuleBndrSig ln (GHC.HsWB thing _ _ _)) = do+    mark GHC.AnnOpenP -- "("+    markLocated ln+    mark GHC.AnnDcolon+    markLocated thing+    mark GHC.AnnCloseP -- ")"++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.AnnDecl name) where+   markAST _ (GHC.HsAnnotation src prov e) = do+     markWithString GHC.AnnOpen src+     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 name => Annotate (GHC.WarnDecls name) where+   markAST _ (GHC.Warnings src warns) = do+     markWithString GHC.AnnOpen src+     mapM_ markLocated warns+     markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------++instance (Annotate name)+   => Annotate (GHC.WarnDecl name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.ForeignDecl name) where+  markAST _ (GHC.ForeignImport ln 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+    markExternal ls GHC.AnnVal (show src)+    markLocated ln+    mark GHC.AnnDcolon+    markLocated typ+    markTrailingSemi+++  markAST _l (GHC.ForeignExport ln typ _ (GHC.CExport spec (GHC.L ls src))) = do+    mark GHC.AnnForeign+    mark GHC.AnnExport+    markLocated spec+    markExternal ls GHC.AnnVal (show src)+    setContext (Set.singleton PrefixOp) $ markLocated ln+    mark GHC.AnnDcolon+    markLocated typ+++-- ---------------------------------------------------------------------++instance (Annotate GHC.CExportSpec) where+  markAST l (GHC.CExportStatic _ 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.DerivDecl name) where++  markAST _ (GHC.DerivDecl typ mov) = do+    mark GHC.AnnDeriving+    mark GHC.AnnInstance+    markMaybe mov+    markLocated typ+    markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.DefaultDecl name) where++  markAST _ (GHC.DefaultDecl typs) = do+    mark GHC.AnnDefault+    mark GHC.AnnOpenP -- '('+    markListIntercalate typs+    mark GHC.AnnCloseP -- ')'+    markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.InstDecl name) 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+  markAST _ (GHC.NoOverlap src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Overlappable src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Overlapping src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Overlaps src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Incoherent src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.ClsInstDecl name) where++  markAST _ (GHC.ClsInstDecl 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.TyFamInstDecl name) where++  markAST _ (GHC.TyFamInstDecl eqn _) = do+    mark GHC.AnnType+    inContext (Set.singleton TopLevel) $ mark GHC.AnnInstance -- Note: this keyword is optional+    markLocated eqn+    markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.DataFamInstDecl name) where++  markAST l (GHC.DataFamInstDecl ln (GHC.HsWB pats _ _ _)+             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+    inContext (Set.singleton TopLevel) $ mark GHC.AnnInstance++    markLocated ctx++    markTyClass ln pats++    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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsBind name) where+  markAST _ (GHC.FunBind _ _ (GHC.MG 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 lb) _typ _fvs _ticks) = do+    markLocated lhs+    case grhs of+      (GHC.L _ (GHC.GRHS [] _):_) -> mark GHC.AnnEqual -- empty guards+      _ -> return ()+    markListIntercalateWithFunLevel markLocated 2 grhs+    unless (GHC.isEmptyLocalBinds lb) $ mark GHC.AnnWhere+    markOptional GHC.AnnWhere++    markLocalBindsWithLayout lb+    markTrailingSemi++  markAST _ (GHC.VarBind _n rhse _) =+    -- Note: this bind is introduced by the typechecker+    markLocated rhse++  markAST l (GHC.PatSynBind (GHC.PSB ln _fvs args def dir)) = do+    mark GHC.AnnPattern+    case args of+      GHC.InfixPatSyn la lb -> do+        markLocated la+        setContext (Set.singleton InfixOp) $ markLocated ln+        markLocated lb+      GHC.PrefixPatSyn ns -> do+        markLocated ln+        mapM_ markLocated ns+    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++  -- Introduced after renaming.+  markAST _ (GHC.AbsBinds _ _ _ _ _) =+    traceM "warning: AbsBinds introduced after renaming"++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+    => Annotate (GHC.IPBind name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name,+                                                  Annotate body)+  => Annotate (GHC.Match name (GHC.Located body)) where++  markAST _ (GHC.Match mln pats _typ (GHC.GRHSs grhs lb)) = do+    let+      get_infix Nothing = False+      get_infix (Just (_,f)) = f+      isFunBind = isJust+    case (get_infix mln,pats) of+      (True, a:b:xs) -> do+        if null xs+          then markOptional GHC.AnnOpenP+          else mark         GHC.AnnOpenP+        markLocated a+        case mln of+          Nothing -> return ()+          Just (n,_) -> setContext (Set.singleton InfixOp) $ markLocated n+        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+          -- Nothing -> mark GHC.AnnFunId+          Nothing -> markListNoPrecedingSpace False pats+          Just (n,_) -> do+            setContext (Set.fromList [NoPrecedingSpace,PrefixOp]) $ markLocated n+            mapM_ markLocated pats+        -- markListNoPrecedingSpace 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,+          Annotate name, Annotate body)+  => Annotate (GHC.GRHS name (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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.Sig name) where++  markAST _ (GHC.TypeSig lns typ _) = do+    setContext (Set.singleton PrefixOp) $ markListNoPrecedingSpace True lns+    mark GHC.AnnDcolon+    markLocated typ+    markTrailingSemi+    tellContext (Set.singleton FollowingLine)++  markAST _ (GHC.PatSynSig ln (_ef,GHC.HsQTvs _ns bndrs) ctx1 ctx2 typ) = do+    mark GHC.AnnPattern+    markLocated ln+    mark GHC.AnnDcolon++    -- Note: The 'forall' bndrs '.' may occur multiple times+    unless (null bndrs) $ do+      mark GHC.AnnForall+      mapM_ markLocated bndrs+      mark GHC.AnnDot++    when (GHC.getLoc ctx1 /= GHC.noSrcSpan) $ do+        setContext (Set.fromList [Parens,NoDarrow]) $ markLocated ctx1+        markOffset GHC.AnnDarrow 0+    when (GHC.getLoc ctx2 /= GHC.noSrcSpan) $ do+        setContext (Set.fromList [Parens,NoDarrow]) $ markLocated ctx2+        markOffset GHC.AnnDarrow 1+    markLocated typ+    markTrailingSemi++  markAST _ (GHC.GenericSig ns typ) = do+    mark GHC.AnnDefault+    -- markListIntercalate ns+    setContext (Set.singleton PrefixOp) $ markListIntercalate ns+    mark GHC.AnnDcolon+    markLocated typ+    markTrailingSemi++  markAST _ (GHC.IdSig _) =+    traceM "warning: Introduced after renaming"++  -- FixSig (FixitySig name)+  markAST _ (GHC.FixSig (GHC.FixitySig lns (GHC.Fixity v fdir))) = do+    let fixstr = case fdir of+         GHC.InfixL -> "infixl"+         GHC.InfixR -> "infixr"+         GHC.InfixN -> "infix"+    markWithString GHC.AnnInfix fixstr+    markWithString GHC.AnnVal (show v)+    setContext (Set.singleton InfixOp) $ markListIntercalate lns+    markTrailingSemi++  -- InlineSig (Located name) InlinePragma+  -- '{-# INLINE' activation qvar '#-}'+  markAST _ (GHC.InlineSig ln inl) = do+    markWithString GHC.AnnOpen (GHC.inl_src inl) -- '{-# INLINE'+    markActivation (GHC.inl_act inl)+    setContext (Set.singleton PrefixOp) $ markLocated ln+    markWithString GHC.AnnClose "#-}" -- '#-}'+    markTrailingSemi++  markAST _ (GHC.SpecSig ln typs inl) = do+    markWithString GHC.AnnOpen (GHC.inl_src inl)+    markActivation (GHC.inl_act inl)+    markLocated ln+    mark GHC.AnnDcolon -- '::'+    markListIntercalate typs+    markWithString GHC.AnnClose "#-}" -- '#-}'+    markTrailingSemi+++  -- '{-# SPECIALISE' 'instance' inst_type '#-}'+  markAST _ (GHC.SpecInstSig src typ) = do+    markWithString GHC.AnnOpen src+    mark GHC.AnnInstance+    markLocated typ+    markWithString GHC.AnnClose "#-}" -- '#-}'+    markTrailingSemi++++  -- MinimalSig (BooleanFormula (Located name))+  markAST _l (GHC.MinimalSig src formula) = do+    markWithString GHC.AnnOpen src+    annotationsToCommentsBF formula [GHC.AnnOpenP,GHC.AnnCloseP,GHC.AnnComma,GHC.AnnVbar]+    markAST _l formula+    finalizeBF _l+    markWithString GHC.AnnClose "#-}"+    markTrailingSemi++-- --------------------------------------------------------------------++-- In practice, due to the way the BooleanFormula is constructed in the parser,+-- we will get the following variants+-- a | b : Or [a,b]+-- a , b : And [a,b]+-- ( a ) : a+-- A bottom level Located RdrName is captured in a Var. This is the only part+-- with a location in it.+--+-- So the best strategy might be to convert all the annotations into comments,+-- and then just print the names. DONE+instance  (Annotate name) => Annotate (GHC.BooleanFormula (GHC.Located name)) where+  -- markAST _ (GHC.Var x)  = markLocated x+  markAST _ (GHC.Var x)  = setContext (Set.singleton PrefixOp) $ markLocated x+  markAST l (GHC.Or ls)  = mapM_ (markAST l) ls+  markAST l (GHC.And ls) = mapM_ (markAST l) ls++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsTyVarBndr name) where+  markAST _l (GHC.UserTyVar n) = do+    markAST _l n++  markAST _ (GHC.KindedTyVar n ty) = do+    mark GHC.AnnOpenP  -- '('+    markLocated n+    mark GHC.AnnDcolon -- '::'+    markLocated ty+    mark GHC.AnnCloseP -- '('++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.HsType name) where+  markAST loc ty = do+    markType loc ty+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma+   where++    -- markType :: GHC.SrcSpan -> ast -> Annotated ()+    markType _ (GHC.HsForAllTy _f mwc (GHC.HsQTvs _kvs tvs) ctx@(GHC.L lc ctxs) typ) = do+      unless (null tvs) $ do+        mark GHC.AnnForall+        mapM_ markLocated tvs+        mark GHC.AnnDot++      case mwc of+        Nothing -> when (lc /= GHC.noSrcSpan) $ markLocated ctx+        Just lwc -> do+         let sorted = lexicalSortLocated (GHC.L lwc GHC.HsWildcardTy:ctxs)+         markLocated (GHC.L lc sorted)++      markLocated typ+      -- mark GHC.AnnCloseP -- ")"++    markType _l (GHC.HsTyVar name) = do+      if GHC.isDataOcc $ GHC.occName name+        then do+            mark GHC.AnnSimpleQuote+            markLocatedFromKw GHC.AnnName (GHC.L _l name)+        else unsetContext Intercalate  $ markAST _l name++    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.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 (GHC.HsIPName n) t) = do+      markWithString GHC.AnnVal ("?" ++ (GHC.unpackFS 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+      mark GHC.AnnOpenPE+      markAST l s+      mark GHC.AnnCloseP++    markType _ (GHC.HsDocTy t ds) = do+      markLocated t+      markLocated ds++    markType _ (GHC.HsBangTy b t) = do+      case b of+        (GHC.HsSrcBang ms (Just True) _) -> do+          markWithString GHC.AnnOpen  (fromMaybe "{-# UNPACK" ms)+          markWithString GHC.AnnClose "#-}"+        (GHC.HsSrcBang ms (Just False) _) -> do+          markWithString GHC.AnnOpen  (fromMaybe "{-# NOUNPACK" ms)+          markWithString GHC.AnnClose "#-}"+        _ -> return ()+      mark GHC.AnnBang+      markLocated t++    markType _ (GHC.HsRecTy cons) = do+      mark GHC.AnnOpenC  -- '{'+      markListIntercalate cons+      mark GHC.AnnCloseC -- '}'++    -- HsCoreTy Type+    markType _ (GHC.HsCoreTy _t) =+      traceM "warning: HsCoreTy Introduced after renaming"++    markType _ (GHC.HsExplicitListTy _ ts) = do+      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++    -- HsTyLit HsTyLit+    markType l (GHC.HsTyLit lit) = do+      case lit of+        (GHC.HsNumTy s _) ->+          markExternal l GHC.AnnVal s+        (GHC.HsStrTy s _) ->+          markExternal l GHC.AnnVal s++    -- HsWrapTy HsTyAnnotated (HsType name)+    markType _ (GHC.HsWrapTy _ _) =+      traceM "warning: HsWrapTyy Introduced after renaming"++    markType l GHC.HsWildcardTy = do+      markExternal l GHC.AnnVal "_"+    markType l (GHC.HsNamedWildcardTy n) = do+      markExternal l GHC.AnnVal  (showGhc n)++    markType l (GHC.HsQuasiQuoteTy n) = do+      markAST l n++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsSplice name) where+  markAST _ c =+    case c of+      GHC.HsSplice _n b@(GHC.L _ (GHC.HsVar n))  -> do+        -- TODO: We do not seem to have any way to distinguish between which of+        -- the next two lines will emit output. If AnnThIdSplice is there, the+        markWithStringOptional GHC.AnnThIdSplice   ("$" ++ (GHC.occNameString (GHC.occName n)))+        markLocated b+      GHC.HsSplice _n b@(GHC.L _ (GHC.HsBracket _)) -> do+        markLocated b+      GHC.HsSplice _n b -> do+        markLocated b++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsQuasiQuote name) where+  markAST l (GHC.HsQuasiQuote n _pos fs) = do+        markExternal l GHC.AnnVal+              ("[" ++ showGhc n ++ "|" ++ GHC.unpackFS fs ++ "|]")++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name) =>+                             Annotate (GHC.ConDeclField name) where+  markAST _ (GHC.ConDeclField ns ty mdoc) = do+{-+data ConDeclField name  -- Record fields have Haddoc docs on them+  = ConDeclField { cd_fld_names :: [LFieldOcc name],+                                   -- ^ See Note [ConDeclField names]+                   cd_fld_type :: LBangType name,+                   cd_fld_doc  :: Maybe LHsDocString }++-}+    unsetContext Intercalate $ do+      markListIntercalate ns+      mark GHC.AnnDcolon+      markLocated ty+      markMaybe mdoc+    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 (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.Pat name) 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 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.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"++      -- ViewPat (LHsExpr id) (LPat id) (PostTc id Type)+      markPat _ (GHC.ViewPat e pat _) = do+        markLocated e+        mark GHC.AnnRarrow+        markLocated pat++      -- SplicePat (HsSplice id)+      markPat l (GHC.SplicePat s) = do+        mark GHC.AnnOpenPE+        markAST l s+        mark GHC.AnnCloseP++      -- LitPat HsLit+      markPat l (GHC.LitPat lp) = markExternal l GHC.AnnVal (hsLit2String lp)++      -- NPat (HsOverLit id) (Maybe (SyntaxExpr id)) (SyntaxExpr id)+      markPat _ (GHC.NPat ol mn _) = do+        -- markOptional GHC.AnnMinus+        when (isJust mn) $ mark GHC.AnnMinus+        markLocated ol++      -- NPlusKPat (Located id) (HsOverLit id) (SyntaxExpr id) (SyntaxExpr id)+      markPat _ (GHC.NPlusKPat ln ol _ _) = do+        markLocated ln+        markWithString GHC.AnnVal "+"  -- "+"+        markLocated ol+++      markPat _ (GHC.SigPatIn pat (GHC.HsWB ty _ _ _)) = do+        markLocated pat+        mark GHC.AnnDcolon+        markLocated ty++      markPat _ GHC.SigPatOut {} =+        traceM "warning: SigPatOut introduced after renaming"++      -- CoPat HsAnnotated (Pat id) Type+      markPat _ GHC.CoPat {} =+        traceM "warning: CoPat introduced after renaming"++      markPat l (GHC.QuasiQuotePat p) = markAST l p++-- ---------------------------------------------------------------------+hsLit2String :: GHC.HsLit -> GHC.SourceText+hsLit2String lit =+  case lit of+    GHC.HsChar       src _   -> src+    -- It should be included here+    -- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x#L1471+    GHC.HsCharPrim   src _   -> src ++ "#"+    GHC.HsString     src _   -> src+    GHC.HsStringPrim src _   -> src+    GHC.HsInt        src _   -> src+    GHC.HsIntPrim    src _   -> src+    GHC.HsWordPrim   src _   -> src+    GHC.HsInt64Prim  src _   -> src+    GHC.HsWord64Prim src _   -> src+    GHC.HsInteger    src _ _ -> src+    GHC.HsRat        (GHC.FL src _) _ -> src+    GHC.HsFloatPrim  (GHC.FL src _)   -> src ++ "#"+    GHC.HsDoublePrim (GHC.FL src _)   -> src ++ "##"++markHsConPatDetails :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+                      => GHC.Located name -> GHC.HsConPatDetails name -> 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+      setContext (Set.singleton InfixOp) $ markLocated ln+      markLocated a2++markHsConDeclDetails :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+                    => Bool -> Bool -> [GHC.Located name] -> GHC.HsConDeclDetails name -> 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate [GHC.LConDeclField name] 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 (GHC.DataId name) => Annotate (GHC.HsOverLit name) where+  markAST l ol =+    let str = case GHC.ol_val ol of+                GHC.HsIntegral src _ -> src+                GHC.HsFractional l2  -> GHC.fl_text l2+                GHC.HsIsString src _ -> src+    in+    markExternal l GHC.AnnVal str++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate arg)+    => Annotate (GHC.HsWithBndrs name (GHC.Located arg)) where+  markAST _ (GHC.HsWB thing _ _ _) = do+    markLocated thing++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,Annotate name+         ,GHC.HasOccName name,Annotate body)+  => Annotate (GHC.Stmt name (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.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 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  (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  =>  Annotate (GHC.ParStmtBlock name name) where+  markAST _ (GHC.ParStmtBlock stmts _ns _) = do+    markListIntercalate stmts++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsLocalBinds name) where+  markAST _ lb = markHsLocalBinds lb++-- ---------------------------------------------------------------------++markHsLocalBinds :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+                     => GHC.HsLocalBinds name -> 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 (reverse binds)+markHsLocalBinds GHC.EmptyLocalBinds                   = return ()++-- ---------------------------------------------------------------------++markMatchGroup :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name,+                                               Annotate body)+                   => GHC.SrcSpan -> GHC.MatchGroup name (GHC.Located body)+                   -> Annotated ()+markMatchGroup _ (GHC.MG matches _ _ _)+  = setContextLevel (Set.singleton AdvanceLine) 2 $ markListWithLayout matches++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name,+                                               Annotate body)+  => Annotate [GHC.Located (GHC.Match name (GHC.Located body))] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsExpr name) 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 l (GHC.HsVar n)           = unsetContext Intercalate $ markAST l n++      markExpr l (GHC.HsIPVar (GHC.HsIPName v))         =+        markExternal l GHC.AnnVal ("?" ++ GHC.unpackFS v)+      markExpr l (GHC.HsOverLit ov)     = markAST l ov+      markExpr l (GHC.HsLit lit)        = markAST l lit++      markExpr _ (GHC.HsLam (GHC.MG [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+        -- markLocated e1+        setContext (Set.singleton PrefixOp) $ markLocated e1+        -- markLocated e2+        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 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 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 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 "[:"+        markListIntercalate 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 (GHC.HsRecFields 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+        markLocated typ++      markExpr _ (GHC.ExprWithTySigOut e typ) = do+        markLocated e+        mark GHC.AnnDcolon+        markLocated typ++      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+        markWithString GHC.AnnOpen src -- "{-# SCC"+        markWithStringOptional GHC.AnnVal (GHC.unpackFS csFStr)+        markWithString GHC.AnnValStr ("\"" ++ GHC.unpackFS csFStr ++ "\"")+        markWithString GHC.AnnClose "#-}"+        markLocated e++      markExpr _ (GHC.HsCoreAnn src csFStr e) = do+        markWithString GHC.AnnOpen src -- "{-# CORE"+        markWithString GHC.AnnVal ("\"" ++ GHC.unpackFS 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+        markWithString GHC.AnnClose "|]"+      -- Introduced after the renamer+      markExpr _ (GHC.HsBracket (GHC.DecBrG _)) =+        traceM "warning: DecBrG introduced after renamer"+      markExpr _l (GHC.HsBracket (GHC.ExpBr e)) = do+        -- This exists like this as the lexer collapses [e| and [| into the+        -- same construtor+        workOutString _l GHC.AnnOpen+          (\ss -> if spanLength ss == 2+                    then "[|"+                    else "[e|")+        markLocated e+        markWithString GHC.AnnClose "|]"+      markExpr _l (GHC.HsBracket (GHC.TExpBr e)) = do+        -- This exists like this as the lexer collapses [e|| and [|| into the+        -- same construtor+        workOutString _l GHC.AnnOpen+          (\ss -> if spanLength ss == 3+                    then "[||"+                    else "[e||")+        markLocated e+        markWithString GHC.AnnClose "||]"+      markExpr _ (GHC.HsBracket (GHC.TypBr e)) = do+        markWithString GHC.AnnOpen "[t|"+        markLocated e+        markWithString GHC.AnnClose "|]"+      markExpr _ (GHC.HsBracket (GHC.PatBr e)) = do+        markWithString GHC.AnnOpen  "[p|"+        markLocated e+        markWithString GHC.AnnClose "|]"++      markExpr _ (GHC.HsRnBracketOut _ _) =+        traceM "warning: HsRnBracketOut introduced after renamer"+      markExpr _ (GHC.HsTcBracketOut _ _) =+        traceM "warning: HsTcBracketOut introduced after renamer"++      markExpr _ (GHC.HsSpliceE isTyped e) = do+        case e of+          GHC.HsSplice _n b@(GHC.L _ (GHC.HsVar n))  -> do+            if isTyped+              then do+                mark GHC.AnnOpenPTE+                markWithStringOptional GHC.AnnThIdTySplice ("$$" ++ (GHC.occNameString (GHC.occName n)))+              else do+                mark GHC.AnnOpenPE+                markWithStringOptional GHC.AnnThIdSplice   ("$" ++ (GHC.occNameString (GHC.occName n)))+            markLocated b+            mark GHC.AnnCloseP+          GHC.HsSplice _n b -> do+            if isTyped+              then do+                markOptional GHC.AnnThIdSplice+                mark GHC.AnnOpenPTE+              else mark GHC.AnnOpenPE+            markLocated b+            mark GHC.AnnCloseP++      markExpr l (GHC.HsQuasiQuoteE e) = do+        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.AnnOpen "(|"+        markLocated e+        mapM_ markLocated cs+        markWithString GHC.AnnClose "|)"++      markExpr _ (GHC.HsTick _ _) = return ()+      markExpr _ (GHC.HsBinTick _ _ _) = return ()++      markExpr _ (GHC.HsTickPragma src (str,(v1,v2),(v3,v4)) e) = do+        -- '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'+        markWithString       GHC.AnnOpen  src+        markOffsetWithString GHC.AnnVal 0 (show (GHC.unpackFS str)) -- STRING+        markOffsetWithString GHC.AnnVal 1 (show v1) -- INTEGER+        markOffset GHC.AnnColon 0 -- ':'+        markOffsetWithString GHC.AnnVal 2 (show v2) -- INTEGER+        mark   GHC.AnnMinus   -- '-'+        markOffsetWithString GHC.AnnVal 3 (show v3) -- INTEGER+        markOffset GHC.AnnColon 1 -- ':'+        markOffsetWithString GHC.AnnVal 4 (show v4) -- INTEGER+        markWithString   GHC.AnnClose  "#-}"+        markLocated e++      markExpr l GHC.EWildPat = do+        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.HsType ty) = markLocated ty++      markExpr _ (GHC.HsWrap _ _) =+        traceM "warning: HsWrap introduced after renaming"+      markExpr _ (GHC.HsUnboundVar _) =+        traceM "warning: HsUnboundVar introduced after renaming"+++-- ---------------------------------------------------------------------++instance Annotate GHC.HsLit where+  markAST l lit = markExternal l GHC.AnnVal (hsLit2String lit)++-- ---------------------------------------------------------------------++-- |Used for declarations that need to be aligned together, e.g. in a+-- do or let .. in statement/expr+instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate [GHC.ExprLStmt name] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsTupArg name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsCmdTop name) where+  markAST _ (GHC.HsCmdTop cmd _ _ _) = markLocated cmd++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.HsCmd name) 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 _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++    -- TODO: This test assumes no auto-generated SrcSpans+    let isPrefixOp = case cs of+          [] -> True+          (GHC.L h _:_) -> GHC.getLoc e < h+    when isPrefixOp $ markWithString GHC.AnnOpen "(|"+    -- 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 $ markWithString GHC.AnnClose "|)"++  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 binds e) = do+    mark GHC.AnnLet+    markOptional GHC.AnnOpenC+    markLocalBindsWithLayout binds+    markOptional GHC.AnnCloseC+    mark GHC.AnnIn+    markLocated e++  markAST _ (GHC.HsCmdDo es _) = do+    mark GHC.AnnDo+    markOptional GHC.AnnOpenC+    markListWithLayout es+    markOptional GHC.AnnCloseC++  markAST _ GHC.HsCmdCast {} =+    traceM "warning: HsCmdCast introduced after renaming"++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate [GHC.Located (GHC.StmtLR name name (GHC.LHsCmd name))] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+     => Annotate (GHC.TyClDecl name) where++  markAST l (GHC.FamDecl famdecl) = markAST l famdecl >> markTrailingSemi++  markAST _ (GHC.SynDecl ln (GHC.HsQTvs _ tyvars) 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 ln tyvars+    mark GHC.AnnEqual+    markLocated typ+    markTrailingSemi++  markAST _ (GHC.DataDecl ln (GHC.HsQTvs _ns tyVars)+                (GHC.HsDataDefn nd ctx mctyp mk cons mderivs) _) = do+    if nd == GHC.DataType+      then mark GHC.AnnData+      else mark GHC.AnnNewtype+    markMaybe mctyp+    when (null (GHC.unLoc ctx)) $ markOptional GHC.AnnDarrow+    markLocated ctx+    markTyClass 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]) $ markMaybe mderivs+    markTrailingSemi++  -- -----------------------------------++  markAST _ (GHC.ClassDecl ctx ln (GHC.HsQTvs _ns tyVars) fds+                          sigs meths ats atdefs docs _) = do+    mark GHC.AnnClass+    markLocated ctx++    markTyClass 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.Located a -> [GHC.Located ast] -> Annotated ()+markTyClass ln tyVars = do+    markManyOptional GHC.AnnOpenP++    let+      parensNeeded = GHC.isSymOcc (GHC.occName $ GHC.unLoc ln) && length tyVars > 2+      lnFun = do+        ifInContext (Set.singleton CtxMiddle)+                      (setContext (Set.singleton InfixOp) $ markLocated ln)+                      (markLocated ln)+      listFun b = do+        if parensNeeded+          then ifInContext (Set.singleton (CtxPos 0))+                      (markMany GHC.AnnOpenP)+                      (return ())+          else ifInContext (Set.singleton (CtxPos 0))+                      (markManyOptional GHC.AnnOpenP)+                      (return ())++        markLocated b++        if parensNeeded+          then ifInContext (Set.singleton (CtxPos 2))+                      (markMany GHC.AnnCloseP)+                      (return ())+          else ifInContext (Set.singleton (CtxPos 2))+                      (markManyOptional GHC.AnnCloseP)+                      (return ())++      prepareListFun ls = map (\b -> (GHC.getLoc b, listFun b )) ls++    unsetContext CtxMiddle $+      applyListAnnotationsContexts (LC (Set.fromList [CtxOnly,PrefixOp]) (Set.fromList [CtxFirst,PrefixOp])+                                        (Set.singleton CtxMiddle) (Set.singleton CtxLast))+                               ([(GHC.getLoc ln,lnFun)]+                             ++ prepareListFun tyVars)+    markManyOptional GHC.AnnCloseP++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name, GHC.OutputableBndr name,GHC.HasOccName name)+   => Annotate (GHC.FamilyDecl name) where+  markAST _ (GHC.FamilyDecl info ln (GHC.HsQTvs _ tyvars) mkind) = do+    case info of+      GHC.DataFamily -> mark GHC.AnnData+      _              -> mark GHC.AnnType++    mark GHC.AnnFamily++    markTyClass ln tyvars+    case mkind of+      Nothing -> return ()+      Just k -> do+        mark GHC.AnnDcolon+        markLocated k+    case info of+      GHC.ClosedTypeFamily eqns -> do+        mark GHC.AnnWhere+        markOptional GHC.AnnOpenC -- {+        markListWithLayout eqns+        markOptional GHC.AnnCloseC -- }+      _ -> return ()+    markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.TyFamInstEqn name) where+  markAST _ (GHC.TyFamEqn ln (GHC.HsWB pats _ _ _) typ) = do+    markTyClass ln pats+    -- let+    --   fun = ifInContext (Set.singleton (CtxPos 0))+    --             (setContext (Set.singleton PrefixOp) $ markLocated ln)+    --             (markLocated ln)+    -- markOptional GHC.AnnOpenP+    -- applyListAnnotationsContexts (LC Set.empty Set.empty Set.empty Set.empty)+    --                      ([(GHC.getLoc ln, fun)]+    --                      ++ prepareListAnnotationWithContext (Set.singleton PrefixOp) pats)+    -- markOptional GHC.AnnCloseP+    mark GHC.AnnEqual+    markLocated typ++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.TyFamDefltEqn name) where+  markAST _ (GHC.TyFamEqn ln (GHC.HsQTvs _ns bndrs) typ) = do+    mark GHC.AnnType+    mark GHC.AnnInstance+    applyListAnnotations (prepareListAnnotation [ln]+                       ++ prepareListAnnotation 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.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => GHC.SrcSpan -> GHC.HsDataDefn name -> Annotated ()+markDataDefn _ (GHC.HsDataDefn _ ctx typ _mk cons mderivs) = do+  markLocated ctx+  markMaybe typ+  markMaybe _mk+  if isGadt cons+    then markListWithLayout cons+    else markListIntercalateWithFunLevel markLocated 2 cons+  case mderivs of+    Nothing -> return ()+    Just d -> setContext (Set.singleton Deriving) $ markLocated d++-- ---------------------------------------------------------------------++-- Note: GHC.HsContext name aliases to here too+instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+     => Annotate [GHC.LHsType name] where+  markAST l ts = do+    inContext (Set.singleton Deriving) $ mark GHC.AnnDeriving+    -- 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 (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+      => Annotate (GHC.ConDecl name) where+  markAST _ (GHC.ConDecl lns _expr (GHC.HsQTvs _ns bndrs) ctx+                         dets res _ depc_syntax) = do+    case res of+      GHC.ResTyH98 -> do++        unless (null bndrs) $ do+          mark GHC.AnnForall+          mapM_ markLocated bndrs+          mark GHC.AnnDot++        unless (null $ GHC.unLoc ctx) $ do+          setContext (Set.fromList [NoDarrow]) $ markLocated ctx+          mark GHC.AnnDarrow+        case dets of+          GHC.InfixCon _ _ -> return ()+          _ -> setContext (Set.singleton PrefixOp) $ markListIntercalate lns++        markHsConDeclDetails False False lns dets++      GHC.ResTyGADT ls ty -> do+        -- only print names if not infix+        case dets of+          GHC.InfixCon _ _ -> return ()+          _ -> markListIntercalate lns++        if depc_syntax+          then do+            markHsConDeclDetails True False lns dets+            mark GHC.AnnCloseC+            mark GHC.AnnDcolon+            markManyOptional GHC.AnnOpenP++          else do+            mark GHC.AnnDcolon+            markLocated (GHC.L ls (ResTyGADTHook bndrs))+            markManyOptional GHC.AnnOpenP+            unless (null $ GHC.unLoc ctx) $ do+              markLocated ctx+            markHsConDeclDetails False True lns dets++        markLocated ty++        markManyOptional GHC.AnnCloseP+++    case res of+      GHC.ResTyH98 -> inContext (Set.fromList [Intercalate]) $ mark GHC.AnnVbar+      _  -> return ()+    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.OutputableBndr name) => GHC.Outputable (ResTyGADTHook name) where+  ppr (ResTyGADTHook bs) = GHC.text "ResTyGADTHook" GHC.<+> GHC.ppr bs+++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (ResTyGADTHook name) where+  markAST _ (ResTyGADTHook bndrs) = do+    unless (null bndrs) $ do+      mark GHC.AnnForall+      mapM_ markLocated bndrs+      mark GHC.AnnDot++-- ---------------------------------------------------------------------++instance (Annotate name, GHC.DataId name, GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.HsRecField name (GHC.LPat name)) 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 name, GHC.DataId name, GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.HsRecField name (GHC.LHsExpr name)) 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 (GHC.DataId name,Annotate name)+    => Annotate (GHC.FunDep (GHC.Located name)) 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+    case mh of+      Nothing -> return ()+      Just (GHC.Header h) ->+         markWithString GHC.AnnHeader ("\"" ++ GHC.unpackFS h ++ "\"")+    markWithString GHC.AnnVal ("\"" ++ GHC.unpackFS f ++ "\"")+    markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------

@@ -0,0 +1,2750 @@+{-# 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.RdrName) 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.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => GHC.HsLocalBinds name -> 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.RdrName) 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 ls txt) lss) = do+    markExternal ls GHC.AnnOpen txt+    mark GHC.AnnOpenS+    markListIntercalate lss+    mark GHC.AnnCloseS+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.DeprecatedTxt (GHC.L ls txt) lss) = do+    markExternal ls GHC.AnnOpen txt+    mark GHC.AnnOpenS+    markListIntercalate lss+    mark GHC.AnnCloseS+    markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------++instance Annotate GHC.StringLiteral where+  markAST l (GHC.StringLiteral src _) = do+    markExternal l GHC.AnnVal src+    inContext (Set.fromList [Intercalate]) $ mark GHC.AnnComma++-- ---------------------------------------------------------------------++instance Annotate (GHC.SourceText,GHC.FastString) where+  markAST l (src,_fs) = do+    markExternal l GHC.AnnVal src++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.HasOccName name,Annotate name)+  => Annotate [GHC.LIE name] 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 (GHC.DataId name,GHC.HasOccName name, Annotate name)+  => Annotate (GHC.IE name) where+  markAST _ ie = do++    case ie of+        (GHC.IEVar ln) -> do+          -- TODO: I am pretty sure this criterion is inadequate+          if GHC.isDataOcc $ GHC.occName $ GHC.unLoc ln+            then mark GHC.AnnPattern+            else markOptional GHC.AnnPattern+          setContext (Set.fromList [PrefixOp,InIE]) $ markLocated ln++        (GHC.IEThingAbs ln) -> do+          setContext (Set.fromList [PrefixOp,InIE]) $ markLocated ln++        (GHC.IEThingWith ln wc ns _lfs) -> do+          setContext (Set.fromList [PrefixOp,InIE]) $ markLocated ln+          mark GHC.AnnOpenP+          case wc of+            GHC.NoIEWildcard -> unsetContext Intercalate $ setContext (Set.fromList [PrefixOp,InIE])+                                 $ markListIntercalate ns+            GHC.IEWildcard n -> do+              setContext (Set.fromList [PrefixOp,Intercalate,InIE]) $ mapM_ markLocated (take n ns)+              mark GHC.AnnDotdot+              case drop n ns of+                [] -> return ()+                ns' -> do+                  mark GHC.AnnComma+                  setContext (Set.fromList [PrefixOp,InIE]) $ mapM_ markLocated ns'+          mark GHC.AnnCloseP++        (GHC.IEThingAll ln) -> do+          setContext (Set.fromList [PrefixOp,InIE]) $ 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)++-- ---------------------------------------------------------------------++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+      -- Horrible hack until GHC 8.2 with https://phabricator.haskell.org/D3016+      typeIESym = isSym && (GHC.isTcClsNameSpace $ GHC.rdrNameSpace n)+                        && spanLength l - length str > 6 -- length of "type" + 2 parens+      canParen = isSym && rdrName2String n /= "$"+                       && (not typeIESym)+      doNormalRdrName = do+        let str' = case str of+              -- TODO: unicode support?+                        "forall" -> if spanLength l == 1 then "∀" else str+                        _ -> str+        -- when (isSym && (GHC.isTcClsNameSpace $ GHC.rdrNameSpace n)) $ inContext (Set.singleton InIE) $ mark GHC.AnnType+        when (spanLength l - length str > 4) $ inContext (Set.singleton InIE) $ mark GHC.AnnType+        let str'' = if typeIESym then "(" ++ str' ++ ")"+                                 else 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")++-- ---------------------------------------------------------------------++-- TODO: What is this used for? Not in ExactPrint+instance Annotate GHC.Name where+  markAST l n = do+    markExternal l GHC.AnnVal (showGhc n)++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.ImportDecl name) 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 "#-}"+   when src (markWithString GHC.AnnOpen (fromMaybe "{-# SOURCE" msrc)+             >> markWithString GHC.AnnClose "#-}")+   when safeflag (mark GHC.AnnSafe)+   when qualFlag (unsetContext TopLevel $ mark GHC.AnnQualified)+   case mpkg of+    Nothing -> return ()+    Just (GHC.StringLiteral srcPkg _) -> markWithString GHC.AnnPackageName srcPkg++   markLocated modname++   case GHC.ideclAs imp of+      Nothing -> return ()+      Just mn -> do+          mark GHC.AnnAs+          markWithString GHC.AnnVal (GHC.moduleNameString 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.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+            => GHC.LHsDecl name -> 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+            => Annotate (GHC.HsDecl name) where+  markAST l d = markLHsDecl (GHC.L l d)++-- ---------------------------------------------------------------------++instance (Annotate name)+   => Annotate (GHC.RoleAnnotDecl name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.SpliceDecl name) where+  markAST _ (GHC.SpliceDecl e@(GHC.L _ (GHC.HsQuasiQuote{})) _flag) = do+    setContext (Set.singleton InSpliceDecl) $ markLocated e+    markTrailingSemi+  markAST _ (GHC.SpliceDecl e flag) = do+    case flag of+      GHC.ExplicitSplice -> mark GHC.AnnOpenPE+      GHC.ImplicitSplice -> return ()++    setContext (Set.singleton InSpliceDecl) $ markLocated e++    case flag of+      GHC.ExplicitSplice -> mark GHC.AnnCloseP+      GHC.ImplicitSplice -> return ()++    markTrailingSemi++{-+- data SpliceExplicitFlag = ExplicitSplice | -- <=> $(f x y)+-                           ImplicitSplice   -- <=> f x y,  i.e. a naked+-                           top level expression+-+-}++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.VectDecl name) where+  markAST _ (GHC.HsVect src ln e) = do+    markWithString GHC.AnnOpen src -- "{-# VECTORISE"+    markLocated ln+    mark GHC.AnnEqual+    markLocated e+    markWithString GHC.AnnClose "#-}" -- "#-}"++  markAST _ (GHC.HsNoVect src ln) = do+    markWithString GHC.AnnOpen src -- "{-# NOVECTORISE"+    markLocated ln+    markWithString GHC.AnnClose "#-}" -- "#-}"++  markAST _ (GHC.HsVectTypeIn src _b ln mln) = do+    markWithString GHC.AnnOpen 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+    markWithString GHC.AnnOpen 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.RuleDecls name) where+   markAST _ (GHC.HsRules src rules) = do+     markWithString GHC.AnnOpen src+     setLayoutFlag $ markListIntercalateWithFunLevel markLocated 2 rules+     markWithString GHC.AnnClose "#-}"+     markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.RuleDecl name) where+  markAST _ (GHC.HsRule ln act bndrs lhs _ rhs _) = do+    markLocated ln+    setContext (Set.singleton ExplicitNeverActive) $ markActivation 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.Activation -> Annotated ()+markActivation act = do+  case act of+    GHC.ActiveBefore src _ -> do+      mark GHC.AnnOpenS --  '['+      mark GHC.AnnTilde -- ~+      markWithString GHC.AnnVal src+      mark GHC.AnnCloseS -- ']'+    GHC.ActiveAfter src _ -> do+      mark GHC.AnnOpenS --  '['+      markWithString GHC.AnnVal src+      mark GHC.AnnCloseS -- ']'+    GHC.NeverActive -> do+      inContext (Set.singleton ExplicitNeverActive) $ do+        mark GHC.AnnOpenS --  '['+        mark GHC.AnnTilde -- ~+        mark GHC.AnnCloseS -- ']'+    _ -> return ()++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.RuleBndr name) 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.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+                 => GHC.LHsSigWcType name -> Annotated ()+markLHsSigWcType (GHC.HsIB _ (GHC.HsWC _ mwc ty)) = do+    case mwc of+      Nothing -> markLocated ty+      Just lwc -> do+       applyListAnnotations ([(lwc,markExternal lwc GHC.AnnVal "_")]+                          ++ prepareListAnnotation [ty]+                            )++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.AnnDecl name) where+   markAST _ (GHC.HsAnnotation src prov e) = do+     markWithString GHC.AnnOpen src+     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 name => Annotate (GHC.WarnDecls name) where+   markAST _ (GHC.Warnings src warns) = do+     markWithString GHC.AnnOpen src+     mapM_ markLocated warns+     markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------++instance (Annotate name)+   => Annotate (GHC.WarnDecl name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.ForeignDecl name) where+  markAST _ (GHC.ForeignImport ln (GHC.HsIB _ typ) _+               (GHC.CImport cconv safety@(GHC.L ll _) _mh _imp (GHC.L ls src))) = do+{-+  = ForeignImport+      { fd_name   :: Located name          -- defines this name+      , fd_sig_ty :: LHsSigType name       -- sig_ty+      , fd_co     :: PostTc name Coercion  -- rep_ty ~ sig_ty+      , fd_fi     :: ForeignImport }++-}+    mark GHC.AnnForeign+    mark GHC.AnnImport+    markLocated cconv+    unless (ll == GHC.noSrcSpan) $ markLocated safety+    if GHC.unLoc cconv == GHC.PrimCallConv+      then markExternal ls GHC.AnnVal src+#if defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,0,1,1))+      else markExternal ls GHC.AnnVal src+#else+      else markExternal ls GHC.AnnVal (show src)+#endif+    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 (show 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.DerivDecl name) where++  markAST _ (GHC.DerivDecl (GHC.HsIB _ typ) mov) = do+    mark GHC.AnnDeriving+    mark GHC.AnnInstance+    markMaybe mov+    markLocated typ+    markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.DefaultDecl name) where++  markAST _ (GHC.DefaultDecl typs) = do+    mark GHC.AnnDefault+    mark GHC.AnnOpenP -- '('+    markListIntercalate typs+    mark GHC.AnnCloseP -- ')'+    markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.InstDecl name) 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+  markAST _ (GHC.NoOverlap src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Overlappable src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Overlapping src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Overlaps src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++  markAST _ (GHC.Incoherent src) = do+    markWithString GHC.AnnOpen src+    markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.ClsInstDecl name) where++  markAST _ (GHC.ClsInstDecl (GHC.HsIB _ poly) binds sigs tyfams datafams mov) = do+    mark GHC.AnnInstance+    markMaybe mov+    markLocated poly+    if null (GHC.bagToList binds) && null sigs && null tyfams && null datafams+      then markOptional GHC.AnnWhere+      else do+        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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.TyFamInstDecl name) where++  markAST _ (GHC.TyFamInstDecl eqn _) = do+    mark GHC.AnnType+    inContext (Set.singleton TopLevel) $ mark GHC.AnnInstance -- Note: this keyword is optional+    markLocated eqn+    markTrailingSemi++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.DataFamInstDecl name) where++  markAST l (GHC.DataFamInstDecl ln (GHC.HsIB _ pats)+             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+    inContext (Set.singleton TopLevel) $ mark GHC.AnnInstance++    markLocated ctx++    markTyClass 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsBind name) 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++    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++  markAST l (GHC.PatSynBind (GHC.PSB ln _fvs args def dir)) = do+    mark GHC.AnnPattern+    case args of+      GHC.InfixPatSyn la lb -> do+        markLocated la+        setContext (Set.singleton InfixOp) $ markLocated ln+        markLocated lb+      GHC.PrefixPatSyn ns -> do+        markLocated ln+        mapM_ markLocated ns+      GHC.RecordPatSyn 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++  -- Introduced after renaming.+  markAST _ (GHC.AbsBinds _ _ _ _ _) =+    traceM "warning: AbsBinds introduced after renaming"++  -- Introduced after renaming.+  markAST _ GHC.AbsBindsSig{} =+    traceM "warning: AbsBindsSig introduced after renaming"++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+    => Annotate (GHC.IPBind name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name,+                                                  Annotate body)+  => Annotate (GHC.Match name (GHC.Located body)) where++  markAST _ (GHC.Match mln pats _typ (GHC.GRHSs grhs (GHC.L _ lb))) = do+    let+      get_infix GHC.NonFunBindMatch    = False+      get_infix (GHC.FunBindMatch _ f) = f+      isFunBind GHC.NonFunBindMatch = False+      isFunBind GHC.FunBindMatch{}  = True+    case (get_infix mln,pats) of+      (True, a:b:xs) -> do+        if null xs+          then markOptional GHC.AnnOpenP+          else mark         GHC.AnnOpenP+        markLocated a+        case mln of+          GHC.NonFunBindMatch -> return ()+          GHC.FunBindMatch n _ -> setContext (Set.singleton InfixOp) $ markLocated n+        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.NonFunBindMatch  -> mark GHC.AnnFunId+          GHC.NonFunBindMatch  -> markListNoPrecedingSpace False pats+          GHC.FunBindMatch n _ -> do+            -- setContext (Set.singleton NoPrecedingSpace) $ markLocated n+            setContext (Set.fromList [NoPrecedingSpace,PrefixOp]) $ markLocated n+            mapM_ markLocated 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,+          Annotate name, Annotate body)+  => Annotate (GHC.GRHS name (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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.Sig name) 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 ln (GHC.HsIB _ typ)) = do+    mark GHC.AnnPattern+    markLocated ln+    mark GHC.AnnDcolon+    markLocated typ+    markTrailingSemi++  markAST _ (GHC.ClassOpSig isDefault ns (GHC.HsIB _ typ)) = do+    when isDefault $ mark GHC.AnnDefault+    -- markListIntercalate ns+    setContext (Set.singleton PrefixOp) $ markListIntercalate ns+    mark GHC.AnnDcolon+    markLocated typ+    markTrailingSemi++  markAST _ (GHC.IdSig _) =+    traceM "warning: Introduced after renaming"++  -- FixSig (FixitySig name)+  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+    markWithString GHC.AnnVal src+    setContext (Set.singleton InfixOp) $ markListIntercalate lns+    markTrailingSemi++  -- InlineSig (Located name) InlinePragma+  -- '{-# INLINE' activation qvar '#-}'+  markAST _ (GHC.InlineSig ln inl) = do+    markWithString GHC.AnnOpen (GHC.inl_src inl) -- '{-# INLINE'+    markActivation (GHC.inl_act inl)+    setContext (Set.singleton PrefixOp) $ markLocated ln+    markWithString GHC.AnnClose "#-}" -- '#-}'+    markTrailingSemi++  markAST _ (GHC.SpecSig ln typs inl) = do+{-+  | SpecSig     (Located name)     -- Specialise a function or datatype  ...+                [LHsSigType name]  -- ... to these types+                InlinePragma       -- The pragma on SPECIALISE_INLINE form.+                                   -- If it's just defaultInlinePragma, then we said+                                   --    SPECIALISE, not SPECIALISE_INLINE++-}+    markWithString GHC.AnnOpen (GHC.inl_src inl)+    markActivation (GHC.inl_act inl)+    markLocated ln+    mark GHC.AnnDcolon -- '::'+    markListIntercalateWithFunLevel markLHsSigType 2 typs+    markWithString GHC.AnnClose "#-}" -- '#-}'+    markTrailingSemi+++  -- '{-# SPECIALISE' 'instance' inst_type '#-}'+  markAST _ (GHC.SpecInstSig src typ) = do+    markWithString GHC.AnnOpen src+    mark GHC.AnnInstance+    markLHsSigType typ+    markWithString GHC.AnnClose "#-}" -- '#-}'+    markTrailingSemi++++  -- MinimalSig (BooleanFormula (Located name))+  markAST _l (GHC.MinimalSig src formula) = do+    markWithString GHC.AnnOpen src+    markLocated formula+    markWithString GHC.AnnClose "#-}"+    markTrailingSemi++-- --------------------------------------------------------------------++markLHsSigType :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+               => GHC.LHsSigType name -> Annotated ()+markLHsSigType (GHC.HsIB _ typ) = markLocated typ++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate [GHC.LHsSigType name] 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 l (GHC.Or ls)  = mapM_ markLocated ls+  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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsTyVarBndr name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.HsType name) 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++  {-+    = HsForAllTy   -- See Note [HsType binders]+        { hst_bndrs :: [LHsTyVarBndr name]   -- Explicit, user-supplied 'forall a b c'+        , hst_body  :: LHsType name          -- body type+        }++  -}++    markType _ (GHC.HsQualTy cxt typ) = do+      markLocated cxt+      markLocated typ+  {-+    | HsQualTy   -- See Note [HsType binders]+        { hst_ctxt :: LHsContext name       -- Context C => blah+        , hst_body :: LHsType name }+  -}++    markType _l (GHC.HsTyVar name) = do+      -- TODO: Should the isExactName test move into the RdrName Annotate instanced?+      if ((GHC.isDataOcc $ GHC.occName $ GHC.unLoc name) && ((not $ isExactName $ GHC.unLoc name)))+                   || (showGhc name == "()")+        then do+            mark GHC.AnnSimpleQuote+            markLocatedFromKw GHC.AnnName name+        else markLocated name++    markType _ (GHC.HsAppsTy ts) = do+      mapM_ markLocated ts++    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.HsOpTy t1 lo t2) = do+    -- HsOpTy              (LHsType name) (Located name) (LHsType name)+      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 (GHC.HsIPName n) t) = do+      markWithString GHC.AnnVal ("?" ++ (GHC.unpackFS 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+        Nothing -> return ()+        Just 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+  {-+    | HsBangTy    HsSrcBang (LHsType name)   -- Bang-style type annotations+  data HsSrcBang =+    HsSrcBang (Maybe SourceText) -- Note [Pragma source text] in BasicTypes+              SrcUnpackedness+              SrcStrictness+  data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'+                     | SrcStrict -- ^ Strict, ie '!'+                     | NoSrcStrict -- ^ no strictness annotation++  data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified+                       | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified+                       | NoSrcUnpack -- ^ no unpack pragma++  -}++    markType _ (GHC.HsRecTy cons) = do+      mark GHC.AnnOpenC  -- '{'+      markListIntercalate cons+      mark GHC.AnnCloseC -- '}'++    -- HsCoreTy Type+    markType _ (GHC.HsCoreTy _t) =+      traceM "warning: HsCoreTy Introduced after renaming"++    markType _ (GHC.HsExplicitListTy _ ts) = do+      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++    -- HsTyLit HsTyLit+    markType l (GHC.HsTyLit lit) = do+      case lit of+        (GHC.HsNumTy s _) ->+          markExternal l GHC.AnnVal s+        (GHC.HsStrTy s _) ->+          markExternal l GHC.AnnVal s++    -- HsWrapTy HsTyAnnotated (HsType name)++    markType l (GHC.HsWildCardTy (GHC.AnonWildCard _)) = do+      markExternal l GHC.AnnVal "_"+++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsAppType name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsSplice name) where+  markAST l c =+    case c of+      GHC.HsQuasiQuote _ n _pos fs -> do+        markExternal l GHC.AnnVal+              ("[" ++ (showGhc n) ++ "|" ++ (GHC.unpackFS fs) ++ "|]")++      GHC.HsTypedSplice _n (GHC.L _ (GHC.HsVar (GHC.L _ n)))  -> do+        markWithString GHC.AnnThIdTySplice ("$$" ++ (GHC.occNameString (GHC.occName n)))+      GHC.HsTypedSplice _n b -> do+        mark GHC.AnnOpenPTE+        markLocated b+        mark GHC.AnnCloseP++      GHC.HsUntypedSplice _n b@(GHC.L _ (GHC.HsVar (GHC.L _ n)))  -> do+        ifInContext (Set.singleton InSpliceDecl)+          (return ())+          (mark GHC.AnnOpenPE)+        -- TODO: We do not seem to have any way to distinguish between which of+        -- the next two lines will emit output. If AnnThIdSplice is there, the+        -- markLocated b ends up with a negative offset so emits nothing.+        markWithStringOptional GHC.AnnThIdSplice ("$" ++ (GHC.occNameString (GHC.occName n)))+        markLocated b+        ifInContext (Set.singleton InSpliceDecl)+          (return ())+          (mark GHC.AnnCloseP)+      GHC.HsUntypedSplice _n b  -> do+        -- TODO: when is this not optional?+        markOptional GHC.AnnThIdSplice+        ifInContext (Set.singleton InSpliceDecl)+          (return ())+          (mark GHC.AnnOpenPE)+        markLocated b+        ifInContext (Set.singleton InSpliceDecl)+          (return ())+          (mark GHC.AnnCloseP)+#if defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,0,1,1))+      GHC.HsSpliced{} -> error "HsSpliced only exists between renamer and typechecker in GHC"+#endif++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name) =>+                             Annotate (GHC.ConDeclField name) where+  markAST _ (GHC.ConDeclField ns ty mdoc) = do+{-+data ConDeclField name  -- Record fields have Haddoc docs on them+  = ConDeclField { cd_fld_names :: [LFieldOcc name],+                                   -- ^ See Note [ConDeclField names]+                   cd_fld_type :: LBangType name,+                   cd_fld_doc  :: Maybe LHsDocString }++-}+    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 (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.Pat name) 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.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"++      -- ViewPat (LHsExpr id) (LPat id) (PostTc id Type)+      markPat _ (GHC.ViewPat e pat _) = do+        markLocated e+        mark GHC.AnnRarrow+        markLocated pat++      -- SplicePat (HsSplice id)+      markPat l (GHC.SplicePat s) = do+        markAST l s++      -- LitPat HsLit+      markPat l (GHC.LitPat lp) = markExternal l GHC.AnnVal (hsLit2String lp)++      -- NPat (HsOverLit id) (Maybe (SyntaxExpr id)) (SyntaxExpr id)+      markPat _ (GHC.NPat ol mn _ _) = do+        -- markOptional GHC.AnnMinus+        when (isJust mn) $ mark GHC.AnnMinus+        markLocated ol++      -- NPlusKPat (Located id) (HsOverLit id) (SyntaxExpr id) (SyntaxExpr id)+      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"++      -- CoPat HsAnnotated (Pat id) Type+      markPat _ GHC.CoPat {} =+        traceM "warning: CoPat introduced after renaming"++-- ---------------------------------------------------------------------+hsLit2String :: GHC.HsLit -> GHC.SourceText+hsLit2String lit =+  case lit of+    GHC.HsChar       src _   -> src+    -- It should be included here+    -- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x#L1471+    GHC.HsCharPrim   src _   -> src ++ "#"+    GHC.HsString     src _   -> src+    GHC.HsStringPrim src _   -> src+    GHC.HsInt        src _   -> src+    GHC.HsIntPrim    src _   -> src+    GHC.HsWordPrim   src _   -> src+    GHC.HsInt64Prim  src _   -> src+    GHC.HsWord64Prim src _   -> src+    GHC.HsInteger    src _ _ -> src+    GHC.HsRat        (GHC.FL src _) _ -> src+    GHC.HsFloatPrim  (GHC.FL src _)   -> src ++ "#"+    GHC.HsDoublePrim (GHC.FL src _)   -> src ++ "##"++markHsConPatDetails :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+                      => GHC.Located name -> GHC.HsConPatDetails name -> 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+      setContext (Set.singleton InfixOp) $ markLocated ln+      markLocated a2++markHsConDeclDetails :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+                    => Bool -> Bool -> [GHC.Located name] -> GHC.HsConDeclDetails name -> 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate [GHC.LConDeclField name] 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 (GHC.DataId name) => Annotate (GHC.HsOverLit name) where+  markAST l ol =+    let str = case GHC.ol_val ol of+                GHC.HsIntegral src _ -> src+                GHC.HsFractional l2  -> GHC.fl_text l2+                GHC.HsIsString src _ -> src+    in+    markExternal l GHC.AnnVal str++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate arg)+    => Annotate (GHC.HsImplicitBndrs name (GHC.Located arg)) where+  markAST _ (GHC.HsIB _ thing) = do+    markLocated thing++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,Annotate name+         ,GHC.HasOccName name,Annotate body)+  => Annotate (GHC.Stmt name (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  (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  =>  Annotate (GHC.ParStmtBlock name name) where+  markAST _ (GHC.ParStmtBlock stmts _ns _) = do+    markListIntercalate stmts++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsLocalBinds name) where+  markAST _ lb = markHsLocalBinds lb++-- ---------------------------------------------------------------------++markHsLocalBinds :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+                     => GHC.HsLocalBinds name -> 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 (reverse binds)+markHsLocalBinds GHC.EmptyLocalBinds                   = return ()++-- ---------------------------------------------------------------------++markMatchGroup :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name,+                                               Annotate body)+                   => GHC.SrcSpan -> GHC.MatchGroup name (GHC.Located body)+                   -> Annotated ()+markMatchGroup _ (GHC.MG (GHC.L _ matches) _ _ _)+  = setContextLevel (Set.singleton AdvanceLine) 2 $ markListWithLayout matches++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name,+                                               Annotate body)+  => Annotate [GHC.Located (GHC.Match name (GHC.Located body))] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsExpr name) 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 (GHC.HsIPName v))         =+        markExternal l GHC.AnnVal ("?" ++ GHC.unpackFS v)+      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+        -- markLocated e1+        setContext (Set.singleton PrefixOp) $ markLocated e1+        -- markLocated e2+        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 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 "[:"+        markListIntercalate 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) = do+        markLocated e+        mark GHC.AnnDcolon+        markLHsSigWcType typ++      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+        markWithString GHC.AnnOpen src -- "{-# SCC"+        markWithStringOptional GHC.AnnVal (GHC.sl_st csFStr)+        markWithString GHC.AnnValStr (GHC.sl_st csFStr)+        markWithString GHC.AnnClose "#-}"+        markLocated e++      markExpr _ (GHC.HsCoreAnn src csFStr e) = do+        markWithString GHC.AnnOpen src -- "{-# CORE"+        markWithString GHC.AnnVal (GHC.sl_st 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+        markWithString GHC.AnnClose "|]"+      -- Introduced after the renamer+      markExpr _ (GHC.HsBracket (GHC.DecBrG _)) =+        traceM "warning: DecBrG introduced after renamer"+      markExpr _l (GHC.HsBracket (GHC.ExpBr e)) = do+        markWithString GHC.AnnOpen "[|"+        markOptional GHC.AnnOpenE  -- "[e|"+        markLocated e+        markWithString GHC.AnnClose "|]"+      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+        markWithString GHC.AnnClose "|]"+      markExpr _ (GHC.HsBracket (GHC.PatBr e)) = do+        markWithString GHC.AnnOpen  "[p|"+        markLocated e+        markWithString GHC.AnnClose "|]"++      markExpr _ (GHC.HsRnBracketOut _ _) =+        traceM "warning: HsRnBracketOut introduced after renamer"+      markExpr _ (GHC.HsTcBracketOut _ _) =+        traceM "warning: HsTcBracketOut introduced after renamer"++      -- --------------------------------++      -- markExpr l (GHC.HsSpliceE e@(GHC.HsUntypedSplice _ (GHC.L _ (GHC.HsSpliceE{})))) = do+      --   mark GHC.AnnOpenPE+      --   markAST l e+      --   mark GHC.AnnCloseP+      markExpr l (GHC.HsSpliceE e) = do+        markOptional GHC.AnnOpenPE+        markAST l e+        markOptional GHC.AnnCloseP++      -- --------------------------------++      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.AnnOpen "(|"+        markLocated e+        mapM_ markLocated cs+        markWithString GHC.AnnClose "|)"++      markExpr _ (GHC.HsTick _ _) = return ()+      markExpr _ (GHC.HsBinTick _ _ _) = return ()++      markExpr _ (GHC.HsTickPragma src (str,_,_) ((v1,v2),(v3,v4)) e) = do+        -- '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'+        markWithString       GHC.AnnOpen  src+        markOffsetWithString GHC.AnnVal 0 (GHC.sl_st str) -- STRING+        markOffsetWithString GHC.AnnVal 1 v1 -- INTEGER+        markOffset GHC.AnnColon 0 -- ':'+        markOffsetWithString GHC.AnnVal 2 v2 -- INTEGER+        mark   GHC.AnnMinus   -- '-'+        markOffsetWithString GHC.AnnVal 3 v3 -- INTEGER+        markOffset GHC.AnnColon 1 -- ':'+        markOffsetWithString GHC.AnnVal 4 v4 -- INTEGER+        markWithString   GHC.AnnClose  "#-}"+        markLocated e++      markExpr l GHC.EWildPat = do+        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+        mark GHC.AnnAt+        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"+++-- ---------------------------------------------------------------------++markLHsWcType :: (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+              => GHC.LHsWcType name -> Annotated ()+markLHsWcType (GHC.HsWC _ mwc ty) = do+  case mwc of+    Nothing -> markLocated ty+    Just lwc -> do+     -- let sorted = lexicalSortLocated (GHC.L lwc GHC.HsWildCardTy:[ty])+     -- markLocated (GHC.L lc sorted)+     applyListAnnotations ([(lwc,markExternal lwc GHC.AnnVal "_")]+                        ++ prepareListAnnotation [ty]+                          )++-- ---------------------------------------------------------------------++instance Annotate GHC.HsLit where+  markAST l lit = markExternal l GHC.AnnVal (hsLit2String lit)++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsRecUpdField name) 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+{-+type HsRecUpdField id     = HsRecField' (AmbiguousFieldOcc id) (LHsExpr id)++-- |  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual',+--+-- For details on above see note [Api annotations] in ApiAnnotation+data HsRecField' id arg = HsRecField {+        hsRecFieldLbl :: Located id,+        hsRecFieldArg :: arg,           -- ^ Filled in by renamer when punning+        hsRecPun      :: Bool           -- ^ Note [Punning]+  } deriving (Data, Typeable)++-}++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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate [GHC.ExprLStmt name] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsTupArg name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.HsCmdTop name) where+  markAST _ (GHC.HsCmdTop cmd _ _ _) = markLocated cmd++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+   => Annotate (GHC.HsCmd name) 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 _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++    -- TODO: This test assumes no auto-generated SrcSpans+    let isPrefixOp = case cs of+          [] -> True+          (GHC.L h _:_) -> GHC.getLoc e < h+    when isPrefixOp $ markWithString GHC.AnnOpen "(|"+    -- 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 $ markWithString GHC.AnnClose "|)"++  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"+{-+  | HsCmdWrap   HsWrapper+                (HsCmd id)     -- If   cmd :: arg1 --> res+                               --      wrap :: arg1 "->" arg2+                               -- Then (HsCmdWrap wrap cmd) :: arg2 --> res+-}++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate [GHC.Located (GHC.StmtLR name name (GHC.LHsCmd name))] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+     => Annotate (GHC.TyClDecl name) where++  markAST l (GHC.FamDecl famdecl) = markAST l famdecl >> markTrailingSemi++  markAST _ (GHC.SynDecl ln (GHC.HsQTvs _ tyvars _) 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 ln tyvars+    mark GHC.AnnEqual+    markLocated typ+    markTrailingSemi++  markAST _ (GHC.DataDecl ln (GHC.HsQTvs _ns tyVars _)+                (GHC.HsDataDefn nd ctx mctyp mk cons mderivs) _ _) = do+    if nd == GHC.DataType+      then mark GHC.AnnData+      else mark GHC.AnnNewtype+    markMaybe mctyp+    when (null (GHC.unLoc ctx)) $ markOptional GHC.AnnDarrow+    markLocated ctx+    markTyClass 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]) $ markMaybe mderivs+    markTrailingSemi++  -- -----------------------------------++  markAST _ (GHC.ClassDecl ctx ln (GHC.HsQTvs _ns tyVars _) fds+                          sigs meths ats atdefs docs _) = do+    mark GHC.AnnClass+    markLocated ctx++    markTyClass 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.Located a -> [GHC.Located ast] -> Annotated ()+markTyClass ln tyVars = do+    markManyOptional GHC.AnnOpenP++    let+      parensNeeded = GHC.isSymOcc (GHC.occName $ GHC.unLoc ln) && length tyVars > 2+      lnFun = do+        ifInContext (Set.singleton CtxMiddle)+                      (setContext (Set.singleton InfixOp) $ markLocated ln)+                      (markLocated ln)+      listFun b = do+        if parensNeeded+          then ifInContext (Set.singleton (CtxPos 0))+                      (markMany GHC.AnnOpenP)+                      (return ())+          else ifInContext (Set.singleton (CtxPos 0))+                      (markManyOptional GHC.AnnOpenP)+                      (return ())++        markLocated b++        if parensNeeded+          then ifInContext (Set.singleton (CtxPos 2))+                      (markMany GHC.AnnCloseP)+                      (return ())+          else ifInContext (Set.singleton (CtxPos 2))+                      (markManyOptional GHC.AnnCloseP)+                      (return ())++      prepareListFun ls = map (\b -> (GHC.getLoc b, listFun b )) ls++    unsetContext CtxMiddle $+      applyListAnnotationsContexts (LC (Set.fromList [CtxOnly,PrefixOp]) (Set.fromList [CtxFirst,PrefixOp])+                                        (Set.singleton CtxMiddle) (Set.singleton CtxLast))+                               ([(GHC.getLoc ln,lnFun)]+                             ++ prepareListFun tyVars)+    markManyOptional GHC.AnnCloseP++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name, GHC.OutputableBndr name,GHC.HasOccName name)+   => Annotate (GHC.FamilyDecl name) where+  markAST _ (GHC.FamilyDecl info ln (GHC.HsQTvs _ tyvars _) rsig minj) = do+{-+data FamilyDecl name = FamilyDecl+  { fdInfo           :: FamilyInfo name              -- type/data, closed/open+  , fdLName          :: Located name                 -- type constructor+  , fdTyVars         :: LHsQTyVars name              -- type variables+  , fdResultSig      :: LFamilyResultSig name        -- result signature+  , fdInjectivityAnn :: Maybe (LInjectivityAnn name) -- optional injectivity ann+  }+-}+    case info of+      GHC.DataFamily -> mark GHC.AnnData+      _              -> mark GHC.AnnType++    -- ifInContext (Set.singleton InClassDecl) (return ()) (mark GHC.AnnFamily)+    mark GHC.AnnFamily++    markTyClass 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 (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.FamilyResultSig name) where+  markAST _ (GHC.NoSig)        = return ()+  markAST _ (GHC.KindSig k)    = markLocated k+  markAST _ (GHC.TyVarSig ltv) = markLocated ltv++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name)+  => Annotate (GHC.InjectivityAnn name) where+  markAST _ (GHC.InjectivityAnn ln lns) = do+    markLocated ln+    mark GHC.AnnRarrow+    mapM_ markLocated lns++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.TyFamInstEqn name) where+  markAST _ (GHC.TyFamEqn ln (GHC.HsIB _ pats) typ) = do+    markTyClass ln pats+    -- let+    --   fun = ifInContext (Set.singleton (CtxPos 0))+    --             (setContext (Set.singleton PrefixOp) $ markLocated ln)+    --             (markLocated ln)+    -- markOptional GHC.AnnOpenP+    -- applyListAnnotationsContexts (LC Set.empty Set.empty Set.empty Set.empty)+    --                      ([(GHC.getLoc ln, fun)]+    --                      ++ prepareListAnnotationWithContext (Set.singleton PrefixOp) pats)+    -- markOptional GHC.AnnCloseP+    mark GHC.AnnEqual+    markLocated typ++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.TyFamDefltEqn name) where+  markAST _ (GHC.TyFamEqn ln (GHC.HsQTvs _ns bndrs _) typ) = do+    mark GHC.AnnType+    mark GHC.AnnInstance+    applyListAnnotations (prepareListAnnotation [ln]+                       ++ prepareListAnnotation 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.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => GHC.SrcSpan -> GHC.HsDataDefn name -> Annotated ()+markDataDefn _ (GHC.HsDataDefn _ ctx typ _mk cons mderivs) = do+  markLocated ctx+  markMaybe typ+  if isGadt cons+    then markListWithLayout cons+    else markListIntercalateWithFunLevel markLocated 2 cons+  case mderivs of+    Nothing -> return ()+    Just d -> setContext (Set.singleton Deriving) $ markLocated d++-- ---------------------------------------------------------------------++-- Note: GHC.HsContext name aliases to here too+instance (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+     => Annotate [GHC.LHsType name] 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 (GHC.DataId name,Annotate name,GHC.OutputableBndr name,GHC.HasOccName name)+      => Annotate (GHC.ConDecl name) where+  markAST _ (GHC.ConDeclH98 ln mqtvs mctx+                         dets _ ) = do+{-+  | ConDeclH98+      { con_name    :: Located name++      , con_qvars     :: Maybe (LHsQTyVars name)+        -- User-written forall (if any), and its implicit+        -- kind variables+        -- Non-Nothing needs -XExistentialQuantification+        --               e.g. data T a = forall b. MkT b (b->a)+        --               con_qvars = {b}++      , con_cxt       :: Maybe (LHsContext name)+        -- ^ User-written context (if any)++      , con_details   :: HsConDeclDetails name+          -- ^ Arguments++      , con_doc       :: Maybe LHsDocString+          -- ^ A possible Haddock comment.++-}+    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.OutputableBndr name) => GHC.Outputable (ResTyGADTHook name) 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 (GHC.DataId name,GHC.OutputableBndr name,GHC.HasOccName name,Annotate name)+  => Annotate (ResTyGADTHook name) where+  markAST _ (ResTyGADTHook bndrs) = do+    unless (null bndrs) $ do+      mark GHC.AnnForall+      mapM_ markLocated bndrs+      mark GHC.AnnDot++-- ---------------------------------------------------------------------++instance (Annotate name, GHC.DataId name, GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.HsRecField name (GHC.LPat name)) 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 name, GHC.DataId name, GHC.OutputableBndr name,GHC.HasOccName name)+  => Annotate (GHC.HsRecField name (GHC.LHsExpr name)) 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 (GHC.DataId name,Annotate name)+    => Annotate (GHC.FunDep (GHC.Located name)) 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+    case mh of+      Nothing -> return ()+      Just (GHC.Header srcH _h) ->+         markWithString GHC.AnnHeader srcH+    markWithString GHC.AnnVal (fst f)+    markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------

@@ -0,0 +1,2660 @@+{-# 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.RdrName) 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.RdrName -> 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.RdrName) 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+    -- markExternal ls GHC.AnnOpen txt+    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 (GHC.DataId name,GHC.HasOccName name,Annotate name)+  => Annotate [GHC.LIE name] 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 (GHC.DataId name,GHC.HasOccName name, Annotate name)+  => Annotate (GHC.IE name) 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+                  setContext (Set.singleton PrefixOp) $ mapM_ markLocated 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 (GHC.DataId name,GHC.HasOccName name, Annotate name)+  => Annotate (GHC.IEWrappedName name) 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+{-+data IEWrappedName name+  = IEName    (Located name)  -- ^ no extra+  | IEPattern (Located name)  -- ^ pattern X+  | IEType    (Located name)  -- ^ type (:+:)+  deriving (Eq,Data)++-}+-- ---------------------------------------------------------------------+{-+-- For details on above see note [Api annotations] in ApiAnnotation+data RdrName+  = Unqual OccName+        -- ^ Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.+        -- Create such a 'RdrName' with 'mkRdrUnqual'++  | Qual ModuleName OccName+        -- ^ A qualified name written by the user in+        -- /source/ code.  The module isn't necessarily+        -- the module where the thing is defined;+        -- just the one from which it is imported.+        -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.+        -- Create such a 'RdrName' with 'mkRdrQual'++  | Orig Module OccName+        -- ^ An original name; the module is the /defining/ module.+        -- This is used when GHC generates code that will be fed+        -- into the renamer (e.g. from deriving clauses), but where+        -- we want to say \"Use Prelude.map dammit\". One of these+        -- can be created with 'mkOrig'++  | Exact Name+        -- ^ We know exactly the 'Name'. This is used:+        --+        --  (1) When the parser parses built-in syntax like @[]@+        --      and @(,)@, but wants a 'RdrName' from it+        --+        --  (2) By Template Haskell, when TH has generated a unique name+        --+        -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'+  deriving (Data, Typeable)+-}++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 && rdrName2String n /= "$"+      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")++-- ---------------------------------------------------------------------++-- TODO: What is this used for? Not in ExactPrint+instance Annotate GHC.Name where+  markAST l n = do+    markExternal l GHC.AnnVal (showGhc n)++-- ---------------------------------------------------------------------++instance (GHC.DataId name,GHC.HasOccName name,Annotate name)+  => Annotate (GHC.ImportDecl name) 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.RdrName -> 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.RdrName) where+  markAST l d = markLHsDecl (GHC.L l d)++-- ---------------------------------------------------------------------++instance (Annotate name)+   => Annotate (GHC.RoleAnnotDecl name) 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.RdrName) 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.RdrName) 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.RdrName) where+   markAST _ (GHC.HsRules src rules) = do+     markAnnOpen src "{-# RULES"+     setLayoutFlag $ markListIntercalateWithFunLevel markLocated 2 rules+     markWithString GHC.AnnClose "#-}"+     markTrailingSemi++-- ---------------------------------------------------------------------++instance Annotate (GHC.RuleDecl GHC.RdrName) 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.RdrName) 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.RdrName -> Annotated ()+markLHsSigWcType (GHC.HsWC _ (GHC.HsIB _ ty _)) = do+  markLocated ty++-- ---------------------------------------------------------------------++instance Annotate (GHC.AnnDecl GHC.RdrName) 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 name => Annotate (GHC.WarnDecls name) where+   markAST _ (GHC.Warnings src warns) = do+     markAnnOpen src "{-# WARNING" -- Note: might be {-# DEPRECATED+     mapM_ markLocated warns+     markWithString GHC.AnnClose "#-}"++-- ---------------------------------------------------------------------++instance (Annotate name)+   => Annotate (GHC.WarnDecl name) 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.RdrName) 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.RdrName) where++  markAST _ (GHC.DerivDecl typ ms mov) = do+    mark GHC.AnnDeriving+    markMaybe ms+    mark GHC.AnnInstance+    markMaybe mov+    markLHsSigType typ+    markTrailingSemi+{-+stand_alone_deriving :: { LDerivDecl RdrName }+  : 'deriving' deriv_strategy 'instance' overlap_pragma inst_type+                {% do { let { err = text "in the stand-alone deriving instance"+                                    <> colon <+> quotes (ppr $5) }+                      ; ams (sLL $1 (hsSigType $>) (DerivDecl $5 $2 $4))+                            [mj AnnDeriving $1, mj AnnInstance $3] } }++data DerivDecl name = DerivDecl+        { deriv_type         :: LHsSigType name+        , deriv_strategy     :: Maybe (Located DerivStrategy)+        , deriv_overlap_mode :: Maybe (Located OverlapMode)+         -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDeriving',+         --        'ApiAnnotation.AnnInstance', 'ApiAnnotation.AnnStock',+         --        'ApiAnnotation.AnnAnyClass', 'Api.AnnNewtype',+         --        'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose'++  -- For details on above see note [Api annotations] in ApiAnnotation+        }+-}++-- ---------------------------------------------------------------------++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.RdrName) where++  markAST _ (GHC.DefaultDecl typs) = do+    mark GHC.AnnDefault+    mark GHC.AnnOpenP -- '('+    markListIntercalate typs+    mark GHC.AnnCloseP -- ')'+    markTrailingSemi++-- ---------------------------------------------------------------------++instance Annotate (GHC.InstDecl GHC.RdrName) 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.RdrName) 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.RdrName) where++  markAST _ (GHC.TyFamInstDecl eqn _) = do+    mark GHC.AnnType+    inContext (Set.singleton TopLevel) $ mark GHC.AnnInstance -- Note: this keyword is optional+    markLocated eqn+    markTrailingSemi++-- ---------------------------------------------------------------------++instance Annotate (GHC.DataFamInstDecl GHC.RdrName) where++  markAST l (GHC.DataFamInstDecl ln (GHC.HsIB _ 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+    inContext (Set.singleton TopLevel) $ 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.RdrName) 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++  markAST l (GHC.PatSynBind (GHC.PSB ln _fvs args def dir)) = do+    mark GHC.AnnPattern+    case args of+      GHC.InfixPatSyn la lb -> do+        markLocated la+        setContext (Set.singleton InfixOp) $ markLocated ln+        markLocated lb+      GHC.PrefixPatSyn ns -> do+        markLocated ln+        mapM_ markLocated ns+      GHC.RecordPatSyn 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++  -- Introduced after renaming.+  markAST _ (GHC.AbsBinds _ _ _ _ _) =+    traceM "warning: AbsBinds introduced after renaming"++  -- Introduced after renaming.+  markAST _ GHC.AbsBindsSig{} =+    traceM "warning: AbsBindsSig introduced after renaming"++-- ---------------------------------------------------------------------++instance Annotate (GHC.IPBind GHC.RdrName) 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.RdrName (GHC.Located body)) where++  markAST _ (GHC.Match mln pats _typ (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 _ -> do+            setContext (Set.fromList [NoPrecedingSpace,PrefixOp]) $ 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.RdrName (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.RdrName) 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.RdrName -> Annotated ()+markLHsSigType (GHC.HsIB _ typ _) = markLocated typ++instance Annotate [GHC.LHsSigType GHC.RdrName] 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.RdrName) 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.RdrName) 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.RdrName) 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.RdrName) 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.RdrName) 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.RdrName) 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 -> 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        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 _) _ -> src+    GHC.HsFloatPrim  (GHC.FL src _)   -> src ++ "#"+    GHC.HsDoublePrim (GHC.FL src _)   -> src ++ "##"++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.RdrName -> 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.RdrName -> 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.RdrName] 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 (GHC.DataId name) => Annotate (GHC.HsOverLit name) where+  markAST l ol =+    let str = case GHC.ol_val ol of+                GHC.HsIntegral src _ -> src+                GHC.HsFractional l2  -> GHC.SourceText $ GHC.fl_text l2+                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.RdrName (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.RdrName GHC.RdrName) where+  markAST _ (GHC.ParStmtBlock stmts _ns _) = do+    markListIntercalate stmts++-- ---------------------------------------------------------------------++instance Annotate (GHC.HsLocalBinds GHC.RdrName) where+  markAST _ lb = markHsLocalBinds lb++-- ---------------------------------------------------------------------++markHsLocalBinds :: GHC.HsLocalBinds GHC.RdrName -> 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.RdrName (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.RdrName (GHC.Located body))] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance Annotate (GHC.HsExpr GHC.RdrName) 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.AnnOpen "(|"+        markLocated e+        mapM_ markLocated cs+        markWithString GHC.AnnClose "|)"++      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+        mark GHC.AnnAt+        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.RdrName -> Annotated ()+markLHsWcType (GHC.HsWC _ ty) = do+  markLocated ty++-- ---------------------------------------------------------------------++instance Annotate GHC.HsLit where+  markAST l lit = markExternal l GHC.AnnVal (hsLit2String lit)++-- ---------------------------------------------------------------------++instance Annotate (GHC.HsRecUpdField GHC.RdrName) 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.RdrName] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance Annotate (GHC.HsTupArg GHC.RdrName) 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.RdrName) where+  markAST _ (GHC.HsCmdTop cmd _ _ _) = markLocated cmd++instance Annotate (GHC.HsCmd GHC.RdrName) 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.RdrName GHC.RdrName (GHC.LHsCmd GHC.RdrName))] where+  markAST _ ls = mapM_ markLocated ls++-- ---------------------------------------------------------------------++instance Annotate (GHC.TyClDecl GHC.RdrName) 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+    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 $ 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.RdrName] where+  markAST _ ds = mapM_ markLocated ds++-- ---------------------------------------------------------------------++instance Annotate (GHC.HsDerivingClause GHC.RdrName) 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.RdrName) 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.RdrName) where+  markAST _ (GHC.NoSig)        = return ()+  markAST _ (GHC.KindSig k)    = markLocated k+  markAST _ (GHC.TyVarSig ltv) = markLocated ltv++-- ---------------------------------------------------------------------++instance (GHC.DataId name,Annotate name)+  => Annotate (GHC.InjectivityAnn name) where+  markAST _ (GHC.InjectivityAnn ln lns) = do+    markLocated ln+    mark GHC.AnnRarrow+    mapM_ markLocated lns++-- ---------------------------------------------------------------------++instance Annotate (GHC.TyFamInstEqn GHC.RdrName) where+  markAST _ (GHC.TyFamEqn ln (GHC.HsIB _ pats _) fixity typ) = do+    markTyClass fixity ln pats+    mark GHC.AnnEqual+    markLocated typ++-- ---------------------------------------------------------------------++instance Annotate (GHC.TyFamDefltEqn GHC.RdrName) where+  markAST _ (GHC.TyFamEqn 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.RdrName -> 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.RdrName] 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.RdrName) 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.OutputableBndrId name) => GHC.Outputable (ResTyGADTHook name) 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.RdrName) where+  markAST _ (ResTyGADTHook bndrs) = do+    unless (null bndrs) $ do+      mark GHC.AnnForall+      mapM_ markLocated bndrs+      mark GHC.AnnDot++-- ---------------------------------------------------------------------++instance Annotate (GHC.HsRecField GHC.RdrName (GHC.LPat GHC.RdrName)) 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.RdrName (GHC.LHsExpr GHC.RdrName)) 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 (GHC.DataId name,Annotate name)+    => Annotate (GHC.FunDep (GHC.Located name)) 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