{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ViewPatterns      #-}


-- | '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 HsDoc          as GHC
import qualified Name           as GHC
import qualified RdrName        as GHC
import qualified Outputable     as GHC
import qualified SrcLoc         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, Data (GHC.SrcSpanLess ast), GHC.HasSrcSpan ast) => ast -> Annotated ()
annotate :: ast -> Annotated ()
annotate = ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated

-- instance Annotate (GHC.SrcSpanLess ast) where
--   markAST s ast = undefined
instance (Data ast, Annotate ast) => Annotate (GHC.Located ast) where
  markAST :: SrcSpan -> Located ast -> Annotated ()
markAST SrcSpan
l (GHC.L SrcSpan
_ ast
ast) = SrcSpan -> ast -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l ast
ast

-- ---------------------------------------------------------------------

-- | Constructs a syntax tree which contains information about which
-- annotations are required by each element.
markLocated :: (Data (GHC.SrcSpanLess ast), Annotate ast,  GHC.HasSrcSpan ast)
             => ast -> Annotated ()
markLocated :: ast -> Annotated ()
markLocated ast
ast =
  case ast -> Maybe (LHsDecl GhcPs)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast ast
ast :: Maybe (GHC.LHsDecl GHC.GhcPs) of
    Just LHsDecl GhcPs
d  -> LHsDecl GhcPs -> Annotated ()
markLHsDecl LHsDecl GhcPs
d
    Maybe (LHsDecl GhcPs)
Nothing -> ast -> (SrcSpan -> ast -> Annotated ()) -> Annotated ()
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> (SrcSpan -> a -> Annotated ()) -> Annotated ()
withLocated ast
ast SrcSpan -> ast -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST

-- ---------------------------------------------------------------------

-- |When adding missing annotations, do not put a preceding space in front of a list
markListNoPrecedingSpace :: (Data (GHC.SrcSpanLess ast), Annotate ast, GHC.HasSrcSpan ast)
                         => Bool -> [ast] -> Annotated ()
markListNoPrecedingSpace :: Bool -> [ast] -> Annotated ()
markListNoPrecedingSpace Bool
intercal [ast]
ls =
    case [ast]
ls of
      [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (ast
l:[ast]
ls') -> do
        if Bool
intercal
        then do
          if [ast] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ast]
ls'
            then Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
NoPrecedingSpace            ]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated ast
l
            else Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
NoPrecedingSpace,AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated ast
l
          [ast] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [ast]
ls'
        else do
          Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
NoPrecedingSpace) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated ast
l
          (ast -> Annotated ()) -> [ast] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [ast]
ls'

-- ---------------------------------------------------------------------


-- |Mark a list, with the given keyword as a list item separator
markListIntercalate :: (Data (GHC.SrcSpanLess ast), Annotate ast, GHC.HasSrcSpan ast)
                    => [ast] -> Annotated ()
markListIntercalate :: [ast] -> Annotated ()
markListIntercalate [ast]
ls = (ast -> Annotated ()) -> [ast] -> Annotated ()
forall t. (t -> Annotated ()) -> [t] -> Annotated ()
markListIntercalateWithFun ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [ast]
ls

-- ---------------------------------------------------------------------

markListWithContexts :: Annotate ast
  => Set.Set AstContext -> Set.Set AstContext -> [GHC.Located ast] -> Annotated ()
markListWithContexts :: Set AstContext -> Set AstContext -> [Located ast] -> Annotated ()
markListWithContexts Set AstContext
ctxInitial Set AstContext
ctxRest [Located ast]
ls =
  case [Located ast]
ls of
    [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [Located ast
x] -> Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxInitial Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ast
x
    (Located ast
x:[Located ast]
xs) -> do
      Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxInitial Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ast
x
      Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxRest    Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (Located ast -> Annotated ()) -> [Located ast] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [Located ast]
xs

-- ---------------------------------------------------------------------

-- Context for only if just one, else first item, middle ones, and last one
markListWithContexts' :: Annotate ast
                      => ListContexts
                      -> [GHC.Located ast] -> Annotated ()
markListWithContexts' :: ListContexts -> [Located ast] -> Annotated ()
markListWithContexts' (LC Set AstContext
ctxOnly Set AstContext
ctxInitial Set AstContext
ctxMiddle Set AstContext
ctxLast) [Located ast]
ls =
  case [Located ast]
ls of
    [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [Located ast
x] -> Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxOnly Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ast
x
    (Located ast
x:[Located ast]
xs) -> do
      Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxInitial Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ast
x
      [Located ast] -> Annotated ()
go [Located ast]
xs
  where
    level :: Int
level = Int
2
    go :: [Located ast] -> Annotated ()
go []  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go [Located ast
x] = Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxLast Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ast
x
    go (Located ast
x:[Located ast]
xs) = do
      Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxMiddle Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ast
x
      [Located ast] -> Annotated ()
go [Located ast]
xs


-- ---------------------------------------------------------------------

markListWithLayout :: Annotate ast => [GHC.Located ast] -> Annotated ()
markListWithLayout :: [Located ast] -> Annotated ()
markListWithLayout [Located ast]
ls =
  Annotated () -> Annotated ()
setLayoutFlag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [Located ast] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markList [Located ast]
ls

-- ---------------------------------------------------------------------

markList :: Annotate ast => [GHC.Located ast] -> Annotated ()
markList :: [Located ast] -> Annotated ()
markList [Located ast]
ls =
  Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
NoPrecedingSpace)
   (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ ListContexts -> [Located ast] -> Annotated ()
forall ast.
Annotate ast =>
ListContexts -> [Located ast] -> Annotated ()
markListWithContexts' ListContexts
listContexts' [Located ast]
ls

markLocalBindsWithLayout :: GHC.HsLocalBinds GHC.GhcPs -> Annotated ()
markLocalBindsWithLayout :: HsLocalBinds GhcPs -> Annotated ()
markLocalBindsWithLayout HsLocalBinds GhcPs
binds = HsLocalBinds GhcPs -> Annotated ()
markHsLocalBinds HsLocalBinds GhcPs
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 :: AnnKeywordId -> Located ast -> Annotated ()
markLocatedFromKw AnnKeywordId
kw (GHC.L SrcSpan
l ast
a) = do
  -- Note: l is needed so that the pretty printer can make something up
  SrcSpan
ss <- SrcSpan -> AnnKeywordId -> FreeT AnnotationF Identity SrcSpan
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> m SrcSpan
getSrcSpanForKw SrcSpan
l AnnKeywordId
kw
  AnnKey SrcSpan
ss' AnnConName
_ <- SrcSpan -> AnnKey -> FreeT AnnotationF Identity AnnKey
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKey -> m AnnKey
storeOriginalSrcSpan SrcSpan
l (Located ast -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey (SrcSpan -> ast -> Located ast
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
ss ast
a))
  Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> ast -> Located ast
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
ss' ast
a)

-- ---------------------------------------------------------------------

markMaybe :: (Annotate ast) => Maybe (GHC.Located ast) -> Annotated ()
markMaybe :: Maybe (Located ast) -> Annotated ()
markMaybe Maybe (Located ast)
Nothing    = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markMaybe (Just Located ast
ast) = Located ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ast
ast

-- ---------------------------------------------------------------------
-- Managing lists which have been separated, e.g. Sigs and Binds

prepareListAnnotation :: Annotate a => [GHC.Located a] -> [(GHC.SrcSpan,Annotated ())]
prepareListAnnotation :: [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [Located a]
ls = (Located a -> (SrcSpan, Annotated ()))
-> [Located a] -> [(SrcSpan, Annotated ())]
forall a b. (a -> b) -> [a] -> [b]
map (\Located a
b -> (Located a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
GHC.getLoc Located a
b,Located a -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located a
b)) [Located a]
ls

-- ---------------------------------------------------------------------

instance Annotate (GHC.HsModule GHC.GhcPs) where
  markAST :: SrcSpan -> HsModule GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.HsModule Maybe (Located ModuleName)
mmn Maybe (Located [LIE GhcPs])
mexp [LImportDecl GhcPs]
imps [LHsDecl GhcPs]
decs Maybe (Located WarningTxt)
mdepr Maybe LHsDocString
_haddock) = do

    case Maybe (Located ModuleName)
mmn of
      Maybe (Located ModuleName)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (GHC.L SrcSpan
ln ModuleName
mn) -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnModule
        SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
ln AnnKeywordId
GHC.AnnVal (ModuleName -> String
GHC.moduleNameString ModuleName
mn)

        Maybe (Located WarningTxt)
-> (Located WarningTxt -> Annotated ()) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located WarningTxt)
mdepr Located WarningTxt -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated
        Maybe (Located [LIE GhcPs])
-> (Located [LIE GhcPs] -> Annotated ()) -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located [LIE GhcPs])
mexp Located [LIE GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated

        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere

    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC -- Possible '{'
    AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional AnnKeywordId
GHC.AnnSemi -- possible leading semis
    Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
TopLevel) Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [LImportDecl GhcPs] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LImportDecl GhcPs]
imps

    Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
TopLevel) Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [LHsDecl GhcPs] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LHsDecl GhcPs]
decs

    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC -- Possible '}'

    Annotated ()
forall (m :: * -> *). MonadFree AnnotationF m => m ()
markEOF

-- ---------------------------------------------------------------------

instance Annotate GHC.WarningTxt where
  markAST :: SrcSpan -> WarningTxt -> Annotated ()
markAST SrcSpan
_ (GHC.WarningTxt (GHC.L SrcSpan
_ SourceText
txt) [Located StringLiteral]
lss) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
txt String
"{-# WARNING"
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS
    [Located StringLiteral] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located StringLiteral]
lss
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

  markAST SrcSpan
_ (GHC.DeprecatedTxt (GHC.L SrcSpan
_ SourceText
txt) [Located StringLiteral]
lss) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
txt String
"{-# DEPRECATED"
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS
    [Located StringLiteral] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located StringLiteral]
lss
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

-- ---------------------------------------------------------------------

instance Annotate GHC.StringLiteral where
  markAST :: SrcSpan -> StringLiteral -> Annotated ()
markAST SrcSpan
l (GHC.StringLiteral SourceText
src FastString
fs) = do
    SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
src (String -> String
forall a. Show a => a -> String
show (FastString -> String
GHC.unpackFS FastString
fs))
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma

-- ---------------------------------------------------------------------

instance Annotate (GHC.SourceText,GHC.FastString) where
  markAST :: SrcSpan -> (SourceText, FastString) -> Annotated ()
markAST SrcSpan
l (SourceText
src,FastString
fs) = do
    SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
src (String -> String
forall a. Show a => a -> String
show (FastString -> String
GHC.unpackFS FastString
fs))

-- ---------------------------------------------------------------------

instance Annotate [GHC.LIE GHC.GhcPs] where
   markAST :: SrcSpan -> [LIE GhcPs] -> Annotated ()
markAST SrcSpan
_ [LIE GhcPs]
ls = do
     Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
HasHiding) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnHiding -- in an import decl
     AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP -- '('
     -- Can't use markListIntercalate, there can be trailing commas, but only in imports.
     (LIE GhcPs -> Annotated ()) -> Int -> [LIE GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LIE GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LIE GhcPs]
ls

     AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'

instance Annotate (GHC.IE GHC.GhcPs) where
  markAST :: SrcSpan -> IE GhcPs -> Annotated ()
markAST SrcSpan
_ IE GhcPs
ie = do

    case IE GhcPs
ie of
        GHC.IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
ln -> LIEWrappedName RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
ln

        GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
ln -> do
          Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LIEWrappedName RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
ln

        GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
ln IEWildcard
wc [LIEWrappedName (IdP GhcPs)]
ns [Located (FieldLbl (IdP GhcPs))]
_lfs -> do
          Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LIEWrappedName RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
ln
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP
          case IEWildcard
wc of
            IEWildcard
GHC.NoIEWildcard ->
              AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
PrefixOp])
                (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [LIEWrappedName RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns
            GHC.IEWildcard Int
n -> do
              Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
PrefixOp,AstContext
Intercalate])
                (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (LIEWrappedName RdrName -> Annotated ())
-> [LIEWrappedName RdrName] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LIEWrappedName RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (Int -> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. Int -> [a] -> [a]
take Int
n [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns)
              AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
              case Int -> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. Int -> [a] -> [a]
drop Int
n [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns of
                [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                [LIEWrappedName RdrName]
ns' -> do
                  AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
                  AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
PrefixOp])
                    (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [LIEWrappedName RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LIEWrappedName RdrName]
ns'
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

        (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
ln) -> do
          Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
PrefixOp]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LIEWrappedName RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
ln
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

        (GHC.IEModuleContents XIEModuleContents GhcPs
_ (GHC.L SrcSpan
lm ModuleName
mn)) -> do
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnModule
          SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
lm AnnKeywordId
GHC.AnnVal (ModuleName -> String
GHC.moduleNameString ModuleName
mn)

        -- Only used in Haddock mode so we can ignore them.
        (GHC.IEGroup {})    -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        (GHC.IEDoc {})      -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        (GHC.IEDocNamed {}) -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        GHC.XIE XXIE GhcPs
x -> String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XIE for :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXIE GhcPs
x
    Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate])
      (AnnKeywordId -> Annotated ()
mark         AnnKeywordId
GHC.AnnComma)
      (AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnComma)

-- ---------------------------------------------------------------------

instance Annotate (GHC.IEWrappedName GHC.RdrName) where
  markAST :: SrcSpan -> IEWrappedName RdrName -> Annotated ()
markAST SrcSpan
_ (GHC.IEName Located RdrName
ln) = do
    AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
PrefixOp])
      (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
ln
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
  markAST SrcSpan
_ (GHC.IEPattern Located RdrName
ln) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnPattern
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
ln
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
  markAST SrcSpan
_ (GHC.IEType Located RdrName
ln) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
ln
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma

-- ---------------------------------------------------------------------

isSymRdr :: GHC.RdrName -> Bool
isSymRdr :: RdrName -> Bool
isSymRdr RdrName
n = OccName -> Bool
GHC.isSymOcc (RdrName -> OccName
GHC.rdrNameOcc RdrName
n) Bool -> Bool -> Bool
|| RdrName -> String
rdrName2String RdrName
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"."

instance Annotate GHC.RdrName where
  markAST :: SrcSpan -> RdrName -> Annotated ()
markAST SrcSpan
l RdrName
n = do
    let
      str :: String
str = RdrName -> String
rdrName2String RdrName
n
      isSym :: Bool
isSym = RdrName -> Bool
isSymRdr RdrName
n
      doNormalRdrName :: Annotated ()
doNormalRdrName = do
        let str' :: String
str' = case String
str of
              -- TODO: unicode support?
                        String
"forall" -> if SrcSpan -> Int
spanLength SrcSpan
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"∀" else String
str
                        String
_ -> String
str

        let
          markParen :: GHC.AnnKeywordId -> Annotated ()
          markParen :: AnnKeywordId -> Annotated ()
markParen AnnKeywordId
pa = do
            if Bool
isSym
              then Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
PrefixOp,AstContext
PrefixOpDollar])
                                       (AnnKeywordId -> Annotated ()
mark         AnnKeywordId
pa) -- '('
                                       (AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
pa)
              else AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
pa

        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnSimpleQuote
        AnnKeywordId -> Annotated ()
markParen AnnKeywordId
GHC.AnnOpenP
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isSym (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
InfixOp]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Int -> Annotated ()
markOffset AnnKeywordId
GHC.AnnBackquote Int
0
        Int
cnt  <- AnnKeywordId -> FreeT AnnotationF Identity Int
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m Int
countAnns AnnKeywordId
GHC.AnnVal
        case Int
cnt of
          Int
0 -> SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
str'
          Int
1 -> AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnVal String
str'
          Int
_ -> String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"Printing RdrName, more than 1 AnnVal:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SrcSpan, RdrName) -> String
forall a. Outputable a => a -> String
showGhc (SrcSpan
l,RdrName
n)
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isSym (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
InfixOp]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Int -> Annotated ()
markOffset AnnKeywordId
GHC.AnnBackquote Int
1
        AnnKeywordId -> Annotated ()
markParen AnnKeywordId
GHC.AnnCloseP

    case RdrName
n of
      GHC.Unqual OccName
_ -> Annotated ()
doNormalRdrName
      GHC.Qual ModuleName
_ OccName
_ -> Annotated ()
doNormalRdrName
      GHC.Orig Module
_ OccName
_ -> if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"~"
                        then Annotated ()
doNormalRdrName
                        -- then error $ "GHC.orig:(isSym,canParen)=" ++ show (isSym,canParen)
                        else SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
str
      -- GHC.Orig _ _ -> markExternal l GHC.AnnVal str
      -- GHC.Orig _ _ -> error $ "GHC.orig:str=[" ++ str ++ "]"
      GHC.Exact Name
n'  -> do
       case String
str of
         -- Special handling for Exact RdrNames, which are built-in Names
         String
"[]" -> do
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS  -- '['
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'
         String
"()" -> do
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP  -- '('
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'
         (Char
'(':Char
'#':String
_) -> do
           AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen  String
"(#" -- '(#'
           let cnt :: Int
cnt = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') String
str
           Int -> Annotated () -> Annotated ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
cnt (AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCommaTuple)
           AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose  String
"#)"-- '#)'
         String
"[::]" -> do
           AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen  String
"[:" -- '[:'
           AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
":]" -- ':]'
         String
"->" -> do
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP -- '('
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'
         -- "~#"  -> do
         --   mark GHC.AnnOpenP -- '('
         --   mark GHC.AnnTildehsh
         --   mark GHC.AnnCloseP
         String
"~"  -> do
           Annotated ()
doNormalRdrName
         String
"*"  -> do
           SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
str
         String
"★"  -> do -- Note: unicode star
           SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
str
         String
":"  -> do
           -- Note: The OccName for ":" has the following attributes (via occAttributes)
           -- (d, Data DataSym Sym Val )
           -- consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
           Annotated ()
doNormalRdrName
           -- trace ("RdrName.checking :" ++ (occAttributes $ GHC.occName n)) doNormalRdrName
         (Char
'(':Char
',':String
_) -> do
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP
           let cnt :: Int
cnt = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') String
str
           Int -> Annotated () -> Annotated ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
cnt (AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCommaTuple)
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'
         String
_ -> do
            let isSym' :: Bool
isSym' = RdrName -> Bool
isSymRdr  (Name -> RdrName
GHC.nameRdrName Name
n')
            Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSym' (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP -- '('
            AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnVal String
str
            Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isSym (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma Annotated () -> String -> Annotated ()
forall c. c -> String -> c
`debug` (String
"AnnComma in RdrName")

-- ---------------------------------------------------------------------

instance Annotate (GHC.ImportDecl GHC.GhcPs) where
 markAST :: SrcSpan -> ImportDecl GhcPs -> Annotated ()
markAST SrcSpan
_ imp :: ImportDecl GhcPs
imp@(GHC.ImportDecl XCImportDecl GhcPs
_ SourceText
msrc Located ModuleName
modname Maybe StringLiteral
mpkg Bool
_src Bool
safeflag ImportDeclQualifiedStyle
qualFlag Bool
_impl Maybe (Located ModuleName)
_as Maybe (Bool, Located [LIE GhcPs])
hiding) = do

   -- 'import' maybe_src maybe_safe optqualified maybe_pkg modid maybeas maybeimpspec
   AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnImport

   -- "{-# SOURCE" and "#-}"
   case SourceText
msrc of
     GHC.SourceText String
_txt -> do
       SourceText -> String -> Annotated ()
markAnnOpen SourceText
msrc String
"{-# SOURCE"
       AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"
     SourceText
GHC.NoSourceText -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
safeflag (AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnSafe)
   case ImportDeclQualifiedStyle
qualFlag of
     ImportDeclQualifiedStyle
GHC.QualifiedPre  -- 'qualified' appears in prepositive position.
       -> (AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
TopLevel (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnQualified)
     ImportDeclQualifiedStyle
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   case Maybe StringLiteral
mpkg of
    Just (GHC.StringLiteral (GHC.SourceText String
srcPkg) FastString
_) ->
      AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnPackageName String
srcPkg
    Maybe StringLiteral
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   Located ModuleName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ModuleName
modname

   case ImportDeclQualifiedStyle
qualFlag of
     ImportDeclQualifiedStyle
GHC.QualifiedPost -- 'qualified' appears in postpositive position.
       -> (AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
TopLevel (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnQualified)
     ImportDeclQualifiedStyle
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   case ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
GHC.ideclAs ImportDecl GhcPs
imp of
      Maybe (Located ModuleName)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Located ModuleName
mn -> do
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnAs
          Located ModuleName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located ModuleName
mn

   case Maybe (Bool, Located [LIE GhcPs])
hiding of
     Maybe (Bool, Located [LIE GhcPs])
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just (Bool
isHiding,Located [LIE GhcPs]
lie) -> do
       if Bool
isHiding
         then Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
HasHiding) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$
                Located [LIE GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located [LIE GhcPs]
lie
         else Located [LIE GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located [LIE GhcPs]
lie
   Annotated ()
markTrailingSemi


 markAST SrcSpan
_ (GHC.XImportDecl XXImportDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XImportDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXImportDecl GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate GHC.ModuleName where
   markAST :: SrcSpan -> ModuleName -> Annotated ()
markAST SrcSpan
l ModuleName
mname =
    SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal (ModuleName -> String
GHC.moduleNameString ModuleName
mname)

-- ---------------------------------------------------------------------

markLHsDecl :: GHC.LHsDecl GHC.GhcPs -> Annotated ()
markLHsDecl :: LHsDecl GhcPs -> Annotated ()
markLHsDecl (GHC.L SrcSpan
l HsDecl GhcPs
decl) =
    case HsDecl GhcPs
decl of
      GHC.TyClD XTyClD GhcPs
_ TyClDecl GhcPs
d       -> GenLocated SrcSpan (TyClDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> TyClDecl GhcPs -> GenLocated SrcSpan (TyClDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l TyClDecl GhcPs
d)
      GHC.InstD XInstD GhcPs
_ InstDecl GhcPs
d       -> GenLocated SrcSpan (InstDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> InstDecl GhcPs -> GenLocated SrcSpan (InstDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l InstDecl GhcPs
d)
      GHC.DerivD XDerivD GhcPs
_ DerivDecl GhcPs
d      -> GenLocated SrcSpan (DerivDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> DerivDecl GhcPs -> GenLocated SrcSpan (DerivDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l DerivDecl GhcPs
d)
      GHC.ValD XValD GhcPs
_ HsBind GhcPs
d        -> GenLocated SrcSpan (HsBind GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> HsBind GhcPs -> GenLocated SrcSpan (HsBind GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsBind GhcPs
d)
      GHC.SigD XSigD GhcPs
_ Sig GhcPs
d        -> GenLocated SrcSpan (Sig GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> Sig GhcPs -> GenLocated SrcSpan (Sig GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l Sig GhcPs
d)
      GHC.KindSigD XKindSigD GhcPs
_ StandaloneKindSig GhcPs
d    -> GenLocated SrcSpan (StandaloneKindSig GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan
-> StandaloneKindSig GhcPs
-> GenLocated SrcSpan (StandaloneKindSig GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l StandaloneKindSig GhcPs
d)
      GHC.DefD XDefD GhcPs
_ DefaultDecl GhcPs
d        -> GenLocated SrcSpan (DefaultDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan
-> DefaultDecl GhcPs -> GenLocated SrcSpan (DefaultDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l DefaultDecl GhcPs
d)
      GHC.ForD XForD GhcPs
_ ForeignDecl GhcPs
d        -> GenLocated SrcSpan (ForeignDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan
-> ForeignDecl GhcPs -> GenLocated SrcSpan (ForeignDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l ForeignDecl GhcPs
d)
      GHC.WarningD XWarningD GhcPs
_ WarnDecls GhcPs
d    -> GenLocated SrcSpan (WarnDecls GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> WarnDecls GhcPs -> GenLocated SrcSpan (WarnDecls GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l WarnDecls GhcPs
d)
      GHC.AnnD XAnnD GhcPs
_ AnnDecl GhcPs
d        -> GenLocated SrcSpan (AnnDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> AnnDecl GhcPs -> GenLocated SrcSpan (AnnDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l AnnDecl GhcPs
d)
      GHC.RuleD XRuleD GhcPs
_ RuleDecls GhcPs
d       -> GenLocated SrcSpan (RuleDecls GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> RuleDecls GhcPs -> GenLocated SrcSpan (RuleDecls GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l RuleDecls GhcPs
d)
      GHC.SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
d     -> GenLocated SrcSpan (SpliceDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan
-> SpliceDecl GhcPs -> GenLocated SrcSpan (SpliceDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l SpliceDecl GhcPs
d)
      GHC.DocD XDocD GhcPs
_ DocDecl
d        -> GenLocated SrcSpan DocDecl -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> DocDecl -> GenLocated SrcSpan DocDecl
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l DocDecl
d)
      GHC.RoleAnnotD XRoleAnnotD GhcPs
_ RoleAnnotDecl GhcPs
d  -> GenLocated SrcSpan (RoleAnnotDecl GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan
-> RoleAnnotDecl GhcPs -> GenLocated SrcSpan (RoleAnnotDecl GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l RoleAnnotDecl GhcPs
d)
      GHC.XHsDecl XXHsDecl GhcPs
x  -> String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XHsDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXHsDecl GhcPs
x

instance Annotate (GHC.HsDecl GHC.GhcPs) where
  markAST :: SrcSpan -> HsDecl GhcPs -> Annotated ()
markAST SrcSpan
l HsDecl GhcPs
d = LHsDecl GhcPs -> Annotated ()
markLHsDecl (SrcSpan -> HsDecl GhcPs -> LHsDecl GhcPs
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsDecl GhcPs
d)

-- ---------------------------------------------------------------------

instance Annotate (GHC.RoleAnnotDecl GHC.GhcPs) where
  markAST :: SrcSpan -> RoleAnnotDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.RoleAnnotDecl XCRoleAnnotDecl GhcPs
_ Located (IdP GhcPs)
ln [Located (Maybe Role)]
mr) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRole
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    (Located (Maybe Role) -> Annotated ())
-> [Located (Maybe Role)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located (Maybe Role) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [Located (Maybe Role)]
mr
  markAST SrcSpan
_ (GHC.XRoleAnnotDecl XXRoleAnnotDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XRoleAnnotDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXRoleAnnotDecl GhcPs
x

instance Annotate (Maybe GHC.Role) where
  markAST :: SrcSpan -> Maybe Role -> Annotated ()
markAST SrcSpan
l Maybe Role
Nothing  = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"_"
  markAST SrcSpan
l (Just Role
r) = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal (FastString -> String
GHC.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ Role -> FastString
GHC.fsFromRole Role
r)

-- ---------------------------------------------------------------------

instance Annotate (GHC.SpliceDecl GHC.GhcPs) where
  markAST :: SrcSpan -> SpliceDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.SpliceDecl XSpliceDecl GhcPs
_ e :: Located (HsSplice GhcPs)
e@(GHC.L SrcSpan
_ (GHC.HsQuasiQuote{})) SpliceExplicitFlag
_flag) = do
    Located (HsSplice GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsSplice GhcPs)
e
    Annotated ()
markTrailingSemi
  markAST SrcSpan
_ (GHC.SpliceDecl XSpliceDecl GhcPs
_ Located (HsSplice GhcPs)
e SpliceExplicitFlag
_flag) = do
    Located (HsSplice GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsSplice GhcPs)
e
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.XSpliceDecl XXSpliceDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XSpliceDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXSpliceDecl GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.RuleDecls GHC.GhcPs) where
  markAST :: SrcSpan -> RuleDecls GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.HsRules XCRuleDecls GhcPs
_ SourceText
src [LRuleDecl GhcPs]
rules) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# RULES"
    Annotated () -> Annotated ()
setLayoutFlag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (LRuleDecl GhcPs -> Annotated ())
-> Int -> [LRuleDecl GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LRuleDecl GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LRuleDecl GhcPs]
rules
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"
    Annotated ()
markTrailingSemi
  markAST SrcSpan
_ (GHC.XRuleDecls XXRuleDecls GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XRuleDecls for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXRuleDecls GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.RuleDecl GHC.GhcPs) where
  markAST :: SrcSpan -> RuleDecl GhcPs -> Annotated ()
markAST SrcSpan
l (GHC.HsRule XHsRule GhcPs
_ Located (SourceText, FastString)
ln Activation
act Maybe [LHsTyVarBndr (NoGhcTc GhcPs)]
mtybndrs [LRuleBndr GhcPs]
termbndrs Located (HsExpr GhcPs)
lhs Located (HsExpr GhcPs)
rhs) = do
    Located (SourceText, FastString) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (SourceText, FastString)
ln
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
ExplicitNeverActive) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Activation -> Annotated ()
markActivation SrcSpan
l Activation
act

    case Maybe [LHsTyVarBndr (NoGhcTc GhcPs)]
mtybndrs of
      Maybe [LHsTyVarBndr (NoGhcTc GhcPs)]
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just [LHsTyVarBndr (NoGhcTc GhcPs)]
bndrs -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnForall
        (LHsTyVarBndr GhcPs -> Annotated ())
-> [LHsTyVarBndr GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsTyVarBndr GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsTyVarBndr GhcPs]
[LHsTyVarBndr (NoGhcTc GhcPs)]
bndrs
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDot

    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnForall
    (LRuleBndr GhcPs -> Annotated ())
-> [LRuleBndr GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LRuleBndr GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LRuleBndr GhcPs]
termbndrs
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDot

    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
lhs
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
rhs
    Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnSemi
    Annotated ()
markTrailingSemi
{-
  = HsRule -- Source rule
       { rd_ext  :: XHsRule pass
           -- ^ After renamer, free-vars from the LHS and RHS
       , rd_name :: Located (SourceText,RuleName)
           -- ^ Note [Pragma source text] in BasicTypes
       , rd_act  :: Activation
       , rd_tyvs :: Maybe [LHsTyVarBndr (NoGhcTc pass)]
           -- ^ Forall'd type vars
       , rd_tmvs :: [LRuleBndr pass]
           -- ^ Forall'd term vars, before typechecking; after typechecking
           --    this includes all forall'd vars
       , rd_lhs  :: Located (HsExpr pass)
       , rd_rhs  :: Located (HsExpr pass)
       }

-}

  markAST SrcSpan
_ (GHC.XRuleDecl XXRuleDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XRuleDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXRuleDecl GhcPs
x

-- ---------------------------------------------------------------------

markActivation :: GHC.SrcSpan -> GHC.Activation -> Annotated ()
markActivation :: SrcSpan -> Activation -> Annotated ()
markActivation SrcSpan
_ Activation
act = do
  case Activation
act of
    GHC.ActiveBefore SourceText
src Int
phase -> do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS --  '['
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnTilde -- ~
      SourceText -> String -> Annotated ()
markSourceText SourceText
src (Int -> String
forall a. Show a => a -> String
show Int
phase)
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'
    GHC.ActiveAfter SourceText
src Int
phase -> do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS --  '['
      SourceText -> String -> Annotated ()
markSourceText SourceText
src (Int -> String
forall a. Show a => a -> String
show Int
phase)
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'
    Activation
GHC.NeverActive -> do
      Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
ExplicitNeverActive) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS --  '['
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnTilde -- ~
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'
    Activation
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- ---------------------------------------------------------------------

instance Annotate (GHC.RuleBndr GHC.GhcPs) where
  markAST :: SrcSpan -> RuleBndr GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.RuleBndr XCRuleBndr GhcPs
_ Located (IdP GhcPs)
ln) = Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
  markAST SrcSpan
_ (GHC.RuleBndrSig XRuleBndrSig GhcPs
_ Located (IdP GhcPs)
ln LHsSigWcType GhcPs
st) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP -- "("
    Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    LHsSigWcType GhcPs -> Annotated ()
markLHsSigWcType LHsSigWcType GhcPs
st
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ")"
  markAST SrcSpan
_ (GHC.XRuleBndr XXRuleBndr GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XRuleBndr for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXRuleBndr GhcPs
x

-- ---------------------------------------------------------------------

markLHsSigWcType :: GHC.LHsSigWcType GHC.GhcPs -> Annotated ()
markLHsSigWcType :: LHsSigWcType GhcPs -> Annotated ()
markLHsSigWcType (GHC.HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
ty)) = do
  LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
ty
markLHsSigWcType (GHC.HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
_)) = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markLHsSigWcType extension hit"
markLHsSigWcType (GHC.XHsWildCardBndrs XXHsWildCardBndrs GhcPs (LHsSigType GhcPs)
_)              = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markLHsSigWcType extension hit"

-- ---------------------------------------------------------------------

instance Annotate (GHC.AnnDecl GHC.GhcPs) where
   markAST :: SrcSpan -> AnnDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.HsAnnotation XHsAnnotation GhcPs
_ SourceText
src AnnProvenance (IdP GhcPs)
prov Located (HsExpr GhcPs)
e) = do
     SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# ANN"
     case AnnProvenance (IdP GhcPs)
prov of
       (GHC.ValueAnnProvenance Located (IdP GhcPs)
n) -> Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
n
       (GHC.TypeAnnProvenance Located (IdP GhcPs)
n) -> do
         AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType
         Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
n
       AnnProvenance (IdP GhcPs)
GHC.ModuleAnnProvenance -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnModule

     Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e
     AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"
     Annotated ()
markTrailingSemi

   markAST SrcSpan
_ (GHC.XAnnDecl XXAnnDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XAnnDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXAnnDecl GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.WarnDecls GHC.GhcPs) where
   markAST :: SrcSpan -> WarnDecls GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.Warnings XWarnings GhcPs
_ SourceText
src [LWarnDecl GhcPs]
warns) = do
     SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# WARNING" -- Note: might be {-# DEPRECATED
     (LWarnDecl GhcPs -> Annotated ())
-> [LWarnDecl GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LWarnDecl GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LWarnDecl GhcPs]
warns
     AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

   markAST SrcSpan
_ (GHC.XWarnDecls XXWarnDecls GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XWarnDecls for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXWarnDecls GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.WarnDecl GHC.GhcPs) where
   markAST :: SrcSpan -> WarnDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.Warning XWarning GhcPs
_ [Located (IdP GhcPs)]
lns WarningTxt
txt) = do
     [Located RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located (IdP GhcPs)]
[Located RdrName]
lns
     AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS -- "["
     case WarningTxt
txt of
       GHC.WarningTxt    GenLocated SrcSpan SourceText
_src [Located StringLiteral]
ls -> [Located StringLiteral] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located StringLiteral]
ls
       GHC.DeprecatedTxt GenLocated SrcSpan SourceText
_src [Located StringLiteral]
ls -> [Located StringLiteral] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located StringLiteral]
ls
     AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- "]"

   markAST SrcSpan
_ (GHC.XWarnDecl XXWarnDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XWarnDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXWarnDecl GhcPs
x

instance Annotate GHC.FastString where
  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.
  markAST :: SrcSpan -> FastString -> Annotated ()
markAST SrcSpan
l FastString
fs = do
    SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal (String -> String
forall a. Show a => a -> String
show (FastString -> String
GHC.unpackFS FastString
fs))
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma

-- ---------------------------------------------------------------------

instance Annotate (GHC.ForeignDecl GHC.GhcPs) where
  markAST :: SrcSpan -> ForeignDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.ForeignImport XForeignImport GhcPs
_ Located (IdP GhcPs)
ln (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
typ)
               (GHC.CImport Located CCallConv
cconv safety :: Located Safety
safety@(GHC.L SrcSpan
ll Safety
_) Maybe Header
_mh CImportSpec
_imp (GHC.L SrcSpan
ls SourceText
src))) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnForeign
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnImport
    Located CCallConv -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located CCallConv
cconv
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SrcSpan
ll SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
GHC.noSrcSpan) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located Safety -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located Safety
safety
    SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
ls SourceText
src String
""
    Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_l (GHC.ForeignExport XForeignExport GhcPs
_ Located (IdP GhcPs)
ln (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
typ) (GHC.CExport Located CExportSpec
spec (GHC.L SrcSpan
ls SourceText
src))) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnForeign
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnExport
    Located CExportSpec -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located CExportSpec
spec
    SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
ls AnnKeywordId
GHC.AnnVal (SourceText -> String -> String
sourceTextToString SourceText
src String
"")
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ


  markAST SrcSpan
_ (GHC.ForeignImport XForeignImport GhcPs
_ Located (IdP GhcPs)
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
_) ForeignImport
_) = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markAST ForeignDecl hit extenstion"
  markAST SrcSpan
_ (GHC.ForeignExport XForeignExport GhcPs
_ Located (IdP GhcPs)
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
_) ForeignExport
_) = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markAST ForeignDecl hit extenstion"
  markAST SrcSpan
_ (GHC.XForeignDecl XXForeignDecl GhcPs
_)                               = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markAST ForeignDecl hit extenstion"

-- ---------------------------------------------------------------------

instance (Annotate GHC.CExportSpec) where
  markAST :: SrcSpan -> CExportSpec -> Annotated ()
markAST SrcSpan
l (GHC.CExportStatic SourceText
_src FastString
_ CCallConv
cconv) = SrcSpan -> CCallConv -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l CCallConv
cconv

-- ---------------------------------------------------------------------

instance (Annotate GHC.CCallConv) where
  markAST :: SrcSpan -> CCallConv -> Annotated ()
markAST SrcSpan
l CCallConv
GHC.StdCallConv        =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"stdcall"
  markAST SrcSpan
l CCallConv
GHC.CCallConv          =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"ccall"
  markAST SrcSpan
l CCallConv
GHC.CApiConv           =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"capi"
  markAST SrcSpan
l CCallConv
GHC.PrimCallConv       =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"prim"
  markAST SrcSpan
l CCallConv
GHC.JavaScriptCallConv =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"javascript"

-- ---------------------------------------------------------------------

instance (Annotate GHC.Safety) where
  markAST :: SrcSpan -> Safety -> Annotated ()
markAST SrcSpan
l Safety
GHC.PlayRisky         = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"unsafe"
  markAST SrcSpan
l Safety
GHC.PlaySafe          = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"safe"
  markAST SrcSpan
l Safety
GHC.PlayInterruptible = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"interruptible"

-- ---------------------------------------------------------------------

instance Annotate (GHC.DerivDecl GHC.GhcPs) where

  markAST :: SrcSpan -> DerivDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.DerivDecl XCDerivDecl GhcPs
_ (GHC.HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
typ)) Maybe (LDerivStrategy GhcPs)
ms Maybe (Located OverlapMode)
mov) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDeriving
    Maybe (LDerivStrategy GhcPs) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (LDerivStrategy GhcPs)
ms
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnInstance
    Maybe (Located OverlapMode) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (Located OverlapMode)
mov
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
    Annotated ()
markTrailingSemi

{-
data DerivDecl pass = DerivDecl
        { deriv_ext          :: XCDerivDecl pass
        , deriv_type         :: LHsSigWcType pass
          -- ^ The instance type to derive.
          --
          -- It uses an 'LHsSigWcType' because the context is allowed to be a
          -- single wildcard:
          --
          -- > deriving instance _ => Eq (Foo a)
          --
          -- Which signifies that the context should be inferred.

          -- See Note [Inferring the instance context] in TcDerivInfer.

        , deriv_strategy     :: Maybe (LDerivStrategy pass)
        , deriv_overlap_mode :: Maybe (Located OverlapMode)

type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both

data HsWildCardBndrs pass thing
    -- See Note [HsType binders]
    -- See Note [The wildcard story for types]
  = HsWC { hswc_ext :: XHsWC pass thing
                -- after the renamer
                -- Wild cards, both named and anonymous

         , hswc_body :: thing
                -- Main payload (type or list of types)
                -- If there is an extra-constraints wildcard,
                -- it's still there in the hsc_body.
    }


-}


  markAST SrcSpan
_ (GHC.DerivDecl XCDerivDecl GhcPs
_ (GHC.HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
_)) Maybe (LDerivStrategy GhcPs)
_ Maybe (Located OverlapMode)
_) = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markAST DerivDecl hit extension"
  markAST SrcSpan
_ (GHC.DerivDecl XCDerivDecl GhcPs
_ (GHC.XHsWildCardBndrs XXHsWildCardBndrs GhcPs (LHsSigType GhcPs)
_) Maybe (LDerivStrategy GhcPs)
_ Maybe (Located OverlapMode)
_)              = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markAST DerivDecl hit extension"
  markAST SrcSpan
_ (GHC.XDerivDecl XXDerivDecl GhcPs
_)                                          = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"markAST DerivDecl hit extension"

-- ---------------------------------------------------------------------

instance Annotate (GHC.DerivStrategy GHC.GhcPs) where

  markAST :: SrcSpan -> DerivStrategy GhcPs -> Annotated ()
markAST SrcSpan
_ DerivStrategy GhcPs
GHC.StockStrategy    = AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnStock
  markAST SrcSpan
_ DerivStrategy GhcPs
GHC.AnyclassStrategy = AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnAnyclass
  markAST SrcSpan
_ DerivStrategy GhcPs
GHC.NewtypeStrategy  = AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnNewtype
  markAST SrcSpan
_ (GHC.ViaStrategy (GHC.HsIB _ ty)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVia
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
ty
  markAST SrcSpan
_ (GHC.ViaStrategy (GHC.XHsImplicitBndrs _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XHsImplicitBndrs in AnnDerivStrategy"

-- ---------------------------------------------------------------------

instance Annotate (GHC.DefaultDecl GHC.GhcPs) where

  markAST :: SrcSpan -> DefaultDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.DefaultDecl XCDefaultDecl GhcPs
_ [LHsType GhcPs]
typs) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDefault
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP -- '('
    [LHsType GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LHsType GhcPs]
typs
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.XDefaultDecl XXDefaultDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XDefaultDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXDefaultDecl GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.InstDecl GHC.GhcPs) where

  markAST :: SrcSpan -> InstDecl GhcPs -> Annotated ()
markAST SrcSpan
l (GHC.ClsInstD     XClsInstD GhcPs
_  ClsInstDecl GhcPs
cid) = SrcSpan -> ClsInstDecl GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l  ClsInstDecl GhcPs
cid
  markAST SrcSpan
l (GHC.DataFamInstD XDataFamInstD GhcPs
_ DataFamInstDecl GhcPs
dfid) = SrcSpan -> DataFamInstDecl GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l DataFamInstDecl GhcPs
dfid
  markAST SrcSpan
l (GHC.TyFamInstD   XTyFamInstD GhcPs
_ TyFamInstDecl GhcPs
tfid) = SrcSpan -> TyFamInstDecl GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l TyFamInstDecl GhcPs
tfid
  markAST SrcSpan
_ (GHC.XInstDecl XXInstDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XInstDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXInstDecl GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate GHC.OverlapMode where

  -- NOTE: NoOverlap is only used in the typechecker
  markAST :: SrcSpan -> OverlapMode -> Annotated ()
markAST SrcSpan
_ (GHC.NoOverlap SourceText
src) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# NO_OVERLAP"
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

  markAST SrcSpan
_ (GHC.Overlappable SourceText
src) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# OVERLAPPABLE"
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

  markAST SrcSpan
_ (GHC.Overlapping SourceText
src) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# OVERLAPPING"
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

  markAST SrcSpan
_ (GHC.Overlaps SourceText
src) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# OVERLAPS"
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

  markAST SrcSpan
_ (GHC.Incoherent SourceText
src) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# INCOHERENT"
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"

-- ---------------------------------------------------------------------

instance Annotate (GHC.ClsInstDecl GHC.GhcPs) where

  markAST :: SrcSpan -> ClsInstDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.ClsInstDecl XCClsInstDecl GhcPs
_ (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
poly) LHsBinds GhcPs
binds [GenLocated SrcSpan (Sig GhcPs)]
sigs [LTyFamInstDecl GhcPs]
tyfams [LDataFamInstDecl GhcPs]
datafams Maybe (Located OverlapMode)
mov) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnInstance
    Maybe (Located OverlapMode) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (Located OverlapMode)
mov
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
poly
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC -- '{'
    AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markInside AnnKeywordId
GHC.AnnSemi

    [(SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotationsLayout ([GenLocated SrcSpan (HsBind GhcPs)] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation (LHsBinds GhcPs -> [GenLocated SrcSpan (HsBind GhcPs)]
forall a. Bag a -> [a]
GHC.bagToList LHsBinds GhcPs
binds)
                             [(SrcSpan, Annotated ())]
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpan (Sig GhcPs)] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [GenLocated SrcSpan (Sig GhcPs)]
sigs
                             [(SrcSpan, Annotated ())]
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LTyFamInstDecl GhcPs] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [LTyFamInstDecl GhcPs]
tyfams
                             [(SrcSpan, Annotated ())]
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LDataFamInstDecl GhcPs] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [LDataFamInstDecl GhcPs]
datafams
                               )

    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC -- '}'
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.ClsInstDecl XCClsInstDecl GhcPs
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
_) LHsBinds GhcPs
_ [GenLocated SrcSpan (Sig GhcPs)]
_ [LTyFamInstDecl GhcPs]
_ [LDataFamInstDecl GhcPs]
_ Maybe (Located OverlapMode)
_) = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for ClsInstDecl"
  markAST SrcSpan
_ (GHC.XClsInstDecl XXClsInstDecl GhcPs
_)                                   = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for ClsInstDecl"

-- ---------------------------------------------------------------------

instance Annotate (GHC.TyFamInstDecl GHC.GhcPs) where
{-
newtype TyFamInstDecl pass = TyFamInstDecl { tfid_eqn :: TyFamInstEqn pass }

type TyFamInstEqn pass = FamInstEqn pass (LHsType pass)

type FamInstEqn pass rhs
  = HsImplicitBndrs pass (FamEqn pass (HsTyPats pass) rhs)


-}
  markAST :: SrcSpan -> TyFamInstDecl GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.TyFamInstDecl (GHC.HsIB XHsIB GhcPs (FamEqn GhcPs (LHsType GhcPs))
_ FamEqn GhcPs (LHsType GhcPs)
eqn)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnInstance -- Note: this keyword is optional
    FamEqn GhcPs (LHsType GhcPs) -> Annotated ()
markFamEqn FamEqn GhcPs (LHsType GhcPs)
eqn
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.TyFamInstDecl (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (FamEqn GhcPs (LHsType GhcPs))
_)) = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for TyFamInstDecl"

-- ---------------------------------------------------------------------

-- markFamEqn :: (GHC.HasOccName (GHC.IdP pass),
--                Annotate (GHC.IdP pass), Annotate ast1, Annotate ast2)
--            => GHC.FamEqn pass [GHC.Located ast1] (GHC.Located ast2)
--                     -> Annotated ()
-- markFamEqn :: GHC.FamEqn GhcPs [GHC.LHsTypeArg GhcPs] (GHC.LHsType GHC.GhcPs)
markFamEqn :: GHC.FamEqn GhcPs (GHC.LHsType GHC.GhcPs)
           -> Annotated ()
markFamEqn :: FamEqn GhcPs (LHsType GhcPs) -> Annotated ()
markFamEqn (GHC.FamEqn XCFamEqn GhcPs (LHsType GhcPs)
_ Located (IdP GhcPs)
ln Maybe [LHsTyVarBndr GhcPs]
bndrs HsTyPats GhcPs
pats LexicalFixity
fixity LHsType GhcPs
rhs) = do
  Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> HsTyPats GhcPs
-> Annotated ()
forall a.
Annotate a =>
Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> HsTyPats GhcPs -> Annotated ()
markTyClassArgs Maybe [LHsTyVarBndr GhcPs]
bndrs LexicalFixity
fixity Located (IdP GhcPs)
Located RdrName
ln HsTyPats GhcPs
pats
  AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
  LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
rhs
{-
data FamEqn pass pats rhs
  = FamEqn
       { feqn_ext    :: XCFamEqn pass pats rhs
       , feqn_tycon  :: Located (IdP pass)
       , feqn_bndrs  :: Maybe [LHsTyVarBndr pass] -- ^ Optional quantified type vars
       , feqn_pats   :: pats
       , feqn_fixity :: LexicalFixity -- ^ Fixity used in the declaration
       , feqn_rhs    :: rhs
       }
-}

markFamEqn (GHC.XFamEqn XXFamEqn GhcPs (LHsType GhcPs)
_) = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"got XFamEqn"

-- ---------------------------------------------------------------------

instance Annotate (GHC.DataFamInstDecl GHC.GhcPs) where

  markAST :: SrcSpan -> DataFamInstDecl GhcPs -> Annotated ()
markAST SrcSpan
l (GHC.DataFamInstDecl (GHC.HsIB XHsIB GhcPs (FamEqn GhcPs (HsDataDefn GhcPs))
_ (GHC.FamEqn XCFamEqn GhcPs (HsDataDefn GhcPs)
_ Located (IdP GhcPs)
ln Maybe [LHsTyVarBndr GhcPs]
bndrs HsTyPats GhcPs
pats LexicalFixity
fixity
             defn :: HsDataDefn GhcPs
defn@(GHC.HsDataDefn XCHsDataDefn GhcPs
_ NewOrData
nd LHsContext GhcPs
ctx Maybe (Located CType)
typ Maybe (LHsType GhcPs)
_mk [LConDecl GhcPs]
cons HsDeriving GhcPs
mderivs) ))) = do
    case HsDataDefn GhcPs -> NewOrData
forall pass. HsDataDefn pass -> NewOrData
GHC.dd_ND HsDataDefn GhcPs
defn of
      NewOrData
GHC.NewType  -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnNewtype
      NewOrData
GHC.DataType -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnData
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnInstance

    LHsContext GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsContext GhcPs
ctx

    Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> HsTyPats GhcPs
-> Annotated ()
forall a.
Annotate a =>
Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> HsTyPats GhcPs -> Annotated ()
markTyClassArgs Maybe [LHsTyVarBndr GhcPs]
bndrs LexicalFixity
fixity Located (IdP GhcPs)
Located RdrName
ln HsTyPats GhcPs
pats

    case (HsDataDefn GhcPs -> Maybe (LHsType GhcPs)
forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
GHC.dd_kindSig HsDataDefn GhcPs
defn) of
      Just LHsType GhcPs
s -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
        LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
s
      Maybe (LHsType GhcPs)
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    if [LConDecl GhcPs] -> Bool
forall name. [LConDecl name] -> Bool
isGadt ([LConDecl GhcPs] -> Bool) -> [LConDecl GhcPs] -> Bool
forall a b. (a -> b) -> a -> b
$ HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
GHC.dd_cons HsDataDefn GhcPs
defn
      then AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere
      else Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LConDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LConDecl GhcPs]
cons) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
    SrcSpan -> HsDataDefn GhcPs -> Annotated ()
markDataDefn SrcSpan
l (XCHsDataDefn GhcPs
-> NewOrData
-> LHsContext GhcPs
-> Maybe (Located CType)
-> Maybe (LHsType GhcPs)
-> [LConDecl GhcPs]
-> HsDeriving GhcPs
-> HsDataDefn GhcPs
forall pass.
XCHsDataDefn pass
-> NewOrData
-> LHsContext pass
-> Maybe (Located CType)
-> Maybe (LHsKind pass)
-> [LConDecl pass]
-> HsDeriving pass
-> HsDataDefn pass
GHC.HsDataDefn NoExtField
XCHsDataDefn GhcPs
GHC.NoExtField NewOrData
nd (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc []) Maybe (Located CType)
typ Maybe (LHsType GhcPs)
_mk [LConDecl GhcPs]
cons HsDeriving GhcPs
mderivs)
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnWhere
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_
            (GHC.DataFamInstDecl
             (GHC.HsIB XHsIB GhcPs (FamEqn GhcPs (HsDataDefn GhcPs))
_ (GHC.FamEqn XCFamEqn GhcPs (HsDataDefn GhcPs)
_ Located (IdP GhcPs)
_ Maybe [LHsTyVarBndr GhcPs]
_ HsTyPats GhcPs
_ LexicalFixity
_ (GHC.XHsDataDefn XXHsDataDefn GhcPs
_))))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for DataFamInstDecl"
  markAST SrcSpan
_ (GHC.DataFamInstDecl (GHC.HsIB XHsIB GhcPs (FamEqn GhcPs (HsDataDefn GhcPs))
_ (GHC.XFamEqn XXFamEqn GhcPs (HsDataDefn GhcPs)
_)))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for DataFamInstDecl"
  markAST SrcSpan
_ (GHC.DataFamInstDecl (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (FamEqn GhcPs (HsDataDefn GhcPs))
_))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for DataFamInstDecl"

-- ---------------------------------------------------------------------

instance Annotate (GHC.HsBind GHC.GhcPs) where
  markAST :: SrcSpan -> HsBind GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
_ (GHC.MG XMG GhcPs (Located (HsExpr GhcPs))
_ (GHC.L SrcSpan
_ [LMatch GhcPs (Located (HsExpr GhcPs))]
matches) Origin
_) HsWrapper
_ [Tickish Id]
_) = 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 :: Annotated ()
tlFun =
        Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxOnly,AstContext
CtxFirst])
          (ListContexts
-> [LMatch GhcPs (Located (HsExpr GhcPs))] -> Annotated ()
forall ast.
Annotate ast =>
ListContexts -> [Located ast] -> Annotated ()
markListWithContexts' ListContexts
listContexts [LMatch GhcPs (Located (HsExpr GhcPs))]
matches)
          (Set AstContext
-> Set AstContext
-> [LMatch GhcPs (Located (HsExpr GhcPs))]
-> Annotated ()
forall ast.
Annotate ast =>
Set AstContext -> Set AstContext -> [Located ast] -> Annotated ()
markListWithContexts (ListContexts -> Set AstContext
lcMiddle ListContexts
listContexts) (ListContexts -> Set AstContext
lcLast ListContexts
listContexts) [LMatch GhcPs (Located (HsExpr GhcPs))]
matches)
    Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
TopLevel)
      (Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
TopLevel) Int
2 Annotated ()
tlFun)
      Annotated ()
tlFun

  -- -----------------------------------

  markAST SrcSpan
_ (GHC.PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
lhs (GHC.GRHSs XCGRHSs GhcPs (Located (HsExpr GhcPs))
_ [LGRHS GhcPs (Located (HsExpr GhcPs))]
grhs (GHC.L SrcSpan
_ HsLocalBinds GhcPs
lb)) ([Tickish Id], [[Tickish Id]])
_ticks) = do
    Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
lhs
    case [LGRHS GhcPs (Located (HsExpr GhcPs))]
grhs of
      (GHC.L SrcSpan
_ (GHC.GRHS XCGRHS GhcPs (Located (HsExpr GhcPs))
_ [] Located (HsExpr GhcPs)
_):[LGRHS GhcPs (Located (HsExpr GhcPs))]
_) -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual -- empty guards
      [LGRHS GhcPs (Located (HsExpr GhcPs))]
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (LGRHS GhcPs (Located (HsExpr GhcPs)) -> Annotated ())
-> Int -> [LGRHS GhcPs (Located (HsExpr GhcPs))] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LGRHS GhcPs (Located (HsExpr GhcPs)) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LGRHS GhcPs (Located (HsExpr GhcPs))]
grhs

    -- TODO: extract this common code
    case HsLocalBinds GhcPs
lb of
      GHC.EmptyLocalBinds{} -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      HsLocalBinds GhcPs
_ -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC -- '{'
        AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markInside AnnKeywordId
GHC.AnnSemi
        HsLocalBinds GhcPs -> Annotated ()
markLocalBindsWithLayout HsLocalBinds GhcPs
lb
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC -- '}'
    Annotated ()
markTrailingSemi

  -- -----------------------------------

  markAST SrcSpan
_ (GHC.VarBind XVarBind GhcPs GhcPs
_ IdP GhcPs
_n Located (HsExpr GhcPs)
rhse Bool
_) =
    -- Note: this bind is introduced by the typechecker
    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
rhse

  -- -----------------------------------

  -- Introduced after renaming.
  markAST SrcSpan
_ (GHC.AbsBinds {}) =
    String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
"warning: AbsBinds introduced after renaming"

  -- -----------------------------------

  markAST SrcSpan
l (GHC.PatSynBind XPatSynBind GhcPs GhcPs
_ (GHC.PSB XPSB GhcPs GhcPs
_ Located (IdP GhcPs)
ln HsPatSynDetails (Located (IdP GhcPs))
args LPat GhcPs
def HsPatSynDir GhcPs
dir)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnPattern
    case HsPatSynDetails (Located (IdP GhcPs))
args of
      GHC.InfixCon Located (IdP GhcPs)
la Located (IdP GhcPs)
lb -> do
        Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
la
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
        Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
lb
      GHC.PrefixCon [Located (IdP GhcPs)]
ns -> do
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
        (Located RdrName -> Annotated ())
-> [Located RdrName] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [Located (IdP GhcPs)]
[Located RdrName]
ns
      GHC.RecCon [RecordPatSynField (Located (IdP GhcPs))]
fs -> do
        Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenC  -- '{'
        (RecordPatSynField (Located RdrName) -> Annotated ())
-> [RecordPatSynField (Located RdrName)] -> Annotated ()
forall t. (t -> Annotated ()) -> [t] -> Annotated ()
markListIntercalateWithFun (Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (Located RdrName -> Annotated ())
-> (RecordPatSynField (Located RdrName) -> Located RdrName)
-> RecordPatSynField (Located RdrName)
-> Annotated ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordPatSynField (Located RdrName) -> Located RdrName
forall a. RecordPatSynField a -> a
GHC.recordPatSynSelectorId) [RecordPatSynField (Located (IdP GhcPs))]
[RecordPatSynField (Located RdrName)]
fs
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC -- '}'
    case HsPatSynDir GhcPs
dir of
      HsPatSynDir GhcPs
GHC.ImplicitBidirectional -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
      HsPatSynDir GhcPs
_                         -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLarrow

    Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
def
    case HsPatSynDir GhcPs
dir of
      HsPatSynDir GhcPs
GHC.Unidirectional           -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      HsPatSynDir GhcPs
GHC.ImplicitBidirectional    -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      GHC.ExplicitBidirectional MatchGroup GhcPs (Located (HsExpr GhcPs))
mg -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenC  -- '{'
        SrcSpan
-> MatchGroup GhcPs (Located (HsExpr GhcPs)) -> Annotated ()
forall body.
Annotate body =>
SrcSpan -> MatchGroup GhcPs (Located body) -> Annotated ()
markMatchGroup SrcSpan
l MatchGroup GhcPs (Located (HsExpr GhcPs))
mg
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC -- '}'

    Annotated ()
markTrailingSemi

  -- -----------------------------------

  markAST SrcSpan
_ (GHC.FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
_ (GHC.XMatchGroup XXMatchGroup GhcPs (Located (HsExpr GhcPs))
_) HsWrapper
_ [Tickish Id]
_)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for HsBind"
  markAST SrcSpan
_ (GHC.PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
_ (GHC.XGRHSs XXGRHSs GhcPs (Located (HsExpr GhcPs))
_) ([Tickish Id], [[Tickish Id]])
_)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for HsBind"
  markAST SrcSpan
_ (GHC.PatSynBind XPatSynBind GhcPs GhcPs
_ (GHC.XPatSynBind XXPatSynBind GhcPs GhcPs
_))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for HsBind"
  markAST SrcSpan
_ (GHC.XHsBindsLR XXHsBindsLR GhcPs GhcPs
_)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"extension hit for HsBind"

-- ---------------------------------------------------------------------

instance Annotate (GHC.IPBind GHC.GhcPs) where
  markAST :: SrcSpan -> IPBind GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.IPBind XCIPBind GhcPs
_ Either (Located HsIPName) (IdP GhcPs)
en Located (HsExpr GhcPs)
e) = do
    case Either (Located HsIPName) (IdP GhcPs)
en of
      Left Located HsIPName
n   -> Located HsIPName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located HsIPName
n
      Right IdP GhcPs
_i -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e
    Annotated ()
markTrailingSemi

  -- markAST _ (GHC.XCIPBind x) = error $ "got XIPBind for:" ++ showGhc x
  markAST SrcSpan
_ (GHC.XIPBind XXIPBind GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XIPBind for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXIPBind GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate GHC.HsIPName where
  markAST :: SrcSpan -> HsIPName -> Annotated ()
markAST SrcSpan
l (GHC.HsIPName FastString
n) = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal (String
"?" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FastString -> String
GHC.unpackFS FastString
n)

-- ---------------------------------------------------------------------

instance (Annotate body)
  => Annotate (GHC.Match GHC.GhcPs (GHC.Located body)) where

  markAST :: SrcSpan -> Match GhcPs (Located body) -> Annotated ()
markAST SrcSpan
_ (GHC.Match XCMatch GhcPs (Located body)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
mln [LPat GhcPs]
pats (GHC.GRHSs XCGRHSs GhcPs (Located body)
_ [LGRHS GhcPs (Located body)]
grhs (GHC.L SrcSpan
_ HsLocalBinds GhcPs
lb))) = do
    let
      get_infix :: HsMatchContext id -> LexicalFixity
get_infix (GHC.FunRhs Located id
_ LexicalFixity
f SrcStrictness
_) = LexicalFixity
f
      get_infix HsMatchContext id
_                  = LexicalFixity
GHC.Prefix

      isFunBind :: HsMatchContext id -> Bool
isFunBind GHC.FunRhs{} = Bool
True
      isFunBind HsMatchContext id
_            = Bool
False
    case (HsMatchContext RdrName -> LexicalFixity
forall id. HsMatchContext id -> LexicalFixity
get_infix HsMatchContext (NameOrRdrName (IdP GhcPs))
HsMatchContext RdrName
mln,[LPat GhcPs]
[Located (Pat GhcPs)]
pats) of
      (LexicalFixity
GHC.Infix, Located (Pat GhcPs)
a:Located (Pat GhcPs)
b:[Located (Pat GhcPs)]
xs) -> do
        if [Located (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (Pat GhcPs)]
xs
          then AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenP
          else AnnKeywordId -> Annotated ()
mark         AnnKeywordId
GHC.AnnOpenP
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (Pat GhcPs)
a
        case HsMatchContext (NameOrRdrName (IdP GhcPs))
mln of
          GHC.FunRhs Located (NameOrRdrName (IdP GhcPs))
n LexicalFixity
_ SrcStrictness
_ -> Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (NameOrRdrName (IdP GhcPs))
Located RdrName
n
          HsMatchContext (NameOrRdrName (IdP GhcPs))
_              -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (Pat GhcPs)
b
        if [Located (Pat GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (Pat GhcPs)]
xs
         then AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseP
         else AnnKeywordId -> Annotated ()
mark         AnnKeywordId
GHC.AnnCloseP
        (Located (Pat GhcPs) -> Annotated ())
-> [Located (Pat GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [Located (Pat GhcPs)]
xs
      (LexicalFixity, [Located (Pat GhcPs)])
_ -> do
        [AnnKeywordId] -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
[AnnKeywordId] -> m ()
annotationsToComments [AnnKeywordId
GHC.AnnOpenP,AnnKeywordId
GHC.AnnCloseP]
        Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
LambdaExpr]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLam -- For HsLam
        case HsMatchContext (NameOrRdrName (IdP GhcPs))
mln of
          GHC.FunRhs Located (NameOrRdrName (IdP GhcPs))
n LexicalFixity
_ SrcStrictness
s -> do
            Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
NoPrecedingSpace,AstContext
PrefixOp]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
              Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SrcStrictness
s SrcStrictness -> SrcStrictness -> Bool
forall a. Eq a => a -> a -> Bool
== SrcStrictness
GHC.SrcStrict) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBang
              Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (NameOrRdrName (IdP GhcPs))
Located RdrName
n
            (Located (Pat GhcPs) -> Annotated ())
-> [Located (Pat GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LPat GhcPs]
[Located (Pat GhcPs)]
pats
          HsMatchContext (NameOrRdrName (IdP GhcPs))
_  -> Bool -> [Located (Pat GhcPs)] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
Bool -> [ast] -> Annotated ()
markListNoPrecedingSpace Bool
False [LPat GhcPs]
[Located (Pat GhcPs)]
pats

    -- TODO: The AnnEqual annotation actually belongs in the first GRHS value
    case [LGRHS GhcPs (Located body)]
grhs of
      (GHC.L SrcSpan
_ (GHC.GRHS XCGRHS GhcPs (Located body)
_ [] Located body
_):[LGRHS GhcPs (Located body)]
_) -> Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsMatchContext RdrName -> Bool
forall id. HsMatchContext id -> Bool
isFunBind HsMatchContext (NameOrRdrName (IdP GhcPs))
HsMatchContext RdrName
mln) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual -- empty guards
      [LGRHS GhcPs (Located body)]
_ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
LambdaExpr]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow -- For HsLam
    (LGRHS GhcPs (Located body) -> Annotated ())
-> [LGRHS GhcPs (Located body)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LGRHS GhcPs (Located body) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LGRHS GhcPs (Located body)]
grhs

    case HsLocalBinds GhcPs
lb of
      GHC.EmptyLocalBinds{} -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      HsLocalBinds GhcPs
_ -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC -- '{'
        AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markInside AnnKeywordId
GHC.AnnSemi
        HsLocalBinds GhcPs -> Annotated ()
markLocalBindsWithLayout HsLocalBinds GhcPs
lb
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC -- '}'
    Annotated ()
markTrailingSemi

  -- -----------------------------------

  markAST SrcSpan
_ (GHC.Match XCMatch GhcPs (Located body)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
_ [LPat GhcPs]
_ (GHC.XGRHSs XXGRHSs GhcPs (Located body)
_))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"hit extension for Match"
  markAST SrcSpan
_ (GHC.XMatch XXMatch GhcPs (Located body)
_)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"hit extension for Match"

-- ---------------------------------------------------------------------

instance (Annotate body)
  => Annotate (GHC.GRHS GHC.GhcPs (GHC.Located body)) where
  markAST :: SrcSpan -> GRHS GhcPs (Located body) -> Annotated ()
markAST SrcSpan
_ (GHC.GRHS XCGRHS GhcPs (Located body)
_ [GuardLStmt GhcPs]
guards Located body
expr) = do
    case [GuardLStmt GhcPs]
guards of
      [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (GuardLStmt GhcPs
_:[GuardLStmt GhcPs]
_) -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
        AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
LeftMost,AstContext
PrefixOp])
          (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [GuardLStmt GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [GuardLStmt GhcPs]
guards
        Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CaseAlt])
          (() -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          (AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual)

    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnEqual -- For apply-refact Structure8.hs test

    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CaseAlt]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow -- For HsLam
    Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
LeftMost,AstContext
PrefixOp]) Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located body -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located body
expr

  markAST SrcSpan
_ (GHC.XGRHS XXGRHS GhcPs (Located body)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XGRHS for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXGRHS GhcPs (Located body)
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.Sig GHC.GhcPs) where

  markAST :: SrcSpan -> Sig GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.TypeSig XTypeSig GhcPs
_ [Located (IdP GhcPs)]
lns LHsSigWcType GhcPs
st)  = do
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Bool -> [Located RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
Bool -> [ast] -> Annotated ()
markListNoPrecedingSpace Bool
True [Located (IdP GhcPs)]
[Located RdrName]
lns
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    LHsSigWcType GhcPs -> Annotated ()
markLHsSigWcType LHsSigWcType GhcPs
st
    Annotated ()
markTrailingSemi
    Set AstContext -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> m ()
tellContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
FollowingLine)

  markAST SrcSpan
_ (GHC.PatSynSig XPatSynSig GhcPs
_ [Located (IdP GhcPs)]
lns (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
typ)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnPattern
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [Located RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located (IdP GhcPs)]
[Located RdrName]
lns
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.ClassOpSig XClassOpSig GhcPs
_ Bool
isDefault [Located (IdP GhcPs)]
ns (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
typ)) = do
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isDefault (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDefault
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [Located RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located (IdP GhcPs)]
[Located RdrName]
ns
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.IdSig {}) =
    String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
"warning: Introduced after renaming"

  markAST SrcSpan
_ (GHC.FixSig XFixSig GhcPs
_ (GHC.FixitySig XFixitySig GhcPs
_ [Located (IdP GhcPs)]
lns (GHC.Fixity SourceText
src Int
v FixityDirection
fdir))) = do
    let fixstr :: String
fixstr = case FixityDirection
fdir of
         FixityDirection
GHC.InfixL -> String
"infixl"
         FixityDirection
GHC.InfixR -> String
"infixr"
         FixityDirection
GHC.InfixN -> String
"infix"
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnInfix String
fixstr
    SourceText -> String -> Annotated ()
markSourceText SourceText
src (Int -> String
forall a. Show a => a -> String
show Int
v)
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [Located RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located (IdP GhcPs)]
[Located RdrName]
lns
    Annotated ()
markTrailingSemi

  markAST SrcSpan
l (GHC.InlineSig XInlineSig GhcPs
_ Located (IdP GhcPs)
ln InlinePragma
inl) = do
    SourceText -> String -> Annotated ()
markAnnOpen (InlinePragma -> SourceText
GHC.inl_src InlinePragma
inl) String
"{-# INLINE"
    SrcSpan -> Activation -> Annotated ()
markActivation SrcSpan
l (InlinePragma -> Activation
GHC.inl_act InlinePragma
inl)
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}" -- '#-}'
    Annotated ()
markTrailingSemi

  markAST SrcSpan
l (GHC.SpecSig XSpecSig GhcPs
_ Located (IdP GhcPs)
ln [LHsSigType GhcPs]
typs InlinePragma
inl) = do
    SourceText -> String -> Annotated ()
markAnnOpen (InlinePragma -> SourceText
GHC.inl_src InlinePragma
inl) String
"{-# SPECIALISE" -- Note: may be {-# SPECIALISE_INLINE
    SrcSpan -> Activation -> Annotated ()
markActivation SrcSpan
l (InlinePragma -> Activation
GHC.inl_act InlinePragma
inl)
    Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon -- '::'
    (LHsSigType GhcPs -> Annotated ())
-> Int -> [LHsSigType GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LHsSigType GhcPs -> Annotated ()
markLHsSigType Int
2 [LHsSigType GhcPs]
typs
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}" -- '#-}'
    Annotated ()
markTrailingSemi


  markAST SrcSpan
_ (GHC.SpecInstSig XSpecInstSig GhcPs
_ SourceText
src LHsSigType GhcPs
typ) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# SPECIALISE"
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnInstance
    LHsSigType GhcPs -> Annotated ()
markLHsSigType LHsSigType GhcPs
typ
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}" -- '#-}'
    Annotated ()
markTrailingSemi


  markAST SrcSpan
_ (GHC.MinimalSig XMinimalSig GhcPs
_ SourceText
src LBooleanFormula (Located (IdP GhcPs))
formula) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# MINIMAL"
    LBooleanFormula (Located RdrName) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LBooleanFormula (Located (IdP GhcPs))
LBooleanFormula (Located RdrName)
formula
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.SCCFunSig XSCCFunSig GhcPs
_ SourceText
src Located (IdP GhcPs)
ln Maybe (Located StringLiteral)
ml) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# SCC"
    Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    Maybe (Located StringLiteral) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (Located StringLiteral)
ml
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.CompleteMatchSig XCompleteMatchSig GhcPs
_ SourceText
src (GHC.L SrcSpan
_ [Located (IdP GhcPs)]
ns) Maybe (Located (IdP GhcPs))
mlns) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src String
"{-# COMPLETE"
    [Located RdrName] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located (IdP GhcPs)]
[Located RdrName]
ns
    case Maybe (Located (IdP GhcPs))
mlns of
      Maybe (Located (IdP GhcPs))
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Located (IdP GhcPs)
_ -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
        Maybe (Located RdrName) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (Located (IdP GhcPs))
Maybe (Located RdrName)
mlns
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}" -- '#-}'
    Annotated ()
markTrailingSemi

  -- -----------------------------------
  markAST SrcSpan
_ (GHC.PatSynSig XPatSynSig GhcPs
_ [Located (IdP GhcPs)]
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
_))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"hit extension for Sig"
  markAST SrcSpan
_ (GHC.ClassOpSig XClassOpSig GhcPs
_ Bool
_ [Located (IdP GhcPs)]
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
_))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"hit extension for Sig"
  markAST SrcSpan
_ (GHC.FixSig XFixSig GhcPs
_ (GHC.XFixitySig XXFixitySig GhcPs
_))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"hit extension for Sig"
  markAST SrcSpan
_ (GHC.XSig XXSig GhcPs
_)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"hit extension for Sig"

-- ---------------------------------------------------------------------

instance Annotate (GHC.StandaloneKindSig GHC.GhcPs) where

  markAST :: SrcSpan -> StandaloneKindSig GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.StandaloneKindSig XStandaloneKindSig GhcPs
_ Located (IdP GhcPs)
ln LHsSigType GhcPs
st)  = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    LHsSigType GhcPs -> Annotated ()
markLHsSigType LHsSigType GhcPs
st
    Annotated ()
markTrailingSemi
    Set AstContext -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> m ()
tellContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
FollowingLine)

  markAST SrcSpan
_ (GHC.XStandaloneKindSig XXStandaloneKindSig GhcPs
_)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"hit extension for StandaloneKindSig"

-- --------------------------------------------------------------------

markLHsSigType :: GHC.LHsSigType GHC.GhcPs -> Annotated ()
markLHsSigType :: LHsSigType GhcPs -> Annotated ()
markLHsSigType (GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
typ) = LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
markLHsSigType (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (LHsType GhcPs)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XHsImplicitBndrs for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXHsImplicitBndrs GhcPs (LHsType GhcPs)
x

instance Annotate [GHC.LHsSigType GHC.GhcPs] where
  markAST :: SrcSpan -> [LHsSigType GhcPs] -> Annotated ()
markAST SrcSpan
_ [LHsSigType GhcPs]
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.
    let marker :: AnnKeywordId -> Annotated ()
marker = case [LHsSigType GhcPs]
ls of
          []  -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional
          [GHC.HsIB XHsIB GhcPs (LHsType GhcPs)
_ LHsType GhcPs
t] -> if PprPrec -> HsType GhcPs -> Bool
forall pass. PprPrec -> HsType pass -> Bool
GHC.hsTypeNeedsParens PprPrec
GHC.appPrec (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc LHsType GhcPs
t)
                           then AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany
                           else AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional
          [LHsSigType GhcPs]
_   -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany -- Need parens if more than one entry
    AnnKeywordId -> Annotated ()
marker AnnKeywordId
GHC.AnnOpenP
    (LHsSigType GhcPs -> Annotated ())
-> [LHsSigType GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> [t] -> Annotated ()
markListIntercalateWithFun LHsSigType GhcPs -> Annotated ()
markLHsSigType [LHsSigType GhcPs]
ls
    AnnKeywordId -> Annotated ()
marker AnnKeywordId
GHC.AnnCloseP

-- --------------------------------------------------------------------

instance  (Annotate name) => Annotate (GHC.BooleanFormula (GHC.Located name)) where
  markAST :: SrcSpan -> BooleanFormula (Located name) -> Annotated ()
markAST SrcSpan
_ (GHC.Var Located name
x)  = do
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located name -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located name
x
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
AddVbar]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
  markAST SrcSpan
_ (GHC.Or [LBooleanFormula (Located name)]
ls)  = (LBooleanFormula (Located name) -> Annotated ())
-> Int
-> AstContext
-> [LBooleanFormula (Located name)]
-> Annotated ()
forall t.
(t -> Annotated ()) -> Int -> AstContext -> [t] -> Annotated ()
markListIntercalateWithFunLevelCtx LBooleanFormula (Located name) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 AstContext
AddVbar [LBooleanFormula (Located name)]
ls
  markAST SrcSpan
_ (GHC.And [LBooleanFormula (Located name)]
ls) = do
    (LBooleanFormula (Located name) -> Annotated ())
-> Int -> [LBooleanFormula (Located name)] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LBooleanFormula (Located name) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LBooleanFormula (Located name)]
ls
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
AddVbar]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
  markAST SrcSpan
_ (GHC.Parens LBooleanFormula (Located name)
x)  = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP -- '('
    LBooleanFormula (Located name) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LBooleanFormula (Located name)
x
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
AddVbar]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma

-- ---------------------------------------------------------------------

instance Annotate (GHC.HsTyVarBndr GHC.GhcPs) where
  markAST :: SrcSpan -> HsTyVarBndr GhcPs -> Annotated ()
markAST SrcSpan
_l (GHC.UserTyVar XUserTyVar GhcPs
_ Located (IdP GhcPs)
n) = do
    Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
n

  markAST SrcSpan
_ (GHC.KindedTyVar XKindedTyVar GhcPs
_ Located (IdP GhcPs)
n LHsType GhcPs
ty) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP  -- '('
    Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
n
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon -- '::'
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
ty
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- '('

  markAST SrcSpan
_l (GHC.XTyVarBndr XXTyVarBndr GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XTyVarBndr for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXTyVarBndr GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.HsType GHC.GhcPs) where
  markAST :: SrcSpan -> HsType GhcPs -> Annotated ()
markAST SrcSpan
loc HsType GhcPs
ty = do
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
InTypeApp]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnAt
    SrcSpan -> HsType GhcPs -> Annotated ()
markType SrcSpan
loc HsType GhcPs
ty
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
    (Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
AddVbar) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar)
   where

    -- markType :: GHC.SrcSpan -> ast -> Annotated ()
    markType :: GHC.SrcSpan -> (GHC.HsType GHC.GhcPs) -> Annotated ()
    markType :: SrcSpan -> HsType GhcPs -> Annotated ()
markType SrcSpan
_ (GHC.HsForAllTy XForAllTy GhcPs
_ ForallVisFlag
fvf [LHsTyVarBndr GhcPs]
tvs LHsType GhcPs
typ) = do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnForall
      (LHsTyVarBndr GhcPs -> Annotated ())
-> [LHsTyVarBndr GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsTyVarBndr GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsTyVarBndr GhcPs]
tvs
      case ForallVisFlag
fvf of
        ForallVisFlag
GHC.ForallInvis -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDot
        ForallVisFlag
GHC.ForallVis   -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ

    markType SrcSpan
_ (GHC.HsQualTy XQualTy GhcPs
_ LHsContext GhcPs
cxt LHsType GhcPs
typ) = do
      LHsContext GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsContext GhcPs
cxt
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ

    markType SrcSpan
_ (GHC.HsTyVar XTyVar GhcPs
_ PromotionFlag
promoted Located (IdP GhcPs)
name) = do
      Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PromotionFlag
promoted PromotionFlag -> PromotionFlag -> Bool
forall a. Eq a => a -> a -> Bool
== PromotionFlag
GHC.IsPromoted) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnSimpleQuote
      AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
InfixOp (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
name

    markType SrcSpan
_ (GHC.HsAppTy XAppTy GhcPs
_ LHsType GhcPs
t1 LHsType GhcPs
t2) = do
      Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t1
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t2

    markType SrcSpan
_ (GHC.HsAppKindTy XAppKindTy GhcPs
l LHsType GhcPs
t LHsType GhcPs
k) = do
      Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp)  (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t
      SrcSpan -> Annotated ()
markTypeApp XAppKindTy GhcPs
SrcSpan
l
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
k

    markType SrcSpan
_ (GHC.HsFunTy XFunTy GhcPs
_ LHsType GhcPs
t1 LHsType GhcPs
t2) = do
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t1
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t2
      -- markManyOptional GHC.AnnCloseP -- For trailing parens after res_ty in ConDeclGADT

    markType SrcSpan
_ (GHC.HsListTy XListTy GhcPs
_ LHsType GhcPs
t) = do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS -- '['
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'

    markType SrcSpan
_ (GHC.HsTupleTy XTupleTy GhcPs
_ HsTupleSort
tt [LHsType GhcPs]
ts) = do
      case HsTupleSort
tt  of
        HsTupleSort
GHC.HsBoxedOrConstraintTuple -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP  -- '('
        HsTupleSort
_                            -> AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
"(#" -- '(#'
      (LHsType GhcPs -> Annotated ())
-> Int -> [LHsType GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LHsType GhcPs]
ts
      case HsTupleSort
tt  of
        HsTupleSort
GHC.HsBoxedOrConstraintTuple -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP  -- ')'
        HsTupleSort
_                            -> AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#)" -- '#)'

    markType SrcSpan
_ (GHC.HsSumTy XSumTy GhcPs
_ [LHsType GhcPs]
tys) = do
      AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
"(#"
      (LHsType GhcPs -> Annotated ())
-> Int -> AstContext -> [LHsType GhcPs] -> Annotated ()
forall t.
(t -> Annotated ()) -> Int -> AstContext -> [t] -> Annotated ()
markListIntercalateWithFunLevelCtx LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 AstContext
AddVbar [LHsType GhcPs]
tys
      AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#)"

    markType SrcSpan
_ (GHC.HsOpTy XOpTy GhcPs
_ LHsType GhcPs
t1 Located (IdP GhcPs)
lo LHsType GhcPs
t2) = do
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t1
      if (OccName -> Bool
GHC.isTcOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
forall name. HasOccName name => name -> OccName
GHC.occName (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc Located (IdP GhcPs)
Located RdrName
lo)
        then do
          AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnSimpleQuote
        else do
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnSimpleQuote
      AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
PrefixOp (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
lo
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t2

    markType SrcSpan
_ (GHC.HsParTy XParTy GhcPs
_ LHsType GhcPs
t) = do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP  -- '('
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'

    markType SrcSpan
_ (GHC.HsIParamTy XIParamTy GhcPs
_ Located HsIPName
n LHsType GhcPs
t) = do
      Located HsIPName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located HsIPName
n
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t

    markType SrcSpan
l (GHC.HsStarTy XStarTy GhcPs
_ Bool
isUnicode) = do
      if Bool
isUnicode
        then SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"\x2605" -- Unicode star
        else SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"*"

    markType SrcSpan
_ (GHC.HsKindSig XKindSig GhcPs
_ LHsType GhcPs
t LHsType GhcPs
k) = do
      AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenP  -- '('
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon -- '::'
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
k
      AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseP -- ')'

    markType SrcSpan
l (GHC.HsSpliceTy XSpliceTy GhcPs
_ HsSplice GhcPs
s) = do
      SrcSpan -> HsSplice GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsSplice GhcPs
s

    markType SrcSpan
_ (GHC.HsDocTy XDocTy GhcPs
_ LHsType GhcPs
t LHsDocString
ds) = do
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t
      LHsDocString -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsDocString
ds

    markType SrcSpan
_ (GHC.HsBangTy XBangTy GhcPs
_ (GHC.HsSrcBang SourceText
mt SrcUnpackedness
_up SrcStrictness
str) LHsType GhcPs
t) = do
      case SourceText
mt of
        SourceText
GHC.NoSourceText -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        GHC.SourceText String
src -> do
          AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
src
          AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#-}"
      case SrcStrictness
str of
        SrcStrictness
GHC.SrcLazy     -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnTilde
        SrcStrictness
GHC.SrcStrict   -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBang
        SrcStrictness
GHC.NoSrcStrict -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
t

    markType SrcSpan
_ (GHC.HsRecTy XRecTy GhcPs
_ [LConDeclField GhcPs]
cons) = do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenC  -- '{'
      [LConDeclField GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LConDeclField GhcPs]
cons
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC -- '}'

    markType SrcSpan
_ (GHC.HsExplicitListTy XExplicitListTy GhcPs
_ PromotionFlag
promoted [LHsType GhcPs]
ts) = do
      Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PromotionFlag
promoted PromotionFlag -> PromotionFlag -> Bool
forall a. Eq a => a -> a -> Bool
== PromotionFlag
GHC.IsPromoted) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnSimpleQuote
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS  -- "["
      [LHsType GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LHsType GhcPs]
ts
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'

    markType SrcSpan
_ (GHC.HsExplicitTupleTy XExplicitTupleTy GhcPs
_ [LHsType GhcPs]
ts) = do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnSimpleQuote
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP
      [LHsType GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LHsType GhcPs]
ts
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

    markType SrcSpan
l (GHC.HsTyLit XTyLit GhcPs
_ HsTyLit
lit) = do
      case HsTyLit
lit of
        (GHC.HsNumTy SourceText
s Integer
v) ->
          SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
s (Integer -> String
forall a. Show a => a -> String
show Integer
v)
        (GHC.HsStrTy SourceText
s FastString
v) ->
          SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
s (FastString -> String
forall a. Show a => a -> String
show FastString
v)

    markType SrcSpan
l (GHC.HsWildCardTy XWildCardTy GhcPs
_) = do
      SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"_"

    markType SrcSpan
_ (GHC.XHsType XXType GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XHsType for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NewHsTypeX -> String
forall a. Outputable a => a -> String
showGhc NewHsTypeX
XXType GhcPs
x


-- ---------------------------------------------------------------------

-- instance Annotate (GHC.HsAppType GHC.GhcPs) where
--   markAST _ (GHC.HsAppInfix _ n)  = do
--     when (GHC.isDataOcc $ GHC.occName $ GHC.unLoc n) $ mark GHC.AnnSimpleQuote
--     setContext (Set.singleton InfixOp) $ markLocated n
--   markAST _ (GHC.HsAppPrefix _ t) = do
--     markOptional GHC.AnnTilde
--     setContext (Set.singleton PrefixOp) $ markLocated t

-- ---------------------------------------------------------------------

instance Annotate (GHC.HsSplice GHC.GhcPs) where
  markAST :: SrcSpan -> HsSplice GhcPs -> Annotated ()
markAST SrcSpan
l HsSplice GhcPs
c =
    case HsSplice GhcPs
c of
      GHC.HsQuasiQuote XQuasiQuote GhcPs
_ IdP GhcPs
_ IdP GhcPs
n SrcSpan
_pos FastString
fs -> do
        SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal
              -- Note: Lexer.x does not provide unicode alternative. 2017-02-26
              (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (RdrName -> String
forall a. Outputable a => a -> String
showGhc IdP GhcPs
RdrName
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (FastString -> String
GHC.unpackFS FastString
fs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|]")

      GHC.HsTypedSplice XTypedSplice GhcPs
_ SpliceDecoration
hasParens IdP GhcPs
_n b :: Located (HsExpr GhcPs)
b@(GHC.L SrcSpan
_ (GHC.HsVar XVar GhcPs
_ (GHC.L SrcSpan
_ IdP GhcPs
n)))  -> do
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasParens) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenPTE
        if (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasDollar)
          then AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnThIdTySplice (String
"$$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (OccName -> String
GHC.occNameString (RdrName -> OccName
forall name. HasOccName name => name -> OccName
GHC.occName IdP GhcPs
RdrName
n)))
          else Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
b
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasParens) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

      GHC.HsTypedSplice XTypedSplice GhcPs
_ SpliceDecoration
hasParens IdP GhcPs
_n Located (HsExpr GhcPs)
b -> do
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasParens) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenPTE
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
b
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasParens) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

      -- -------------------------------

      GHC.HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
hasParens IdP GhcPs
_n b :: Located (HsExpr GhcPs)
b@(GHC.L SrcSpan
_ (GHC.HsVar XVar GhcPs
_ (GHC.L SrcSpan
_ IdP GhcPs
n)))  -> do
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasParens) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$  AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenPE
        if (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasDollar)
          then AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnThIdSplice (String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (OccName -> String
GHC.occNameString (RdrName -> OccName
forall name. HasOccName name => name -> OccName
GHC.occName IdP GhcPs
RdrName
n)))
          else Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
b
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasParens) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

      GHC.HsUntypedSplice XUntypedSplice GhcPs
_ SpliceDecoration
hasParens IdP GhcPs
_n Located (HsExpr GhcPs)
b  -> do
        case SpliceDecoration
hasParens of
          SpliceDecoration
GHC.HasParens -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenPE
          SpliceDecoration
GHC.HasDollar -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThIdSplice
          SpliceDecoration
GHC.NoParens  -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
b
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SpliceDecoration
hasParens SpliceDecoration -> SpliceDecoration -> Bool
forall a. Eq a => a -> a -> Bool
== SpliceDecoration
GHC.HasParens) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

      GHC.HsSpliced{}  -> String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"HsSpliced only exists between renamer and typechecker in GHC"
      GHC.HsSplicedT{} -> String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"HsSplicedT only exists between renamer and typechecker in GHC"

      -- -------------------------------

      (GHC.XSplice XXSplice GhcPs
x) -> String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XSplice for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXSplice GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.ConDeclField GHC.GhcPs) where
  markAST :: SrcSpan -> ConDeclField GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.ConDeclField XConDeclField GhcPs
_ [LFieldOcc GhcPs]
ns LHsType GhcPs
ty Maybe LHsDocString
mdoc) = do
    AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      [LFieldOcc GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LFieldOcc GhcPs]
ns
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
ty
      Maybe LHsDocString -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe LHsDocString
mdoc
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma

  markAST SrcSpan
_ (GHC.XConDeclField XXConDeclField GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XConDeclField for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXConDeclField GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate (GHC.FieldOcc GHC.GhcPs) where
  markAST :: SrcSpan -> FieldOcc GhcPs -> Annotated ()
markAST SrcSpan
_ (GHC.FieldOcc XCFieldOcc GhcPs
_ Located RdrName
rn) = do
    Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
rn
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma

  markAST SrcSpan
_ (GHC.XFieldOcc XXFieldOcc GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XFieldOcc for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXFieldOcc GhcPs
x

-- ---------------------------------------------------------------------

instance Annotate GHC.HsDocString where
  markAST :: SrcSpan -> HsDocString -> Annotated ()
markAST SrcSpan
l HsDocString
s = do
    SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal (HsDocString -> String
GHC.unpackHDS HsDocString
s)

-- ---------------------------------------------------------------------

instance Annotate (GHC.Pat GHC.GhcPs) where
  markAST :: SrcSpan -> Pat GhcPs -> Annotated ()
markAST SrcSpan
loc Pat GhcPs
typ = do
    SrcSpan -> Pat GhcPs -> Annotated ()
markPat SrcSpan
loc Pat GhcPs
typ
    Set AstContext -> Annotated () -> Annotated ()
inContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Intercalate]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma Annotated () -> String -> Annotated ()
forall c. c -> String -> c
`debug` (String
"AnnComma in Pat")
    where
      markPat :: SrcSpan -> Pat GhcPs -> Annotated ()
markPat SrcSpan
l (GHC.WildPat XWildPat GhcPs
_) = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
"_"
      markPat SrcSpan
l (GHC.VarPat XVarPat GhcPs
_ Located (IdP GhcPs)
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 :: String
pun_RDR = String
"pun-right-hand-side"
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Located RdrName -> String
forall a. Outputable a => a -> String
showGhc Located (IdP GhcPs)
Located RdrName
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
pun_RDR) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$
          AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc Located (IdP GhcPs)
Located RdrName
n)
          -- unsetContext Intercalate $ setContext (Set.singleton PrefixOp) $ markLocated n
      markPat SrcSpan
_ (GHC.LazyPat XLazyPat GhcPs
_ LPat GhcPs
p) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnTilde
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
p

      markPat SrcSpan
_ (GHC.AsPat XAsPat GhcPs
_ Located (IdP GhcPs)
ln LPat GhcPs
p) = do
        Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnAt
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
p

      markPat SrcSpan
_ (GHC.ParPat XParPat GhcPs
_ LPat GhcPs
p) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
p
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP

      markPat SrcSpan
_ (GHC.BangPat XBangPat GhcPs
_ LPat GhcPs
p) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBang
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
p

      markPat SrcSpan
_ (GHC.ListPat XListPat GhcPs
_ [LPat GhcPs]
ps) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS
        (Located (Pat GhcPs) -> Annotated ())
-> Int -> [Located (Pat GhcPs)] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LPat GhcPs]
[Located (Pat GhcPs)]
ps
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS

      markPat SrcSpan
_ (GHC.TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
pats Boxity
b) = do
        if Boxity
b Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
GHC.Boxed then AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP
                          else AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
"(#"
        (Located (Pat GhcPs) -> Annotated ())
-> Int -> [Located (Pat GhcPs)] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LPat GhcPs]
[Located (Pat GhcPs)]
pats
        if Boxity
b Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
GHC.Boxed then AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP
                          else AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#)"

      markPat SrcSpan
_ (GHC.SumPat XSumPat GhcPs
_ LPat GhcPs
pat Int
alt Int
arity) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
"(#"
        Int -> Annotated () -> Annotated ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
pat
        Int -> Annotated () -> Annotated ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
"#)"

      markPat SrcSpan
_ (GHC.ConPatIn Located (IdP GhcPs)
n HsConPatDetails GhcPs
dets) = do
        Located RdrName -> HsConPatDetails GhcPs -> Annotated ()
markHsConPatDetails Located (IdP GhcPs)
Located RdrName
n HsConPatDetails GhcPs
dets

      markPat SrcSpan
_ GHC.ConPatOut {} =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
"warning: ConPatOut Introduced after renaming"

      markPat SrcSpan
_ (GHC.ViewPat XViewPat GhcPs
_ Located (HsExpr GhcPs)
e LPat GhcPs
pat) = do
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
pat

      markPat SrcSpan
l (GHC.SplicePat XSplicePat GhcPs
_ HsSplice GhcPs
s) = do
        SrcSpan -> HsSplice GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsSplice GhcPs
s

      markPat SrcSpan
l (GHC.LitPat XLitPat GhcPs
_ HsLit GhcPs
lp) = SrcSpan -> HsLit GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsLit GhcPs
lp

      markPat SrcSpan
_ (GHC.NPat XNPat GhcPs
_ Located (HsOverLit GhcPs)
ol Maybe (SyntaxExpr GhcPs)
mn SyntaxExpr GhcPs
_) = do
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (SyntaxExpr GhcPs) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (SyntaxExpr GhcPs)
mn) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnMinus
        Located (HsOverLit GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsOverLit GhcPs)
ol

      markPat SrcSpan
_ (GHC.NPlusKPat XNPlusKPat GhcPs
_ Located (IdP GhcPs)
ln Located (HsOverLit GhcPs)
ol HsOverLit GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
        Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
ln
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnVal String
"+"  -- "+"
        Located (HsOverLit GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsOverLit GhcPs)
ol


      markPat SrcSpan
_ (GHC.SigPat XSigPat GhcPs
_ LPat GhcPs
pat LHsSigWcType (NoGhcTc GhcPs)
ty) = do
        Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
pat
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
        LHsSigWcType GhcPs -> Annotated ()
markLHsSigWcType LHsSigWcType GhcPs
LHsSigWcType (NoGhcTc GhcPs)
ty

      markPat SrcSpan
_ GHC.CoPat {} =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
"warning: CoPat introduced after renaming"

      -- markPat _ (GHC.XPat (GHC.L l p)) = markPat l p
      markPat SrcSpan
_ (GHC.XPat XXPat GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XPat for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXPat GhcPs
x

-- ---------------------------------------------------------------------

hsLit2String :: GHC.HsLit GHC.GhcPs -> String
hsLit2String :: HsLit GhcPs -> String
hsLit2String HsLit GhcPs
lit =
  case HsLit GhcPs
lit of
    GHC.HsChar       XHsChar GhcPs
src Char
v   -> SourceText -> Char -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsChar GhcPs
SourceText
src Char
v String
""
    -- It should be included here
    -- https://github.com/ghc/ghc/blob/master/compiler/parser/Lexer.x#L1471
    GHC.HsCharPrim   XHsCharPrim GhcPs
src Char
p   -> SourceText -> Char -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsCharPrim GhcPs
SourceText
src Char
p String
"#"
    GHC.HsString     XHsString GhcPs
src FastString
v   -> SourceText -> FastString -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsString GhcPs
SourceText
src FastString
v String
""
    GHC.HsStringPrim XHsStringPrim GhcPs
src ByteString
v   -> SourceText -> ByteString -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsStringPrim GhcPs
SourceText
src ByteString
v String
""
    GHC.HsInt        XHsInt GhcPs
_ (GHC.IL SourceText
src Bool
_ Integer
v)   -> SourceText -> Integer -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix SourceText
src Integer
v String
""
    GHC.HsIntPrim    XHsIntPrim GhcPs
src Integer
v   -> SourceText -> Integer -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsIntPrim GhcPs
SourceText
src Integer
v String
""
    GHC.HsWordPrim   XHsWordPrim GhcPs
src Integer
v   -> SourceText -> Integer -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsWordPrim GhcPs
SourceText
src Integer
v String
""
    GHC.HsInt64Prim  XHsInt64Prim GhcPs
src Integer
v   -> SourceText -> Integer -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsInt64Prim GhcPs
SourceText
src Integer
v String
""
    GHC.HsWord64Prim XHsWord64Prim GhcPs
src Integer
v   -> SourceText -> Integer -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsWord64Prim GhcPs
SourceText
src Integer
v String
""
    GHC.HsInteger    XHsInteger GhcPs
src Integer
v Type
_ -> SourceText -> Integer -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix XHsInteger GhcPs
SourceText
src Integer
v String
""
    GHC.HsRat        XHsRat GhcPs
_ (GHC.FL SourceText
src Bool
_ Rational
v) Type
_ -> SourceText -> Rational -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix SourceText
src Rational
v String
""
    GHC.HsFloatPrim  XHsFloatPrim GhcPs
_ (GHC.FL SourceText
src Bool
_ Rational
v)   -> SourceText -> Rational -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix SourceText
src Rational
v String
"#"
    GHC.HsDoublePrim XHsDoublePrim GhcPs
_ (GHC.FL SourceText
src Bool
_ Rational
v)   -> SourceText -> Rational -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix SourceText
src Rational
v String
"##"
    (GHC.XLit XXLit GhcPs
x) -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"got XLit for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXLit GhcPs
x

toSourceTextWithSuffix :: (Show a) => GHC.SourceText -> a -> String -> String
toSourceTextWithSuffix :: SourceText -> a -> String -> String
toSourceTextWithSuffix (SourceText
GHC.NoSourceText)    a
alt String
suffix = a -> String
forall a. Show a => a -> String
show a
alt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
toSourceTextWithSuffix (GHC.SourceText String
txt) a
_alt String
suffix = String
txt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix

-- --------------------------------------------------------------------

markHsConPatDetails :: GHC.Located GHC.RdrName -> GHC.HsConPatDetails GHC.GhcPs -> Annotated ()
markHsConPatDetails :: Located RdrName -> HsConPatDetails GhcPs -> Annotated ()
markHsConPatDetails Located RdrName
ln HsConPatDetails GhcPs
dets = do
  case HsConPatDetails GhcPs
dets of
    GHC.PrefixCon [LPat GhcPs]
args -> do
      Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
ln
      (Located (Pat GhcPs) -> Annotated ())
-> [Located (Pat GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LPat GhcPs]
[Located (Pat GhcPs)]
args
    GHC.RecCon (GHC.HsRecFields [LHsRecField GhcPs (LPat GhcPs)]
fs Maybe (Located Int)
dd) -> do
      Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
ln
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenC -- '{'
      case Maybe (Located Int)
dd of
        Maybe (Located Int)
Nothing ->  (LHsRecField GhcPs (Located (Pat GhcPs)) -> Annotated ())
-> Int -> [LHsRecField GhcPs (Located (Pat GhcPs))] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LHsRecField GhcPs (Located (Pat GhcPs)) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Int
2 [LHsRecField GhcPs (LPat GhcPs)]
[LHsRecField GhcPs (Located (Pat GhcPs))]
fs
        Just Located Int
_ -> do
          Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (LHsRecField GhcPs (Located (Pat GhcPs)) -> Annotated ())
-> [LHsRecField GhcPs (Located (Pat GhcPs))] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsRecField GhcPs (Located (Pat GhcPs)) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsRecField GhcPs (LPat GhcPs)]
[LHsRecField GhcPs (Located (Pat GhcPs))]
fs
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC -- '}'
    GHC.InfixCon LPat GhcPs
a1 LPat GhcPs
a2 -> do
      Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
a1
      AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
PrefixOp (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
ln
      Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
a2

markHsConDeclDetails ::
  Bool -> Bool -> [GHC.Located GHC.RdrName] -> GHC.HsConDeclDetails GHC.GhcPs -> Annotated ()

markHsConDeclDetails :: Bool
-> Bool
-> [Located RdrName]
-> HsConDeclDetails GhcPs
-> Annotated ()
markHsConDeclDetails Bool
isDeprecated Bool
inGadt [Located RdrName]
lns HsConDeclDetails GhcPs
dets = do
  case HsConDeclDetails GhcPs
dets of
    GHC.PrefixCon [LHsType GhcPs]
args ->
      Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (LHsType GhcPs -> Annotated ()) -> [LHsType GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsType GhcPs]
args
    -- GHC.RecCon fs -> markLocated fs
    GHC.RecCon Located [LConDeclField GhcPs]
fs -> do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenC
      if Bool
inGadt
        then do
          if Bool
isDeprecated
            then Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
InGadt]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located [LConDeclField GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located [LConDeclField GhcPs]
fs
            else Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
InGadt,AstContext
InRecCon]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located [LConDeclField GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located [LConDeclField GhcPs]
fs
        else do
          if Bool
isDeprecated
            then Located [LConDeclField GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located [LConDeclField GhcPs]
fs
            else Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
InRecCon]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located [LConDeclField GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located [LConDeclField GhcPs]
fs
    GHC.InfixCon LHsType GhcPs
a1 LHsType GhcPs
a2 -> do
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
a1
      Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (Located RdrName -> Annotated ())
-> [Located RdrName] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [Located RdrName]
lns
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
a2

-- ---------------------------------------------------------------------

instance Annotate [GHC.LConDeclField GHC.GhcPs] where
  markAST :: SrcSpan -> [LConDeclField GhcPs] -> Annotated ()
markAST SrcSpan
_ [LConDeclField GhcPs]
fs = do
       AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC -- '{'
       [LConDeclField GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LConDeclField GhcPs]
fs
       AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnDotdot
       Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InRecCon) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC -- '}'
       Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InGadt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
         AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow

-- ---------------------------------------------------------------------

instance Annotate (GHC.HsOverLit GHC.GhcPs) where
  markAST :: SrcSpan -> HsOverLit GhcPs -> Annotated ()
markAST SrcSpan
l HsOverLit GhcPs
ol =
    let str :: SourceText
str = case HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
GHC.ol_val HsOverLit GhcPs
ol of
                GHC.HsIntegral   (GHC.IL SourceText
src Bool
_ Integer
_) -> SourceText
src
                GHC.HsFractional (GHC.FL SourceText
src Bool
_ Rational
_) -> SourceText
src
                GHC.HsIsString SourceText
src FastString
_ -> SourceText
src
    in
    SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
str String
""

-- ---------------------------------------------------------------------

instance (Annotate arg)
    => Annotate (GHC.HsImplicitBndrs GHC.GhcPs (GHC.Located arg)) where
  markAST :: SrcSpan -> HsImplicitBndrs GhcPs (Located arg) -> Annotated ()
markAST SrcSpan
_ (GHC.HsIB XHsIB GhcPs (Located arg)
_ Located arg
thing) = do
    Located arg -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located arg
thing
  markAST SrcSpan
_ (GHC.XHsImplicitBndrs XXHsImplicitBndrs GhcPs (Located arg)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ String
"got XHsImplicitBndrs for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExtCon -> String
forall a. Outputable a => a -> String
showGhc NoExtCon
XXHsImplicitBndrs GhcPs (Located arg)
x

-- ---------------------------------------------------------------------

instance (Annotate body) => Annotate (GHC.Stmt GHC.GhcPs (GHC.Located body)) where

  markAST :: SrcSpan -> Stmt GhcPs (Located body) -> Annotated ()
markAST SrcSpan
_ (GHC.LastStmt XLastStmt GhcPs GhcPs (Located body)
_ Located body
body Bool
_ SyntaxExpr GhcPs
_)
    = Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
LeftMost,AstContext
PrefixOp]) Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located body -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located body
body

  markAST SrcSpan
_ (GHC.BindStmt XBindStmt GhcPs GhcPs (Located body)
_ LPat GhcPs
pat Located body
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
    AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located (Pat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
Located (Pat GhcPs)
pat
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLarrow
    AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
LeftMost,AstContext
PrefixOp]) Int
2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located body -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located body
body

    Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate)
      (AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma)
      (Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
AddVbar) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar)
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ GHC.ApplicativeStmt{}
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error String
"ApplicativeStmt should not appear in ParsedSource"

  markAST SrcSpan
_ (GHC.BodyStmt XBodyStmt GhcPs GhcPs (Located body)
_ Located body
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
    AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located body -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located body
body
    Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
AddVbar)     (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
    Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.LetStmt XLetStmt GhcPs GhcPs (Located body)
_ (GHC.L SrcSpan
_ HsLocalBinds GhcPs
lb)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLet
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC -- '{'
    AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markInside AnnKeywordId
GHC.AnnSemi
    HsLocalBinds GhcPs -> Annotated ()
markLocalBindsWithLayout HsLocalBinds GhcPs
lb
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC -- '}'
    Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate)
      (AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma)
      (Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
AddVbar)     (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar)
    Annotated ()
markTrailingSemi

  markAST SrcSpan
l (GHC.ParStmt XParStmt GhcPs GhcPs (Located body)
_ [ParStmtBlock GhcPs GhcPs]
pbs HsExpr GhcPs
_ SyntaxExpr GhcPs
_) = 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


    Set AstContext -> Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Annotated () -> Annotated () -> m ()
ifInContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate)
      (

      AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$
        ListContexts
-> (ParStmtBlock GhcPs GhcPs -> Annotated ())
-> [ParStmtBlock GhcPs GhcPs]
-> Annotated ()
forall t.
ListContexts -> (t -> Annotated ()) -> [t] -> Annotated ()
markListWithContextsFunction
          (Set AstContext
-> Set AstContext
-> Set AstContext
-> Set AstContext
-> ListContexts
LC (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate)  -- only
              Set AstContext
forall a. Set a
Set.empty -- first
              Set AstContext
forall a. Set a
Set.empty -- middle
              (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate) -- last
          ) (SrcSpan -> ParStmtBlock GhcPs GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l) [ParStmtBlock GhcPs GhcPs]
pbs
         )
      (
      AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$
        ListContexts
-> (ParStmtBlock GhcPs GhcPs -> Annotated ())
-> [ParStmtBlock GhcPs GhcPs]
-> Annotated ()
forall t.
ListContexts -> (t -> Annotated ()) -> [t] -> Annotated ()
markListWithContextsFunction
          (Set AstContext
-> Set AstContext
-> Set AstContext
-> Set AstContext
-> ListContexts
LC Set AstContext
forall a. Set a
Set.empty -- only
              ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
AddVbar]) -- first
              ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
AddVbar]) -- middle
              Set AstContext
forall a. Set a
Set.empty                -- last
          ) (SrcSpan -> ParStmtBlock GhcPs GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l) [ParStmtBlock GhcPs GhcPs]
pbs
       )
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.TransStmt XTransStmt GhcPs GhcPs (Located body)
_ TransForm
form [GuardLStmt GhcPs]
stmts [(IdP GhcPs, IdP GhcPs)]
_b Located (HsExpr GhcPs)
using Maybe (Located (HsExpr GhcPs))
by SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ HsExpr GhcPs
_) = do
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (GuardLStmt GhcPs -> Annotated ())
-> [GuardLStmt GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GuardLStmt GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [GuardLStmt GhcPs]
stmts
    case TransForm
form of
      TransForm
GHC.ThenForm -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThen
        AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
using
        case Maybe (Located (HsExpr GhcPs))
by of
          Just Located (HsExpr GhcPs)
b -> do
            AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBy
            AstContext -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AstContext -> Annotated () -> m ()
unsetContext AstContext
Intercalate (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
b
          Maybe (Located (HsExpr GhcPs))
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TransForm
GHC.GroupForm -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThen
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnGroup
        case Maybe (Located (HsExpr GhcPs))
by of
          Just Located (HsExpr GhcPs)
b -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBy Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
b
          Maybe (Located (HsExpr GhcPs))
Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnUsing
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
using
    Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
AddVbar)     (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
    Set AstContext -> Annotated () -> Annotated ()
inContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Intercalate) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
    Annotated ()
markTrailingSemi

  markAST SrcSpan
_ (GHC.RecStmt XRecStmt GhcPs GhcPs (Located body)
_ [LStmtLR GhcPs GhcPs (Located body)]
stmts [IdP GhcPs]
_ [IdP GhcPs]
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRec
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
    AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markInside AnnKeywordId
GHC.AnnSemi
    [LStmtLR GhcPs GhcPs (Located body)] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LStmtLR GhcPs GhcPs (Located body)]
stmts
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC
    Set AstContext -> Annotated () -> Annotated ()