{-# 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 l :: SrcSpan
l (GHC.L _ ast :: 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
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 d :: LHsDecl GhcPs
d  -> LHsDecl GhcPs -> Annotated ()
markLHsDecl LHsDecl GhcPs
d
    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 intercal :: Bool
intercal ls :: [ast]
ls =
    case [ast]
ls of
      [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (l :: ast
l:ls' :: [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 ls :: [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 ctxInitial :: Set AstContext
ctxInitial ctxRest :: Set AstContext
ctxRest ls :: [Located ast]
ls =
  case [Located ast]
ls of
    [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [x :: Located ast
x] -> Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxInitial 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
    (x :: Located ast
x:xs :: [Located ast]
xs) -> do
      Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel Set AstContext
ctxInitial 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    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 ctxOnly :: Set AstContext
ctxOnly ctxInitial :: Set AstContext
ctxInitial ctxMiddle :: Set AstContext
ctxMiddle ctxLast :: Set AstContext
ctxLast) ls :: [Located ast]
ls =
  case [Located ast]
ls of
    [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [x :: 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
    (x :: Located ast
x:xs :: [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 = 2
    go :: [Located ast] -> Annotated ()
go []  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go [x :: 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 (x :: Located ast
x:xs :: [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 ls :: [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 ls :: [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 binds :: 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 kw :: AnnKeywordId
kw (GHC.L l :: SrcSpan
l a :: 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 ss' :: SrcSpan
ss' _ <- 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 Nothing    = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
markMaybe (Just ast :: 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 ls :: [Located a]
ls = (Located a -> (SrcSpan, Annotated ()))
-> [Located a] -> [(SrcSpan, Annotated ())]
forall a b. (a -> b) -> [a] -> [b]
map (\b :: 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 _ (GHC.HsModule mmn :: Maybe (Located ModuleName)
mmn mexp :: Maybe (Located [LIE GhcPs])
mexp imps :: [LImportDecl GhcPs]
imps decs :: [LHsDecl GhcPs]
decs mdepr :: Maybe (Located WarningTxt)
mdepr _haddock :: Maybe LHsDocString
_haddock) = do

    case Maybe (Located ModuleName)
mmn of
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (GHC.L ln :: SrcSpan
ln mn :: 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) 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) 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 _ (GHC.WarningTxt (GHC.L _ txt :: SourceText
txt) lss :: [Located StringLiteral]
lss) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
txt "{-# 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 "#-}"

  markAST _ (GHC.DeprecatedTxt (GHC.L _ txt :: SourceText
txt) lss :: [Located StringLiteral]
lss) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
txt "{-# 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 "#-}"

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

instance Annotate GHC.StringLiteral where
  markAST :: SrcSpan -> StringLiteral -> Annotated ()
markAST l :: SrcSpan
l (GHC.StringLiteral src :: SourceText
src fs :: 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 l :: SrcSpan
l (src :: SourceText
src,fs :: 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 _ ls :: [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 2 [LIE GhcPs]
ls

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

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

    case IE GhcPs
ie of
        GHC.IEVar _ ln :: 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 _ ln :: 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 _ ln :: LIEWrappedName (IdP GhcPs)
ln wc :: IEWildcard
wc ns :: [LIEWrappedName (IdP GhcPs)]
ns _lfs :: [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
            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 n :: 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 ()
                ns' :: [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 _ ln :: 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 _ (GHC.L lm :: SrcSpan
lm mn :: 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 x :: XXIE GhcPs
x -> String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XIE for :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
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 _ (GHC.IEName ln :: 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 _ (GHC.IEPattern ln :: 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 _ (GHC.IEType ln :: 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 n :: 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
== "."

instance Annotate GHC.RdrName where
  markAST :: SrcSpan -> RdrName -> Annotated ()
markAST l :: SrcSpan
l n :: 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?
                        "forall" -> if SrcSpan -> Int
spanLength SrcSpan
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "∀" else String
str
                        _ -> String
str

        let
          markParen :: GHC.AnnKeywordId -> Annotated ()
          markParen :: AnnKeywordId -> Annotated ()
markParen pa :: 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 0
        Int
cnt  <- AnnKeywordId -> FreeT AnnotationF Identity Int
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m Int
countAnns AnnKeywordId
GHC.AnnVal
        case Int
cnt of
          0 -> SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
str'
          1 -> AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnVal String
str'
          _ -> String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "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 1
        AnnKeywordId -> Annotated ()
markParen AnnKeywordId
GHC.AnnCloseP

    case RdrName
n of
      GHC.Unqual _ -> Annotated ()
doNormalRdrName
      GHC.Qual _ _ -> Annotated ()
doNormalRdrName
      GHC.Orig _ _ -> if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "~"
                        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 n' :: Name
n'  -> do
       case String
str of
         -- Special handling for Exact RdrNames, which are built-in Names
         "[]" -> do
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS  -- '['
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'
         "()" -> do
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP  -- '('
           AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'
         ('(':'#':_) -> do
           AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen  "(#" -- '(#'
           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
==',') 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  "#)"-- '#)'
         "[::]" -> do
           AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen  "[:" -- '[:'
           AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose ":]" -- ':]'
         "->" -> 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
         "~"  -> do
           Annotated ()
doNormalRdrName
         "*"  -> do
           SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
str
         "★"  -> 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
         ":"  -> 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
         ('(':',':_) -> 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
==',') 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 -- ')'
         _ -> 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` ("AnnComma in RdrName")

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

instance Annotate (GHC.ImportDecl GHC.GhcPs) where
 markAST :: SrcSpan -> ImportDecl GhcPs -> Annotated ()
markAST _ imp :: ImportDecl GhcPs
imp@(GHC.ImportDecl _ msrc :: SourceText
msrc modname :: Located ModuleName
modname mpkg :: Maybe StringLiteral
mpkg _src :: Bool
_src safeflag :: Bool
safeflag qualFlag :: Bool
qualFlag _impl :: Bool
_impl _as :: Maybe (Located ModuleName)
_as hiding :: 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 _txt :: String
_txt -> do
       SourceText -> String -> Annotated ()
markAnnOpen SourceText
msrc "{-# SOURCE"
       AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#-}"
     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)
   Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
qualFlag (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)
   case Maybe StringLiteral
mpkg of
    Just (GHC.StringLiteral (GHC.SourceText srcPkg :: String
srcPkg) _) ->
      AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnPackageName String
srcPkg
    _ -> () -> 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 ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
GHC.ideclAs ImportDecl GhcPs
imp of
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just mn :: 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
     Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just (isHiding :: Bool
isHiding,lie :: 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 _ (GHC.XImportDecl x :: XXImportDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XImportDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXImportDecl GhcPs
x

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

instance Annotate GHC.ModuleName where
   markAST :: SrcSpan -> ModuleName -> Annotated ()
markAST l :: SrcSpan
l mname :: 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 l :: SrcSpan
l decl :: HsDecl GhcPs
decl) =
    case HsDecl GhcPs
decl of
      GHC.TyClD _ d :: 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 _ d :: 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 _ d :: 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 _ d :: 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 _ d :: 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.DefD _ d :: 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 _ d :: 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 _ d :: 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 _ d :: 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 _ d :: 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 _ d :: 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 _ d :: 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 _ d :: 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 x :: XXHsDecl GhcPs
x  -> String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XHsDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXHsDecl GhcPs
x

instance Annotate (GHC.HsDecl GHC.GhcPs) where
  markAST :: SrcSpan -> HsDecl GhcPs -> Annotated ()
markAST l :: SrcSpan
l d :: 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 _ (GHC.RoleAnnotDecl _ ln :: Located (IdP GhcPs)
ln mr :: [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 _ (GHC.XRoleAnnotDecl x :: XXRoleAnnotDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XRoleAnnotDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXRoleAnnotDecl GhcPs
x

instance Annotate (Maybe GHC.Role) where
  markAST :: SrcSpan -> Maybe Role -> Annotated ()
markAST l :: SrcSpan
l Nothing  = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "_"
  markAST l :: SrcSpan
l (Just r :: 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 _ (GHC.SpliceDecl _ e :: Located (HsSplice GhcPs)
e@(GHC.L _ (GHC.HsQuasiQuote{})) _flag :: 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 _ (GHC.SpliceDecl _ e :: Located (HsSplice GhcPs)
e _flag :: 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 _ (GHC.XSpliceDecl x :: XXSpliceDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XSpliceDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXSpliceDecl GhcPs
x

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

instance Annotate (GHC.RuleDecls GHC.GhcPs) where
  markAST :: SrcSpan -> RuleDecls GhcPs -> Annotated ()
markAST _ (GHC.HsRules _ src :: SourceText
src rules :: [LRuleDecl GhcPs]
rules) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# 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 2 [LRuleDecl GhcPs]
rules
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#-}"
    Annotated ()
markTrailingSemi
  markAST _ (GHC.XRuleDecls x :: XXRuleDecls GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XRuleDecls for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXRuleDecls GhcPs
x

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

instance Annotate (GHC.RuleDecl GHC.GhcPs) where
  markAST :: SrcSpan -> RuleDecl GhcPs -> Annotated ()
markAST l :: SrcSpan
l (GHC.HsRule _ ln :: Located (SourceText, FastString)
ln act :: Activation
act mtybndrs :: Maybe [LHsTyVarBndr (NoGhcTc GhcPs)]
mtybndrs termbndrs :: [LRuleBndr GhcPs]
termbndrs lhs :: Located (HsExpr GhcPs)
lhs rhs :: 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
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just bndrs :: [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 _ (GHC.XRuleDecl x :: XXRuleDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XRuleDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXRuleDecl GhcPs
x

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

markActivation :: GHC.SrcSpan -> GHC.Activation -> Annotated ()
markActivation :: SrcSpan -> Activation -> Annotated ()
markActivation _ act :: Activation
act = do
  case Activation
act of
    GHC.ActiveBefore src :: SourceText
src phase :: 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 src :: SourceText
src phase :: 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 -- ']'
    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 -- ']'
    _ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance Annotate (GHC.RuleBndr GHC.GhcPs) where
  markAST :: SrcSpan -> RuleBndr GhcPs -> Annotated ()
markAST _ (GHC.RuleBndr _ ln :: 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 _ (GHC.RuleBndrSig _ ln :: Located (IdP GhcPs)
ln st :: 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 _ (GHC.XRuleBndr x :: XXRuleBndr GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XRuleBndr for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXRuleBndr GhcPs
x

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

markLHsSigWcType :: GHC.LHsSigWcType GHC.GhcPs -> Annotated ()
markLHsSigWcType :: LHsSigWcType GhcPs -> Annotated ()
markLHsSigWcType (GHC.HsWC _ (GHC.HsIB _ ty :: 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 _ (GHC.XHsImplicitBndrs _)) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markLHsSigWcType extension hit"
markLHsSigWcType (GHC.XHsWildCardBndrs _)              = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markLHsSigWcType extension hit"

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

instance Annotate (GHC.AnnDecl GHC.GhcPs) where
   markAST :: SrcSpan -> AnnDecl GhcPs -> Annotated ()
markAST _ (GHC.HsAnnotation _ src :: SourceText
src prov :: AnnProvenance (IdP GhcPs)
prov e :: Located (HsExpr GhcPs)
e) = do
     SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# ANN"
     case AnnProvenance (IdP GhcPs)
prov of
       (GHC.ValueAnnProvenance n :: 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 n :: 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
       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 "#-}"
     Annotated ()
markTrailingSemi

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

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

instance Annotate (GHC.WarnDecls GHC.GhcPs) where
   markAST :: SrcSpan -> WarnDecls GhcPs -> Annotated ()
markAST _ (GHC.Warnings _ src :: SourceText
src warns :: [LWarnDecl GhcPs]
warns) = do
     SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# 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 "#-}"

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

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

instance Annotate (GHC.WarnDecl GHC.GhcPs) where
   markAST :: SrcSpan -> WarnDecl GhcPs -> Annotated ()
markAST _ (GHC.Warning _ lns :: [Located (IdP GhcPs)]
lns txt :: 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    _src :: GenLocated SrcSpan SourceText
_src ls :: [Located StringLiteral]
ls -> [Located StringLiteral] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [Located StringLiteral]
ls
       GHC.DeprecatedTxt _src :: GenLocated SrcSpan SourceText
_src ls :: [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 _ (GHC.XWarnDecl x :: XXWarnDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XWarnDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXWarnDecl GhcPs
x

instance Annotate GHC.FastString where
  -- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.
  markAST :: SrcSpan -> FastString -> Annotated ()
markAST l :: SrcSpan
l fs :: 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 _ (GHC.ForeignImport _ ln :: Located (IdP GhcPs)
ln (GHC.HsIB _ typ :: LHsType GhcPs
typ)
               (GHC.CImport cconv :: Located CCallConv
cconv safety :: Located Safety
safety@(GHC.L ll :: SrcSpan
ll _) _mh :: Maybe Header
_mh _imp :: CImportSpec
_imp (GHC.L ls :: SrcSpan
ls src :: 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 ""
    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 _l :: SrcSpan
_l (GHC.ForeignExport _ ln :: Located (IdP GhcPs)
ln (GHC.HsIB _ typ :: LHsType GhcPs
typ) (GHC.CExport spec :: Located CExportSpec
spec (GHC.L ls :: SrcSpan
ls src :: 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 "")
    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 _ (GHC.ForeignImport _ _ (GHC.XHsImplicitBndrs _) _) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markAST ForeignDecl hit extenstion"
  markAST _ (GHC.ForeignExport _ _ (GHC.XHsImplicitBndrs _) _) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markAST ForeignDecl hit extenstion"
  markAST _ (GHC.XForeignDecl _)                               = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markAST ForeignDecl hit extenstion"

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

instance (Annotate GHC.CExportSpec) where
  markAST :: SrcSpan -> CExportSpec -> Annotated ()
markAST l :: SrcSpan
l (GHC.CExportStatic _src :: SourceText
_src _ cconv :: 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 l :: SrcSpan
l GHC.StdCallConv        =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "stdcall"
  markAST l :: SrcSpan
l GHC.CCallConv          =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "ccall"
  markAST l :: SrcSpan
l GHC.CApiConv           =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "capi"
  markAST l :: SrcSpan
l GHC.PrimCallConv       =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "prim"
  markAST l :: SrcSpan
l GHC.JavaScriptCallConv =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "javascript"

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

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

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

instance Annotate (GHC.DerivDecl GHC.GhcPs) where

  markAST :: SrcSpan -> DerivDecl GhcPs -> Annotated ()
markAST _ (GHC.DerivDecl _ (GHC.HsWC _ (GHC.HsIB _ typ :: LHsType GhcPs
typ)) ms :: Maybe (LDerivStrategy GhcPs)
ms mov :: 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 _ (GHC.DerivDecl _ (GHC.HsWC _ (GHC.XHsImplicitBndrs _)) _ _) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markAST DerivDecl hit extension"
  markAST _ (GHC.DerivDecl _ (GHC.XHsWildCardBndrs _) _ _)              = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markAST DerivDecl hit extension"
  markAST _ (GHC.XDerivDecl _)                                          = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markAST DerivDecl hit extension"

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

instance Annotate (GHC.DerivStrategy GHC.GhcPs) where

  markAST :: SrcSpan -> DerivStrategy GhcPs -> Annotated ()
markAST _ GHC.StockStrategy    = AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnStock
  markAST _ GHC.AnyclassStrategy = AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnAnyclass
  markAST _ GHC.NewtypeStrategy  = AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnNewtype
  markAST _ (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 _ (GHC.ViaStrategy (GHC.XHsImplicitBndrs _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XHsImplicitBndrs in AnnDerivStrategy"

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

instance Annotate (GHC.DefaultDecl GHC.GhcPs) where

  markAST :: SrcSpan -> DefaultDecl GhcPs -> Annotated ()
markAST _ (GHC.DefaultDecl _ typs :: [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 _ (GHC.XDefaultDecl x :: XXDefaultDecl GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XDefaultDecl for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXDefaultDecl GhcPs
x

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

instance Annotate (GHC.InstDecl GHC.GhcPs) where

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

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

instance Annotate GHC.OverlapMode where

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

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

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

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

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

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

instance Annotate (GHC.ClsInstDecl GHC.GhcPs) where

  markAST :: SrcSpan -> ClsInstDecl GhcPs -> Annotated ()
markAST _ (GHC.ClsInstDecl _ (GHC.HsIB _ poly :: LHsType GhcPs
poly) binds :: LHsBinds GhcPs
binds sigs :: [GenLocated SrcSpan (Sig GhcPs)]
sigs tyfams :: [LTyFamInstDecl GhcPs]
tyfams datafams :: [LDataFamInstDecl GhcPs]
datafams mov :: 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 _ (GHC.ClsInstDecl _ (GHC.XHsImplicitBndrs _) _ _ _ _ _) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for ClsInstDecl"
  markAST _ (GHC.XClsInstDecl _)                                   = String -> Annotated ()
forall a. HasCallStack => String -> a
error "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 _ (GHC.TyFamInstDecl (GHC.HsIB _ eqn :: FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs)
eqn)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnInstance -- Note: this keyword is optional
    FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs) -> Annotated ()
markFamEqn FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs)
eqn
    Annotated ()
markTrailingSemi

  markAST _ (GHC.TyFamInstDecl (GHC.XHsImplicitBndrs _)) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "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)
           -> Annotated ()
markFamEqn :: FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs) -> Annotated ()
markFamEqn (GHC.FamEqn _ ln :: Located (IdP GhcPs)
ln bndrs :: Maybe [LHsTyVarBndr GhcPs]
bndrs pats :: HsTyPats GhcPs
pats fixity :: LexicalFixity
fixity rhs :: LHsType GhcPs
rhs) = do
  Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> HsTyPats GhcPs
-> Annotated ()
forall a.
(Annotate a, HasOccName 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 _) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "got XFamEqn"

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

instance Annotate (GHC.DataFamInstDecl GHC.GhcPs) where

  markAST :: SrcSpan -> DataFamInstDecl GhcPs -> Annotated ()
markAST l :: SrcSpan
l (GHC.DataFamInstDecl (GHC.HsIB _ (GHC.FamEqn _ ln :: Located (IdP GhcPs)
ln bndrs :: Maybe [LHsTyVarBndr GhcPs]
bndrs pats :: HsTyPats GhcPs
pats fixity :: LexicalFixity
fixity
             defn :: HsDataDefn GhcPs
defn@(GHC.HsDataDefn _ nd :: NewOrData
nd ctx :: LHsContext GhcPs
ctx typ :: Maybe (Located CType)
typ _mk :: Maybe (LHsType GhcPs)
_mk cons :: [LConDecl GhcPs]
cons mderivs :: HsDeriving GhcPs
mderivs) ))) = do
    case HsDataDefn GhcPs -> NewOrData
forall pass. HsDataDefn pass -> NewOrData
GHC.dd_ND HsDataDefn GhcPs
defn of
      GHC.NewType  -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnNewtype
      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, HasOccName 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 s :: 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
      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 NoExt
XCHsDataDefn GhcPs
GHC.noExt 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)
    Annotated ()
markTrailingSemi

  markAST _
            (GHC.DataFamInstDecl
             (GHC.HsIB _ (GHC.FamEqn _ _ _ _ _ (GHC.XHsDataDefn _))))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for DataFamInstDecl"
  markAST _ (GHC.DataFamInstDecl (GHC.HsIB _ (GHC.XFamEqn _)))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for DataFamInstDecl"
  markAST _ (GHC.DataFamInstDecl (GHC.XHsImplicitBndrs _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for DataFamInstDecl"

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

instance Annotate (GHC.HsBind GHC.GhcPs) where
  markAST :: SrcSpan -> HsBind GhcPs -> Annotated ()
markAST _ (GHC.FunBind _ _ (GHC.MG _ (GHC.L _ matches :: [LMatch GhcPs (Located (HsExpr GhcPs))]
matches) _) _ _) = do
    -- Note: from a layout perspective a FunBind should not exist, so the
    -- current context is passed through unchanged to the matches.
    -- TODO: perhaps bring the edp from the first match up to the annotation for
    -- the FunBind.
    let
      tlFun :: 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) 2 Annotated ()
tlFun)
      Annotated ()
tlFun

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

  markAST _ (GHC.PatBind _ lhs :: LPat GhcPs
lhs (GHC.GRHSs _ grhs :: [LGRHS GhcPs (Located (HsExpr GhcPs))]
grhs (GHC.L _ lb :: HsLocalBinds GhcPs
lb)) _ticks :: ([Tickish Id], [[Tickish Id]])
_ticks) = do
    LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
lhs
    case [LGRHS GhcPs (Located (HsExpr GhcPs))]
grhs of
      (GHC.L _ (GHC.GRHS _ [] _):_) -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual -- empty guards
      _ -> () -> 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 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 ()
      _ -> 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 _ (GHC.VarBind _ _n :: IdP GhcPs
_n rhse :: Located (HsExpr GhcPs)
rhse _) =
    -- 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 _ (GHC.AbsBinds {}) =
    String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: AbsBinds introduced after renaming"

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

  markAST l :: SrcSpan
l (GHC.PatSynBind _ (GHC.PSB _ ln :: Located (IdP GhcPs)
ln args :: HsPatSynDetails (Located (IdP GhcPs))
args def :: LPat GhcPs
def dir :: HsPatSynDir GhcPs
dir)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnPattern
    case HsPatSynDetails (Located (IdP GhcPs))
args of
      GHC.InfixCon la :: Located (IdP GhcPs)
la lb :: 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 ns :: [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 fs :: [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
      GHC.ImplicitBidirectional -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
      _                         -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLarrow

    LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
def
    case HsPatSynDir GhcPs
dir of
      GHC.Unidirectional           -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      GHC.ImplicitBidirectional    -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      GHC.ExplicitBidirectional mg :: 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 _ (GHC.FunBind _ _ (GHC.XMatchGroup _) _ _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for HsBind"
  markAST _ (GHC.PatBind _ _ (GHC.XGRHSs _) _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for HsBind"
  markAST _ (GHC.PatSynBind _ (GHC.XPatSynBind _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for HsBind"
  markAST _ (GHC.XHsBindsLR _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for HsBind"

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

instance Annotate (GHC.IPBind GHC.GhcPs) where
  markAST :: SrcSpan -> IPBind GhcPs -> Annotated ()
markAST _ (GHC.IPBind _ en :: Either (Located HsIPName) (IdP GhcPs)
en e :: Located (HsExpr GhcPs)
e) = do
    case Either (Located HsIPName) (IdP GhcPs)
en of
      Left n :: Located HsIPName
n   -> Located HsIPName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located HsIPName
n
      Right _i :: 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 _ (GHC.XIPBind x :: XXIPBind GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XIPBind for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXIPBind GhcPs
x

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

instance Annotate GHC.HsIPName where
  markAST :: SrcSpan -> HsIPName -> Annotated ()
markAST l :: SrcSpan
l (GHC.HsIPName n :: FastString
n) = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal ("?" 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 _ (GHC.Match _ mln :: HsMatchContext (NameOrRdrName (IdP GhcPs))
mln pats :: [LPat GhcPs]
pats (GHC.GRHSs _ grhs :: [LGRHS GhcPs (Located body)]
grhs (GHC.L _ lb :: HsLocalBinds GhcPs
lb))) = do
    let
      get_infix :: HsMatchContext id -> LexicalFixity
get_infix (GHC.FunRhs _ f :: LexicalFixity
f _) = LexicalFixity
f
      get_infix _                  = LexicalFixity
GHC.Prefix

      isFunBind :: HsMatchContext id -> Bool
isFunBind GHC.FunRhs{} = Bool
True
      isFunBind _            = Bool
False
    case (HsMatchContext RdrName -> LexicalFixity
forall id. HsMatchContext id -> LexicalFixity
get_infix HsMatchContext (NameOrRdrName (IdP GhcPs))
HsMatchContext RdrName
mln,[LPat GhcPs]
pats) of
      (GHC.Infix, a :: LPat GhcPs
a:b :: LPat GhcPs
b:xs :: [LPat GhcPs]
xs) -> do
        if [LPat GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
xs
          then AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenP
          else AnnKeywordId -> Annotated ()
mark         AnnKeywordId
GHC.AnnOpenP
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
a
        case HsMatchContext (NameOrRdrName (IdP GhcPs))
mln of
          GHC.FunRhs n :: Located (NameOrRdrName (IdP GhcPs))
n _ _ -> 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
          _              -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
b
        if [LPat GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LPat GhcPs]
xs
         then AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseP
         else AnnKeywordId -> Annotated ()
mark         AnnKeywordId
GHC.AnnCloseP
        (LPat GhcPs -> Annotated ()) -> [LPat GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LPat GhcPs]
xs
      _ -> 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 n :: Located (NameOrRdrName (IdP GhcPs))
n _ s :: 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
            (LPat GhcPs -> Annotated ()) -> [LPat GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LPat GhcPs]
pats
          _  -> Bool -> [LPat GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
Bool -> [ast] -> Annotated ()
markListNoPrecedingSpace Bool
False [LPat GhcPs]
pats

    -- TODO: The AnnEqual annotation actually belongs in the first GRHS value
    case [LGRHS GhcPs (Located body)]
grhs of
      (GHC.L _ (GHC.GRHS _ [] _):_) -> 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
      _ -> () -> 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 ()
      _ -> 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 _ (GHC.Match _ _ _ (GHC.XGRHSs _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension for Match"
  markAST _ (GHC.XMatch _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension for Match"

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

instance (Annotate body)
  => Annotate (GHC.GRHS GHC.GhcPs (GHC.Located body)) where
  markAST :: SrcSpan -> GRHS GhcPs (Located body) -> Annotated ()
markAST _ (GHC.GRHS _ guards :: [GuardLStmt GhcPs]
guards expr :: Located body
expr) = do
    case [GuardLStmt GhcPs]
guards of
      [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (_:_) -> 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]) 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 _ (GHC.XGRHS x :: XXGRHS GhcPs (Located body)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XGRHS for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXGRHS GhcPs (Located body)
x

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

instance Annotate (GHC.Sig GHC.GhcPs) where

  markAST :: SrcSpan -> Sig GhcPs -> Annotated ()
markAST _ (GHC.TypeSig _ lns :: [Located (IdP GhcPs)]
lns st :: 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 _ (GHC.PatSynSig _ lns :: [Located (IdP GhcPs)]
lns (GHC.HsIB _ typ :: 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 _ (GHC.ClassOpSig _ isDefault :: Bool
isDefault ns :: [Located (IdP GhcPs)]
ns (GHC.HsIB _ typ :: 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 _ (GHC.IdSig {}) =
    String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: Introduced after renaming"

  markAST _ (GHC.FixSig _ (GHC.FixitySig _ lns :: [Located (IdP GhcPs)]
lns (GHC.Fixity src :: SourceText
src v :: Int
v fdir :: FixityDirection
fdir))) = do
    let fixstr :: String
fixstr = case FixityDirection
fdir of
         GHC.InfixL -> "infixl"
         GHC.InfixR -> "infixr"
         GHC.InfixN -> "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 l :: SrcSpan
l (GHC.InlineSig _ ln :: Located (IdP GhcPs)
ln inl :: InlinePragma
inl) = do
    SourceText -> String -> Annotated ()
markAnnOpen (InlinePragma -> SourceText
GHC.inl_src InlinePragma
inl) "{-# 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 "#-}" -- '#-}'
    Annotated ()
markTrailingSemi

  markAST l :: SrcSpan
l (GHC.SpecSig _ ln :: Located (IdP GhcPs)
ln typs :: [HsImplicitBndrs GhcPs (LHsType GhcPs)]
typs inl :: InlinePragma
inl) = do
    SourceText -> String -> Annotated ()
markAnnOpen (InlinePragma -> SourceText
GHC.inl_src InlinePragma
inl) "{-# 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 -- '::'
    (HsImplicitBndrs GhcPs (LHsType GhcPs) -> Annotated ())
-> Int -> [HsImplicitBndrs GhcPs (LHsType GhcPs)] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel HsImplicitBndrs GhcPs (LHsType GhcPs) -> Annotated ()
markLHsSigType 2 [HsImplicitBndrs GhcPs (LHsType GhcPs)]
typs
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#-}" -- '#-}'
    Annotated ()
markTrailingSemi


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


  markAST _ (GHC.MinimalSig _ src :: SourceText
src formula :: LBooleanFormula (Located (IdP GhcPs))
formula) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# 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 "#-}"
    Annotated ()
markTrailingSemi

  markAST _ (GHC.SCCFunSig _ src :: SourceText
src ln :: Located (IdP GhcPs)
ln ml :: Maybe (Located StringLiteral)
ml) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# 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 "#-}"
    Annotated ()
markTrailingSemi

  markAST _ (GHC.CompleteMatchSig _ src :: SourceText
src (GHC.L _ ns :: [Located (IdP GhcPs)]
ns) mlns :: Maybe (Located (IdP GhcPs))
mlns) = do
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# 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
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just _ -> 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 "#-}" -- '#-}'
    Annotated ()
markTrailingSemi

  -- -----------------------------------
  markAST _ (GHC.PatSynSig _ _ (GHC.XHsImplicitBndrs _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension for Sig"
  markAST _ (GHC.ClassOpSig _ _ _ (GHC.XHsImplicitBndrs _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension for Sig"
  markAST _ (GHC.FixSig _ (GHC.XFixitySig _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension for Sig"
  markAST _ (GHC.XSig _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension for Sig"

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

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

instance Annotate [GHC.LHsSigType GHC.GhcPs] where
  markAST :: SrcSpan -> [HsImplicitBndrs GhcPs (LHsType GhcPs)] -> Annotated ()
markAST _ ls :: [HsImplicitBndrs GhcPs (LHsType 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 [HsImplicitBndrs GhcPs (LHsType GhcPs)]
ls of
          []  -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional
          [GHC.HsIB _ t :: 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
          _   -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany -- Need parens if more than one entry
    AnnKeywordId -> Annotated ()
marker AnnKeywordId
GHC.AnnOpenP
    (HsImplicitBndrs GhcPs (LHsType GhcPs) -> Annotated ())
-> [HsImplicitBndrs GhcPs (LHsType GhcPs)] -> Annotated ()
forall t. (t -> Annotated ()) -> [t] -> Annotated ()
markListIntercalateWithFun HsImplicitBndrs GhcPs (LHsType GhcPs) -> Annotated ()
markLHsSigType [HsImplicitBndrs GhcPs (LHsType 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 _ (GHC.Var x :: 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 _ (GHC.Or ls :: [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 2 AstContext
AddVbar [LBooleanFormula (Located name)]
ls
  markAST _ (GHC.And ls :: [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 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 _ (GHC.Parens x :: 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 _l :: SrcSpan
_l (GHC.UserTyVar _ n :: 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 _ (GHC.KindedTyVar _ n :: Located (IdP GhcPs)
n ty :: 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 _l :: SrcSpan
_l (GHC.XTyVarBndr x :: XXTyVarBndr GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XTyVarBndr for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXTyVarBndr GhcPs
x

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

instance Annotate (GHC.HsType GHC.GhcPs) where
  markAST :: SrcSpan -> HsType GhcPs -> Annotated ()
markAST loc :: SrcSpan
loc ty :: 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 _ (GHC.HsForAllTy _ tvs :: [LHsTyVarBndr GhcPs]
tvs typ :: 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
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDot
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ

    markType _ (GHC.HsQualTy _ cxt :: LHsContext GhcPs
cxt typ :: 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 _ (GHC.HsTyVar _ promoted :: PromotionFlag
promoted name :: 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 _ (GHC.HsAppTy _ t1 :: LHsType GhcPs
t1 t2 :: 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 _ (GHC.HsAppKindTy l :: XAppKindTy GhcPs
l t :: LHsType GhcPs
t k :: 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 SrcSpan
XAppKindTy GhcPs
l
      LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
k

    markType _ (GHC.HsFunTy _ t1 :: LHsType GhcPs
t1 t2 :: 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 _ (GHC.HsListTy _ t :: 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 _ (GHC.HsTupleTy _ tt :: HsTupleSort
tt ts :: [LHsType GhcPs]
ts) = do
      case HsTupleSort
tt  of
        GHC.HsBoxedOrConstraintTuple -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP  -- '('
        _                            -> AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen "(#" -- '(#'
      (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 2 [LHsType GhcPs]
ts
      case HsTupleSort
tt  of
        GHC.HsBoxedOrConstraintTuple -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP  -- ')'
        _                            -> AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#)" -- '#)'

    markType _ (GHC.HsSumTy _ tys :: [LHsType GhcPs]
tys) = do
      AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen "(#"
      (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 2 AstContext
AddVbar [LHsType GhcPs]
tys
      AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#)"

    markType _ (GHC.HsOpTy _ t1 :: LHsType GhcPs
t1 lo :: Located (IdP GhcPs)
lo t2 :: 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 _ (GHC.HsParTy _ t :: 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 _ (GHC.HsIParamTy _ n :: Located HsIPName
n t :: 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 l :: SrcSpan
l (GHC.HsStarTy _ isUnicode :: 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 "\x2605" -- Unicode star
        else SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "*"

    markType _ (GHC.HsKindSig _ t :: LHsType GhcPs
t k :: 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 l :: SrcSpan
l (GHC.HsSpliceTy _ s :: HsSplice GhcPs
s) = do
      SrcSpan -> HsSplice GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsSplice GhcPs
s

    markType _ (GHC.HsDocTy _ t :: LHsType GhcPs
t ds :: 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 _ (GHC.HsBangTy _ (GHC.HsSrcBang mt :: SourceText
mt _up :: SrcUnpackedness
_up str :: SrcStrictness
str) t :: LHsType GhcPs
t) = do
      case SourceText
mt of
        GHC.NoSourceText -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        GHC.SourceText src :: String
src -> do
          AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
src
          AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#-}"
      case SrcStrictness
str of
        GHC.SrcLazy     -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnTilde
        GHC.SrcStrict   -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBang
        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 _ (GHC.HsRecTy _ cons :: [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 _ (GHC.HsExplicitListTy _ promoted :: PromotionFlag
promoted ts :: [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 _ (GHC.HsExplicitTupleTy _ ts :: [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 l :: SrcSpan
l (GHC.HsTyLit _ lit :: HsTyLit
lit) = do
      case HsTyLit
lit of
        (GHC.HsNumTy s :: SourceText
s v :: Integer
v) ->
          SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
s (Integer -> String
forall a. Show a => a -> String
show Integer
v)
        (GHC.HsStrTy s :: SourceText
s v :: FastString
v) ->
          SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
s (FastString -> String
forall a. Show a => a -> String
show FastString
v)

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

    markType _ (GHC.XHsType x :: XXType GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XHsType for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NewHsTypeX -> String
forall a. Outputable a => a -> String
showGhc XXType GhcPs
NewHsTypeX
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 l :: SrcSpan
l c :: HsSplice GhcPs
c =
    case HsSplice GhcPs
c of
      GHC.HsQuasiQuote _ _ n :: IdP GhcPs
n _pos :: SrcSpan
_pos fs :: 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
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
forall a. [a] -> [a] -> [a]
++ (FastString -> String
GHC.unpackFS FastString
fs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "|]")

      GHC.HsTypedSplice _ hasParens :: SpliceDecoration
hasParens _n :: IdP GhcPs
_n b :: Located (HsExpr GhcPs)
b@(GHC.L _ (GHC.HsVar _ (GHC.L _ n :: 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
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 _ hasParens :: SpliceDecoration
hasParens _n :: IdP GhcPs
_n b :: 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 _ hasParens :: SpliceDecoration
hasParens _n :: IdP GhcPs
_n b :: Located (HsExpr GhcPs)
b@(GHC.L _ (GHC.HsVar _ (GHC.L _ n :: 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
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 _ hasParens :: SpliceDecoration
hasParens _n :: IdP GhcPs
_n b :: Located (HsExpr GhcPs)
b  -> do
        case SpliceDecoration
hasParens of
          GHC.HasParens -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenPE
          GHC.HasDollar -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThIdSplice
          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 "HsSpliced only exists between renamer and typechecker in GHC"
      GHC.HsSplicedT{} -> String -> Annotated ()
forall a. HasCallStack => String -> a
error "HsSplicedT only exists between renamer and typechecker in GHC"

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

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

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

instance Annotate (GHC.ConDeclField GHC.GhcPs) where
  markAST :: SrcSpan -> ConDeclField GhcPs -> Annotated ()
markAST _ (GHC.ConDeclField _ ns :: [LFieldOcc GhcPs]
ns ty :: LHsType GhcPs
ty mdoc :: 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 _ (GHC.XConDeclField x :: XXConDeclField GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XConDeclField for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXConDeclField GhcPs
x

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

instance Annotate (GHC.FieldOcc GHC.GhcPs) where
  markAST :: SrcSpan -> FieldOcc GhcPs -> Annotated ()
markAST _ (GHC.FieldOcc _ rn :: 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 _ (GHC.XFieldOcc x :: XXFieldOcc GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XFieldOcc for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXFieldOcc GhcPs
x

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

instance Annotate GHC.HsDocString where
  markAST :: SrcSpan -> HsDocString -> Annotated ()
markAST l :: SrcSpan
l s :: 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 -> LPat GhcPs -> Annotated ()
markAST loc :: SrcSpan
loc typ :: LPat GhcPs
typ = do
    SrcSpan -> LPat GhcPs -> Annotated ()
markPat SrcSpan
loc LPat 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` ("AnnComma in Pat")
    where
      markPat :: SrcSpan -> LPat GhcPs -> Annotated ()
markPat l :: SrcSpan
l (GHC.WildPat _) = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "_"
      markPat l :: SrcSpan
l (GHC.VarPat _ n :: 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 = "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 _ (GHC.LazyPat _ p :: LPat GhcPs
p) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnTilde
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
p

      markPat _ (GHC.AsPat _ ln :: Located (IdP GhcPs)
ln p :: 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
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
p

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

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

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

      markPat _ (GHC.TuplePat _ pats :: [LPat GhcPs]
pats b :: 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 "(#"
        (LPat GhcPs -> Annotated ()) -> Int -> [LPat GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated 2 [LPat 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 "#)"

      markPat _ (GHC.SumPat _ pat :: LPat GhcPs
pat alt :: Int
alt arity :: Int
arity) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen "(#"
        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
- 1) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat 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 "#)"

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

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

      markPat _ (GHC.ViewPat _ e :: Located (HsExpr GhcPs)
e pat :: 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
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
pat

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

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

      markPat _ (GHC.NPat _ ol :: Located (HsOverLit GhcPs)
ol mn :: Maybe (SyntaxExpr GhcPs)
mn _) = 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 _ (GHC.NPlusKPat _ ln :: Located (IdP GhcPs)
ln ol :: Located (HsOverLit GhcPs)
ol _ _ _) = 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 "+"  -- "+"
        Located (HsOverLit GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsOverLit GhcPs)
ol


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

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

      markPat _ (GHC.XPat (GHC.L l p)) = SrcSpan -> LPat GhcPs -> Annotated ()
markPat SrcSpan
l LPat GhcPs
p
      -- markPat _ (GHC.XPat x) = error $ "got XPat for:" ++ showGhc x

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

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

toSourceTextWithSuffix :: (Show a) => GHC.SourceText -> a -> String -> String
toSourceTextWithSuffix :: SourceText -> a -> String -> String
toSourceTextWithSuffix (SourceText
GHC.NoSourceText)    alt :: a
alt suffix :: 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 txt :: String
txt) _alt :: a
_alt suffix :: 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 ln :: Located RdrName
ln dets :: HsConPatDetails GhcPs
dets = do
  case HsConPatDetails GhcPs
dets of
    GHC.PrefixCon args :: [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
      (LPat GhcPs -> Annotated ()) -> [LPat GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LPat GhcPs]
args
    GHC.RecCon (GHC.HsRecFields fs :: [LHsRecField GhcPs (LPat GhcPs)]
fs dd :: Maybe 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 Int
dd of
        Nothing ->  (LHsRecField GhcPs (LPat GhcPs) -> Annotated ())
-> Int -> [LHsRecField GhcPs (LPat GhcPs)] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LHsRecField GhcPs (LPat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated 2 [LHsRecField GhcPs (LPat GhcPs)]
fs
        Just _ -> 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 (LPat GhcPs) -> Annotated ())
-> [LHsRecField GhcPs (LPat GhcPs)] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsRecField GhcPs (LPat GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsRecField GhcPs (LPat GhcPs)]
fs
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC -- '}'
    GHC.InfixCon a1 :: LPat GhcPs
a1 a2 :: LPat GhcPs
a2 -> do
      LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat 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
      LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
a2

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

markHsConDeclDetails :: Bool
-> Bool
-> [Located RdrName]
-> HsConDeclDetails GhcPs
-> Annotated ()
markHsConDeclDetails isDeprecated :: Bool
isDeprecated inGadt :: Bool
inGadt lns :: [Located RdrName]
lns dets :: HsConDeclDetails GhcPs
dets = do
  case HsConDeclDetails GhcPs
dets of
    GHC.PrefixCon args :: [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 fs :: 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 a1 :: LHsType GhcPs
a1 a2 :: 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 _ fs :: [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 l :: SrcSpan
l ol :: 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 src :: SourceText
src _ _) -> SourceText
src
                GHC.HsFractional (GHC.FL src :: SourceText
src _ _) -> SourceText
src
                GHC.HsIsString src :: SourceText
src _ -> SourceText
src
    in
    SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
str ""

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

instance (Annotate arg)
    => Annotate (GHC.HsImplicitBndrs GHC.GhcPs (GHC.Located arg)) where
  markAST :: SrcSpan -> HsImplicitBndrs GhcPs (Located arg) -> Annotated ()
markAST _ (GHC.HsIB _ thing :: Located arg
thing) = do
    Located arg -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located arg
thing
  markAST _ (GHC.XHsImplicitBndrs x :: XXHsImplicitBndrs GhcPs (Located arg)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XHsImplicitBndrs for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
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 _ (GHC.LastStmt _ body :: Located body
body _ _)
    = 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]) 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 _ (GHC.BindStmt _ pat :: LPat GhcPs
pat body :: Located body
body _ _) = 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
$ LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat 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]) 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 _ GHC.ApplicativeStmt{}
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "ApplicativeStmt should not appear in ParsedSource"

  markAST _ (GHC.BodyStmt _ body :: Located body
body _ _) = 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 _ (GHC.LetStmt _ (GHC.L _ lb :: 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 l :: SrcSpan
l (GHC.ParStmt _ pbs :: [ParStmtBlock GhcPs GhcPs]
pbs _ _) = do
    -- Within a given parallel list comprehension,one of the sections to be done
    -- in parallel. It is a normal list comprehension, so has a list of
    -- ParStmtBlock, one for each part of the sub- list comprehension


    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 _ (GHC.TransStmt _ form :: TransForm
form stmts :: [GuardLStmt GhcPs]
stmts _b :: [(IdP GhcPs, IdP GhcPs)]
_b using :: Located (HsExpr GhcPs)
using by :: Maybe (Located (HsExpr GhcPs))
by _ _ _) = 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
      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 b :: 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
          Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      GHC.GroupForm -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThen
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnGroup
        case Maybe (Located (HsExpr GhcPs))
by of
          Just b :: 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
          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 _ (GHC.RecStmt _ stmts :: [LStmtLR GhcPs GhcPs (Located body)]
stmts _ _ _ _ _) = 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 ()
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 _ (GHC.XStmtLR x :: XXStmtLR GhcPs GhcPs (Located body)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XStmtLR for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXStmtLR GhcPs GhcPs (Located body)
x

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

-- Note: We never have a located ParStmtBlock, so have nothing to hang the
-- annotation on. This means there is no pushing of context from the parent ParStmt.
instance Annotate (GHC.ParStmtBlock GHC.GhcPs GHC.GhcPs) where
  markAST :: SrcSpan -> ParStmtBlock GhcPs GhcPs -> Annotated ()
markAST _ (GHC.ParStmtBlock _ stmts :: [GuardLStmt GhcPs]
stmts _ns :: [IdP GhcPs]
_ns _) = do
    [GuardLStmt GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [GuardLStmt GhcPs]
stmts
  markAST _ (GHC.XParStmtBlock x :: XXParStmtBlock GhcPs GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XParStmtBlock for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXParStmtBlock GhcPs GhcPs
x

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

instance Annotate (GHC.HsLocalBinds GHC.GhcPs) where
  markAST :: SrcSpan -> HsLocalBinds GhcPs -> Annotated ()
markAST _ lb :: HsLocalBinds GhcPs
lb = HsLocalBinds GhcPs -> Annotated ()
markHsLocalBinds HsLocalBinds GhcPs
lb

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

markHsLocalBinds :: GHC.HsLocalBinds GHC.GhcPs -> Annotated ()
markHsLocalBinds :: HsLocalBinds GhcPs -> Annotated ()
markHsLocalBinds (GHC.HsValBinds _ (GHC.ValBinds _ binds :: LHsBinds GhcPs
binds sigs :: [GenLocated SrcSpan (Sig GhcPs)]
sigs)) =
    [(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
       )
markHsLocalBinds (GHC.HsIPBinds _ (GHC.IPBinds _ binds :: [LIPBind GhcPs]
binds)) = [LIPBind GhcPs] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LIPBind GhcPs]
binds
markHsLocalBinds GHC.EmptyLocalBinds{}                   = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

markHsLocalBinds (GHC.HsValBinds _ (GHC.XValBindsLR _)) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markHsLocalBinds:got extension"
markHsLocalBinds (GHC.HsIPBinds _ (GHC.XHsIPBinds _))   = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markHsLocalBinds:got extension"
markHsLocalBinds (GHC.XHsLocalBindsLR _)                = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markHsLocalBinds:got extension"

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

markMatchGroup :: (Annotate body)
                   => GHC.SrcSpan -> GHC.MatchGroup GHC.GhcPs (GHC.Located body)
                   -> Annotated ()
markMatchGroup :: SrcSpan -> MatchGroup GhcPs (Located body) -> Annotated ()
markMatchGroup _ (GHC.MG _ (GHC.L _ matches :: [LMatch GhcPs (Located body)]
matches) _)
  = 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
AdvanceLine) 2 (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ [LMatch GhcPs (Located body)] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LMatch GhcPs (Located body)]
matches
markMatchGroup _ (GHC.XMatchGroup x :: XXMatchGroup GhcPs (Located body)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XMatchGroup for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXMatchGroup GhcPs (Located body)
x

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

instance (Annotate body)
  => Annotate [GHC.Located (GHC.Match GHC.GhcPs (GHC.Located body))] where
  markAST :: SrcSpan -> [Located (Match GhcPs (Located body))] -> Annotated ()
markAST _ ls :: [Located (Match GhcPs (Located body))]
ls = (Located (Match GhcPs (Located body)) -> Annotated ())
-> [Located (Match GhcPs (Located body))] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Located (Match GhcPs (Located body)) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [Located (Match GhcPs (Located body))]
ls

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

instance Annotate (GHC.HsExpr GHC.GhcPs) where
  markAST :: SrcSpan -> HsExpr GhcPs -> Annotated ()
markAST loc :: SrcSpan
loc expr :: HsExpr GhcPs
expr = do
    SrcSpan -> HsExpr GhcPs -> Annotated ()
markExpr SrcSpan
loc HsExpr GhcPs
expr
    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
    -- TODO: If the AnnComma is not needed, revert to markAST
    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
   where
      markExpr :: SrcSpan -> HsExpr GhcPs -> Annotated ()
markExpr _ (GHC.HsVar _ n :: Located (IdP GhcPs)
n) = 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
        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
PrefixOp)
          (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
n)
          (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
InfixOp)
            (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
n)
            (Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (IdP GhcPs)
Located RdrName
n)
            )

      markExpr l :: SrcSpan
l (GHC.HsRecFld _ f :: AmbiguousFieldOcc GhcPs
f) = SrcSpan -> AmbiguousFieldOcc GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l AmbiguousFieldOcc GhcPs
f

      markExpr l :: SrcSpan
l (GHC.HsOverLabel _ _ fs :: FastString
fs)
        = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal ("#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FastString -> String
GHC.unpackFS FastString
fs)


      markExpr l :: SrcSpan
l (GHC.HsIPVar _ n :: HsIPName
n@(GHC.HsIPName _v :: FastString
_v))         =
        SrcSpan -> HsIPName -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsIPName
n
      markExpr l :: SrcSpan
l (GHC.HsOverLit _ ov :: HsOverLit GhcPs
ov)     = SrcSpan -> HsOverLit GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsOverLit GhcPs
ov
      markExpr l :: SrcSpan
l (GHC.HsLit _ lit :: HsLit GhcPs
lit)        = SrcSpan -> HsLit GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsLit GhcPs
lit

      markExpr _ (GHC.HsLam _ (GHC.MG _ (GHC.L _ [match :: LMatch GhcPs (Located (HsExpr GhcPs))
match]) _)) = do
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
LambdaExpr) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
        -- TODO: Change this, HsLam binds do not need obey layout rules.
        --       And will only ever have a single match
          LMatch GhcPs (Located (HsExpr GhcPs)) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LMatch GhcPs (Located (HsExpr GhcPs))
match
      markExpr _ (GHC.HsLam _ _) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "HsLam with other than one match"

      markExpr l :: SrcSpan
l (GHC.HsLamCase _ match :: MatchGroup GhcPs (Located (HsExpr GhcPs))
match) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLam
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCase
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnSemi
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
CaseAlt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
          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))
match
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC

      markExpr _ (GHC.HsApp _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2) = 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 (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
        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 (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2

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

      markExpr _ (GHC.OpApp _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2 e3 :: Located (HsExpr GhcPs)
e3) = do
        let
          isInfix :: Bool
isInfix = case Located (HsExpr GhcPs)
e2 of
            -- TODO: generalise this. Is it a fixity thing?
            GHC.L _ (GHC.HsVar{}) -> Bool
True
            _                     -> Bool
False

          normal :: Annotated ()
normal =
            -- When it is the leftmost item in a GRHS, e1 needs to have PrefixOp context
            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
LeftMost)
              (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]) 2 (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)
e1)
              (Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1)

        if Bool
isInfix
            then 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
PrefixOp) 2 (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)
e1
            else Annotated ()
normal

        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 (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2

        if Bool
isInfix
          then 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
PrefixOp) 2 (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)
e3
          else Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e3

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

      markExpr _ (GHC.NegApp _ e :: Located (HsExpr GhcPs)
e _) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnMinus
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e

      markExpr _ (GHC.HsPar _ e :: Located (HsExpr GhcPs)
e) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP -- '('
        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.AnnCloseP -- ')'

      markExpr _ (GHC.SectionL _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2) = do
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
        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 (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2

      markExpr _ (GHC.SectionR _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2) = do
        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 (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2

      markExpr _ (GHC.ExplicitTuple _ args :: [LHsTupArg GhcPs]
args b :: 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 "(#"

        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
$ (LHsTupArg GhcPs -> Annotated ())
-> Int -> [LHsTupArg GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LHsTupArg GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated 2 [LHsTupArg GhcPs]
args

        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 "#)"

      markExpr _ (GHC.ExplicitSum _ alt :: Int
alt arity :: Int
arity e :: Located (HsExpr GhcPs)
e) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen "(#"
        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
- 1) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e
        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 "#)"

      markExpr l :: SrcSpan
l (GHC.HsCase _ e1 :: Located (HsExpr GhcPs)
e1 matches :: MatchGroup GhcPs (Located (HsExpr GhcPs))
matches) = Annotated () -> Annotated ()
setRigidFlag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCase
        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
PrefixOp) 2 (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)
e1
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOf
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
        AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markInside AnnKeywordId
GHC.AnnSemi
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
CaseAlt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ 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))
matches
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC

      -- We set the layout for HsIf even though it need not obey layout rules as
      -- when moving these expressions it's useful that they maintain "internal
      -- integrity", that is to say the subparts remain indented relative to each
      -- other.
      markExpr _ (GHC.HsIf _ _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2 e3 :: Located (HsExpr GhcPs)
e3) = Annotated () -> Annotated ()
setLayoutFlag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      -- markExpr _ (GHC.HsIf _ e1 e2 e3) = setRigidFlag $ do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnIf
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
        AnnKeywordId -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> AnnKeywordId -> m ()
markAnnBeforeAnn AnnKeywordId
GHC.AnnSemi AnnKeywordId
GHC.AnnThen
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThen
        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
ListStart) 2 (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)
e2
        AnnKeywordId -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> AnnKeywordId -> m ()
markAnnBeforeAnn AnnKeywordId
GHC.AnnSemi AnnKeywordId
GHC.AnnElse
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnElse
        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
ListStart) 2 (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)
e3

      markExpr _ (GHC.HsMultiIf _ rhs :: [LGRHS GhcPs (Located (HsExpr GhcPs))]
rhs) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnIf
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
CaseAlt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
          -- mapM_ markLocated rhs
          [LGRHS GhcPs (Located (HsExpr GhcPs))] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LGRHS GhcPs (Located (HsExpr GhcPs))]
rhs
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC

      markExpr _ (GHC.HsLet _ (GHC.L _ binds :: HsLocalBinds GhcPs
binds) e :: Located (HsExpr GhcPs)
e) = do
        Annotated () -> Annotated ()
setLayoutFlag (do -- Make sure the 'in' gets indented too
          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
binds
          AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC
          AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnIn
          Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e)

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

      markExpr _ (GHC.HsDo _ cts :: HsStmtContext Name
cts (GHC.L _ es :: [GuardLStmt GhcPs]
es)) = do
        case HsStmtContext Name
cts of
          GHC.DoExpr  -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDo
          GHC.MDoExpr -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnMdo
          _           -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        let (ostr :: String
ostr,cstr :: String
cstr) =
              if HsStmtContext Name -> Bool
forall name. HsStmtContext name -> Bool
isListComp HsStmtContext Name
cts
                then ("[", "]")
                else ("{", "}")

        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsStmtContext Name -> Bool
forall name. HsStmtContext name -> Bool
isListComp HsStmtContext Name
cts) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
ostr
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenS
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
        AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markInside AnnKeywordId
GHC.AnnSemi
        if HsStmtContext Name -> Bool
forall name. HsStmtContext name -> Bool
isListComp HsStmtContext Name
cts
          then do
            GuardLStmt GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated ([GuardLStmt GhcPs] -> GuardLStmt GhcPs
forall a. [a] -> a
last [GuardLStmt GhcPs]
es)
            AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
            Annotated () -> Annotated ()
setLayoutFlag ([GuardLStmt GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate ([GuardLStmt GhcPs] -> [GuardLStmt GhcPs]
forall a. [a] -> [a]
init [GuardLStmt GhcPs]
es))
          else do
           [GuardLStmt GhcPs] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [GuardLStmt GhcPs]
es
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseS
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HsStmtContext Name -> Bool
forall name. HsStmtContext name -> Bool
isListComp HsStmtContext Name
cts) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose String
cstr

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

      markExpr _ (GHC.ExplicitList _ _ es :: [Located (HsExpr GhcPs)]
es) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS
        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 (HsExpr GhcPs) -> Annotated ())
-> Int -> [Located (HsExpr GhcPs)] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated 2 [Located (HsExpr GhcPs)]
es
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS

      markExpr _ (GHC.RecordCon _ n :: Located (IdP GhcPs)
n (GHC.HsRecFields fs :: [LHsRecField GhcPs (Located (HsExpr GhcPs))]
fs dd :: Maybe Int
dd)) = do
        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.AnnOpenC
        case Maybe Int
dd of
          Nothing -> [LHsRecField GhcPs (Located (HsExpr GhcPs))] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LHsRecField GhcPs (Located (HsExpr GhcPs))]
fs
          Just _ -> 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 (HsExpr GhcPs)) -> Annotated ())
-> [LHsRecField GhcPs (Located (HsExpr GhcPs))] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsRecField GhcPs (Located (HsExpr GhcPs)) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsRecField GhcPs (Located (HsExpr GhcPs))]
fs
            AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC

      markExpr _ (GHC.RecordUpd _ e :: Located (HsExpr GhcPs)
e fs :: [LHsRecUpdField GhcPs]
fs) = 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.AnnOpenC
        [LHsRecUpdField GhcPs] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
[ast] -> Annotated ()
markListIntercalate [LHsRecUpdField GhcPs]
fs
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC

      markExpr _ (GHC.ExprWithTySig _ e :: Located (HsExpr GhcPs)
e typ :: LHsSigWcType (NoGhcTc GhcPs)
typ) = do
        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
PrefixOp) 2 (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)
e
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
        LHsSigWcType GhcPs -> Annotated ()
markLHsSigWcType LHsSigWcType GhcPs
LHsSigWcType (NoGhcTc GhcPs)
typ

      markExpr _ (GHC.ArithSeq _ _ seqInfo :: ArithSeqInfo GhcPs
seqInfo) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenS -- '['
        case ArithSeqInfo GhcPs
seqInfo of
            GHC.From e :: Located (HsExpr GhcPs)
e -> 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.AnnDotdot
            GHC.FromTo e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2 -> do
              Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
              AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
              Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2
            GHC.FromThen e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2 -> do
              Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
              AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
              Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2
              AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
            GHC.FromThenTo e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2 e3 :: Located (HsExpr GhcPs)
e3 -> do
              Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
              AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnComma
              Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2
              AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
              Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e3
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseS -- ']'

      markExpr _ (GHC.HsSCC _ src :: SourceText
src csFStr :: StringLiteral
csFStr e :: Located (HsExpr GhcPs)
e) = do
        SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# SCC"
        let txt :: String
txt = SourceText -> String -> String
sourceTextToString (StringLiteral -> SourceText
GHC.sl_st StringLiteral
csFStr) (FastString -> String
GHC.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
GHC.sl_fs StringLiteral
csFStr)
        AnnKeywordId -> String -> Annotated ()
markWithStringOptional AnnKeywordId
GHC.AnnVal    String
txt
        AnnKeywordId -> String -> Annotated ()
markWithString         AnnKeywordId
GHC.AnnValStr String
txt
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#-}"
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e

      markExpr _ (GHC.HsCoreAnn _ src :: SourceText
src csFStr :: StringLiteral
csFStr e :: Located (HsExpr GhcPs)
e) = do
        -- markWithString GHC.AnnOpen src -- "{-# CORE"
        SourceText -> String -> Annotated ()
markAnnOpen SourceText
src "{-# CORE"
        -- markWithString GHC.AnnVal (GHC.sl_st csFStr)
        SourceText -> String -> Annotated ()
markSourceText (StringLiteral -> SourceText
GHC.sl_st StringLiteral
csFStr) (FastString -> String
GHC.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
GHC.sl_fs StringLiteral
csFStr)
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#-}"
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e
      -- TODO: make monomorphic
      markExpr l :: SrcSpan
l (GHC.HsBracket _ (GHC.VarBr _ True v :: IdP GhcPs
v)) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnSimpleQuote
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOpDollar) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Located RdrName -> Annotated ()
forall ast.
Annotate ast =>
AnnKeywordId -> Located ast -> Annotated ()
markLocatedFromKw AnnKeywordId
GHC.AnnName (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l IdP GhcPs
RdrName
v)
      markExpr l :: SrcSpan
l (GHC.HsBracket _ (GHC.VarBr _ False v :: IdP GhcPs
v)) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThTyQuote
        AnnKeywordId -> Located RdrName -> Annotated ()
forall ast.
Annotate ast =>
AnnKeywordId -> Located ast -> Annotated ()
markLocatedFromKw AnnKeywordId
GHC.AnnName (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l IdP GhcPs
RdrName
v)
      markExpr _ (GHC.HsBracket _ (GHC.DecBrL _ ds :: [LHsDecl GhcPs]
ds)) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen "[d|"
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
        Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
NoAdvanceLine)
             (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. a -> Set a
Set.singleton AstContext
TopLevel) 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]
ds
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseQ -- "|]"
      -- Introduced after the renamer
      markExpr _ (GHC.HsBracket _ (GHC.DecBrG _ _)) =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: DecBrG introduced after renamer"
      markExpr _l :: SrcSpan
_l (GHC.HsBracket _ (GHC.ExpBr _ e :: Located (HsExpr GhcPs)
e)) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenEQ -- "[|"
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenE  -- "[e|"
        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.AnnCloseQ -- "|]"
      markExpr _l :: SrcSpan
_l (GHC.HsBracket _ (GHC.TExpBr _ e :: Located (HsExpr GhcPs)
e)) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen  "[||"
        AnnKeywordId -> String -> Annotated ()
markWithStringOptional AnnKeywordId
GHC.AnnOpenE "[e||"
        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 "||]"
      markExpr _ (GHC.HsBracket _ (GHC.TypBr _ e :: LHsType GhcPs
e)) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen "[t|"
        LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
e
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseQ -- "|]"
      markExpr _ (GHC.HsBracket _ (GHC.PatBr _ e :: LPat GhcPs
e)) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen  "[p|"
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
e
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseQ -- "|]"

      markExpr _ (GHC.HsRnBracketOut {}) =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: HsRnBracketOut introduced after renamer"
      markExpr _ (GHC.HsTcBracketOut {}) =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: HsTcBracketOut introduced after renamer"

      markExpr l :: SrcSpan
l (GHC.HsSpliceE _ e :: HsSplice GhcPs
e) = SrcSpan -> HsSplice GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l HsSplice GhcPs
e

      markExpr _ (GHC.HsProc _ p :: LPat GhcPs
p c :: LHsCmdTop GhcPs
c) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnProc
        LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
p
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow
        LHsCmdTop GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsCmdTop GhcPs
c

      markExpr _ (GHC.HsStatic _ e :: Located (HsExpr GhcPs)
e) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnStatic
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e

      markExpr _ (GHC.HsArrApp _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2  o :: HsArrAppType
o isRightToLeft :: Bool
isRightToLeft) = do
            -- isRightToLeft True  => right-to-left (f -< arg)
            --               False => left-to-right (arg >- f)
        if Bool
isRightToLeft
          then do
            Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
            case HsArrAppType
o of
              GHC.HsFirstOrderApp  -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.Annlarrowtail
              GHC.HsHigherOrderApp -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLarrowtail
          else do
            Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2
            case HsArrAppType
o of
              GHC.HsFirstOrderApp  -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.Annrarrowtail
              GHC.HsHigherOrderApp -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrowtail

        if Bool
isRightToLeft
          then Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2
          else Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1

      markExpr _ (GHC.HsArrForm _ e :: Located (HsExpr GhcPs)
e _ cs :: [LHsCmdTop GhcPs]
cs) = do
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpenB "(|"
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e
        (LHsCmdTop GhcPs -> Annotated ())
-> [LHsCmdTop GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsCmdTop GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsCmdTop GhcPs]
cs
        AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnCloseB "|)"

      markExpr _ (GHC.HsTick {}) = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      markExpr _ (GHC.HsBinTick {}) = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      markExpr _ (GHC.HsTickPragma _ src :: SourceText
src (str :: StringLiteral
str,(v1 :: Int
v1,v2 :: Int
v2),(v3 :: Int
v3,v4 :: Int
v4)) ((s1 :: SourceText
s1,s2 :: SourceText
s2),(s3 :: SourceText
s3,s4 :: SourceText
s4)) e :: Located (HsExpr GhcPs)
e) = do
        -- '{-# GENERATED' STRING INTEGER ':' INTEGER '-' INTEGER ':' INTEGER '#-}'
        SourceText -> String -> Annotated ()
markAnnOpen SourceText
src  "{-# GENERATED"
        AnnKeywordId -> Int -> String -> Annotated ()
markOffsetWithString AnnKeywordId
GHC.AnnVal 0 (StringLiteral -> String
stringLiteralToString StringLiteral
str) -- STRING

        let
          markOne :: Int -> a -> SourceText -> Annotated ()
markOne n :: Int
n  v :: a
v GHC.NoSourceText   = AnnKeywordId -> Int -> String -> Annotated ()
markOffsetWithString AnnKeywordId
GHC.AnnVal Int
n (a -> String
forall a. Show a => a -> String
show a
v)
          markOne n :: Int
n _v :: a
_v (GHC.SourceText s :: String
s) = AnnKeywordId -> Int -> String -> Annotated ()
markOffsetWithString AnnKeywordId
GHC.AnnVal Int
n String
s

        Int -> Int -> SourceText -> Annotated ()
forall a. Show a => Int -> a -> SourceText -> Annotated ()
markOne  1 Int
v1 SourceText
s1 -- INTEGER
        AnnKeywordId -> Int -> Annotated ()
markOffset AnnKeywordId
GHC.AnnColon 0 -- ':'
        Int -> Int -> SourceText -> Annotated ()
forall a. Show a => Int -> a -> SourceText -> Annotated ()
markOne  2 Int
v2 SourceText
s2 -- INTEGER
        AnnKeywordId -> Annotated ()
mark   AnnKeywordId
GHC.AnnMinus   -- '-'
        Int -> Int -> SourceText -> Annotated ()
forall a. Show a => Int -> a -> SourceText -> Annotated ()
markOne  3 Int
v3 SourceText
s3 -- INTEGER
        AnnKeywordId -> Int -> Annotated ()
markOffset AnnKeywordId
GHC.AnnColon 1 -- ':'
        Int -> Int -> SourceText -> Annotated ()
forall a. Show a => Int -> a -> SourceText -> Annotated ()
markOne  4 Int
v4 SourceText
s4 -- INTEGER
        AnnKeywordId -> String -> Annotated ()
markWithString   AnnKeywordId
GHC.AnnClose  "#-}"
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e

      markExpr l :: SrcSpan
l (GHC.EWildPat _) = do
        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
InfixOp])
          (do  AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBackquote
               AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnVal "_"
               AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnBackquote)
          (SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "_")

      markExpr _ (GHC.EAsPat _ ln :: Located (IdP GhcPs)
ln e :: Located (HsExpr GhcPs)
e) = 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 (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e

      markExpr _ (GHC.EViewPat _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2) = do
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2

      markExpr _ (GHC.ELazyPat _ e :: Located (HsExpr GhcPs)
e) = do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnTilde
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e

      markExpr _ (GHC.HsAppType _ e :: Located (HsExpr GhcPs)
e ty :: LHsWcType (NoGhcTc GhcPs)
ty) = do
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e
        AnnKeywordId -> KeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> KeywordId -> m ()
markInstead AnnKeywordId
GHC.AnnAt KeywordId
AnnTypeApp
        LHsWcType GhcPs -> Annotated ()
markLHsWcType LHsWcType GhcPs
LHsWcType (NoGhcTc GhcPs)
ty

      markExpr _ (GHC.HsWrap {}) =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: HsWrap introduced after renaming"
      markExpr _ (GHC.HsUnboundVar {}) =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: HsUnboundVar introduced after renaming"

      markExpr _ (GHC.HsConLikeOut{}) =
        String -> Annotated ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM "warning: HsConLikeOut introduced after type checking"

      markExpr _ (GHC.HsBracket _ (GHC.XBracket _)) = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markExpr got extension"
      markExpr _ (GHC.XExpr _)                      = String -> Annotated ()
forall a. HasCallStack => String -> a
error "markExpr got extension"

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

markLHsWcType :: GHC.LHsWcType GHC.GhcPs -> Annotated ()
markLHsWcType :: LHsWcType GhcPs -> Annotated ()
markLHsWcType (GHC.HsWC _ ty :: LHsType GhcPs
ty) = do
  LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
ty
markLHsWcType (GHC.XHsWildCardBndrs x :: XXHsWildCardBndrs GhcPs (LHsType GhcPs)
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "markLHsWcType got :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXHsWildCardBndrs GhcPs (LHsType GhcPs)
x

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

instance Annotate (GHC.HsLit GHC.GhcPs) where
  markAST :: SrcSpan -> HsLit GhcPs -> Annotated ()
markAST l :: SrcSpan
l lit :: HsLit GhcPs
lit = SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal (HsLit GhcPs -> String
hsLit2String HsLit GhcPs
lit)

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

instance Annotate (GHC.HsRecUpdField GHC.GhcPs) where
  markAST :: SrcSpan -> HsRecUpdField GhcPs -> Annotated ()
markAST _ (GHC.HsRecField lbl :: Located (AmbiguousFieldOcc GhcPs)
lbl expr :: Located (HsExpr GhcPs)
expr punFlag :: Bool
punFlag) = 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 (AmbiguousFieldOcc GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (AmbiguousFieldOcc GhcPs)
lbl
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
punFlag Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
      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)
expr
    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.AmbiguousFieldOcc GHC.GhcPs) where
  markAST :: SrcSpan -> AmbiguousFieldOcc GhcPs -> Annotated ()
markAST _ (GHC.Unambiguous _ n :: Located RdrName
n) = Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
n
  markAST _ (GHC.Ambiguous   _ n :: Located RdrName
n) = Located RdrName -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located RdrName
n
  markAST _ (GHC.XAmbiguousFieldOcc x :: XXAmbiguousFieldOcc GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XAmbiguousFieldOcc for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXAmbiguousFieldOcc GhcPs
x

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

-- |Used for declarations that need to be aligned together, e.g. in a
-- do or let .. in statement/expr
instance Annotate [GHC.ExprLStmt GHC.GhcPs] where
  markAST :: SrcSpan -> [GuardLStmt GhcPs] -> Annotated ()
markAST _ ls :: [GuardLStmt GhcPs]
ls = (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]
ls

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

instance Annotate (GHC.HsTupArg GHC.GhcPs) where
  markAST :: SrcSpan -> HsTupArg GhcPs -> Annotated ()
markAST _ (GHC.Present _ (GHC.L l :: SrcSpan
l e :: HsExpr GhcPs
e)) = do
    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> HsExpr GhcPs -> Located (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l HsExpr GhcPs
e)
    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 -> KeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> KeywordId -> m ()
markOutside AnnKeywordId
GHC.AnnComma (AnnKeywordId -> KeywordId
G AnnKeywordId
GHC.AnnComma)

  markAST _ (GHC.Missing _) = do
    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 _ (GHC.XTupArg x :: XXTupArg GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XTupArg got:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXTupArg GhcPs
x

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

instance Annotate (GHC.HsCmdTop GHC.GhcPs) where
  markAST :: SrcSpan -> HsCmdTop GhcPs -> Annotated ()
markAST _ (GHC.HsCmdTop _ cmd :: LHsCmd GhcPs
cmd) = LHsCmd GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsCmd GhcPs
cmd
  markAST _ (GHC.XCmdTop x :: XXCmdTop GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XCmdTop for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXCmdTop GhcPs
x

instance Annotate (GHC.HsCmd GHC.GhcPs) where
  markAST :: SrcSpan -> HsCmd GhcPs -> Annotated ()
markAST _ (GHC.HsCmdArrApp _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: Located (HsExpr GhcPs)
e2 o :: HsArrAppType
o isRightToLeft :: Bool
isRightToLeft) = do
        -- isRightToLeft True  => right-to-left (f -< arg)
        --               False => left-to-right (arg >- f)
    if Bool
isRightToLeft
      then do
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
        case HsArrAppType
o of
          GHC.HsFirstOrderApp  -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.Annlarrowtail
          GHC.HsHigherOrderApp -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLarrowtail
      else do
        Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2
        case HsArrAppType
o of
          GHC.HsFirstOrderApp  -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.Annrarrowtail
          GHC.HsHigherOrderApp -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrowtail

    if Bool
isRightToLeft
      then Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2
      else Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1

  markAST _ (GHC.HsCmdArrForm _ e :: Located (HsExpr GhcPs)
e fixity :: LexicalFixity
fixity _mf :: Maybe Fixity
_mf cs :: [LHsCmdTop GhcPs]
cs) = do
    -- The AnnOpen should be marked for a prefix usage, not for a postfix one,
    -- due to the way checkCmd maps both HsArrForm and OpApp to HsCmdArrForm

    let isPrefixOp :: Bool
isPrefixOp = case LexicalFixity
fixity of
          GHC.Infix  -> Bool
False
          GHC.Prefix -> Bool
True
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isPrefixOp (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenB -- "(|"

    -- This may be an infix operation
    ListContexts -> [(SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotationsContexts (Set AstContext
-> Set AstContext
-> Set AstContext
-> Set AstContext
-> ListContexts
LC (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp) (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
PrefixOp)
                                     (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp) (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InfixOp))
                       ([Located (HsExpr GhcPs)] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [Located (HsExpr GhcPs)
e]
                         [(SrcSpan, Annotated ())]
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LHsCmdTop GhcPs] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [LHsCmdTop GhcPs]
cs)
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isPrefixOp (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseB -- "|)"

  markAST _ (GHC.HsCmdApp _ e1 :: LHsCmd GhcPs
e1 e2 :: Located (HsExpr GhcPs)
e2) = do
    LHsCmd GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsCmd GhcPs
e1
    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e2

  markAST l :: SrcSpan
l (GHC.HsCmdLam _ match :: MatchGroup GhcPs (LHsCmd GhcPs)
match) = do
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
LambdaExpr) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do SrcSpan -> MatchGroup GhcPs (LHsCmd GhcPs) -> Annotated ()
forall body.
Annotate body =>
SrcSpan -> MatchGroup GhcPs (Located body) -> Annotated ()
markMatchGroup SrcSpan
l MatchGroup GhcPs (LHsCmd GhcPs)
match

  markAST _ (GHC.HsCmdPar _ e :: LHsCmd GhcPs
e) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenP
    LHsCmd GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsCmd GhcPs
e
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseP -- ')'

  markAST l :: SrcSpan
l (GHC.HsCmdCase _ e1 :: Located (HsExpr GhcPs)
e1 matches :: MatchGroup GhcPs (LHsCmd GhcPs)
matches) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCase
    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOf
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
CaseAlt) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      SrcSpan -> MatchGroup GhcPs (LHsCmd GhcPs) -> Annotated ()
forall body.
Annotate body =>
SrcSpan -> MatchGroup GhcPs (Located body) -> Annotated ()
markMatchGroup SrcSpan
l MatchGroup GhcPs (LHsCmd GhcPs)
matches
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC

  markAST _ (GHC.HsCmdIf _ _ e1 :: Located (HsExpr GhcPs)
e1 e2 :: LHsCmd GhcPs
e2 e3 :: LHsCmd GhcPs
e3) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnIf
    Located (HsExpr GhcPs) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located (HsExpr GhcPs)
e1
    AnnKeywordId -> Int -> Annotated ()
markOffset AnnKeywordId
GHC.AnnSemi 0
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnThen
    LHsCmd GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsCmd GhcPs
e2
    AnnKeywordId -> Int -> Annotated ()
markOffset AnnKeywordId
GHC.AnnSemi 1
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnElse
    LHsCmd GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsCmd GhcPs
e3

  markAST _ (GHC.HsCmdLet _ (GHC.L _ binds :: HsLocalBinds GhcPs
binds) e :: LHsCmd GhcPs
e) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnLet
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
    HsLocalBinds GhcPs -> Annotated ()
markLocalBindsWithLayout HsLocalBinds GhcPs
binds
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnIn
    LHsCmd GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsCmd GhcPs
e

  markAST _ (GHC.HsCmdDo _ (GHC.L _ es :: [CmdLStmt GhcPs]
es)) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDo
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
    [CmdLStmt GhcPs] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [CmdLStmt GhcPs]
es
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC

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

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

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

instance Annotate [GHC.Located (GHC.StmtLR GHC.GhcPs GHC.GhcPs (GHC.LHsCmd GHC.GhcPs))] where
  markAST :: SrcSpan -> [CmdLStmt GhcPs] -> Annotated ()
markAST _ ls :: [CmdLStmt GhcPs]
ls = (CmdLStmt GhcPs -> Annotated ())
-> [CmdLStmt GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CmdLStmt GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [CmdLStmt GhcPs]
ls

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

instance Annotate (GHC.TyClDecl GHC.GhcPs) where

  markAST :: SrcSpan -> TyClDecl GhcPs -> Annotated ()
markAST l :: SrcSpan
l (GHC.FamDecl _ famdecl :: FamilyDecl GhcPs
famdecl) = SrcSpan -> FamilyDecl GhcPs -> Annotated ()
forall ast. Annotate ast => SrcSpan -> ast -> Annotated ()
markAST SrcSpan
l FamilyDecl GhcPs
famdecl Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Annotated ()
markTrailingSemi
{-
    SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs
            , tcdLName  :: Located (IdP pass)     -- ^ Type constructor
            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
                                                  -- associated type these
                                                  -- include outer binders
            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
            , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration

-}
  markAST _ (GHC.SynDecl _ ln :: Located (IdP GhcPs)
ln (GHC.HsQTvs _ tyvars :: [LHsTyVarBndr GhcPs]
tyvars) fixity :: LexicalFixity
fixity typ :: LHsType GhcPs
typ) = do
    -- There may be arbitrary parens around parts of the constructor that are
    -- infix.
    -- Turn these into comments so that they feed into the right place automatically
    -- annotationsToComments [GHC.AnnOpenP,GHC.AnnCloseP]
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType

    Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> [LHsTyVarBndr GhcPs]
-> Annotated ()
forall ast a.
(Data (SrcSpanLess ast), Annotate a, HasOccName a, Annotate ast,
 HasSrcSpan ast) =>
Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> [ast] -> Annotated ()
markTyClass Maybe [LHsTyVarBndr GhcPs]
forall a. Maybe a
Nothing LexicalFixity
fixity Located (IdP GhcPs)
Located RdrName
ln [LHsTyVarBndr GhcPs]
tyvars
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
    Annotated ()
markTrailingSemi

  markAST _ (GHC.DataDecl _ ln :: Located (IdP GhcPs)
ln (GHC.HsQTvs _ tyVars :: [LHsTyVarBndr GhcPs]
tyVars) fixity :: LexicalFixity
fixity
                (GHC.HsDataDefn _ nd :: NewOrData
nd ctx :: LHsContext GhcPs
ctx mctyp :: Maybe (Located CType)
mctyp mk :: Maybe (LHsType GhcPs)
mk cons :: [LConDecl GhcPs]
cons derivs :: HsDeriving GhcPs
derivs)) = do
    if NewOrData
nd NewOrData -> NewOrData -> Bool
forall a. Eq a => a -> a -> Bool
== NewOrData
GHC.DataType
      then AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnData
      else AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnNewtype
    Maybe (Located CType) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (Located CType)
mctyp
    LHsContext GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsContext GhcPs
ctx
    Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> [LHsTyVarBndr GhcPs]
-> Annotated ()
forall ast a.
(Data (SrcSpanLess ast), Annotate a, HasOccName a, Annotate ast,
 HasSrcSpan ast) =>
Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> [ast] -> Annotated ()
markTyClass Maybe [LHsTyVarBndr GhcPs]
forall a. Maybe a
Nothing LexicalFixity
fixity Located (IdP GhcPs)
Located RdrName
ln [LHsTyVarBndr GhcPs]
tyVars
    case Maybe (LHsType GhcPs)
mk of
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just k :: LHsType GhcPs
k -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
        LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
k
    if [LConDecl GhcPs] -> Bool
forall name. [LConDecl name] -> Bool
isGadt [LConDecl GhcPs]
cons
      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
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnWhere
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC
    Annotated () -> Annotated ()
setLayoutFlag (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
NoPrecedingSpace)
                  (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ ListContexts -> [LConDecl GhcPs] -> Annotated ()
forall ast.
Annotate ast =>
ListContexts -> [Located ast] -> Annotated ()
markListWithContexts' ListContexts
listContexts [LConDecl GhcPs]
cons
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC
    Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
Deriving,AstContext
NoDarrow]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ HsDeriving GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated HsDeriving GhcPs
derivs
    Annotated ()
markTrailingSemi

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

  markAST _ (GHC.ClassDecl _ ctx :: LHsContext GhcPs
ctx ln :: Located (IdP GhcPs)
ln (GHC.HsQTvs _ tyVars :: [LHsTyVarBndr GhcPs]
tyVars) fixity :: LexicalFixity
fixity fds :: [LHsFunDep GhcPs]
fds
                          sigs :: [GenLocated SrcSpan (Sig GhcPs)]
sigs meths :: LHsBinds GhcPs
meths ats :: [LFamilyDecl GhcPs]
ats atdefs :: [LTyFamDefltEqn GhcPs]
atdefs docs :: [GenLocated SrcSpan DocDecl]
docs) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnClass
    LHsContext GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsContext GhcPs
ctx

    Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> [LHsTyVarBndr GhcPs]
-> Annotated ()
forall ast a.
(Data (SrcSpanLess ast), Annotate a, HasOccName a, Annotate ast,
 HasSrcSpan ast) =>
Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> [ast] -> Annotated ()
markTyClass Maybe [LHsTyVarBndr GhcPs]
forall a. Maybe a
Nothing LexicalFixity
fixity Located (IdP GhcPs)
Located RdrName
ln [LHsTyVarBndr GhcPs]
tyVars

    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located (FunDep (Located RdrName))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsFunDep GhcPs]
[Located (FunDep (Located RdrName))]
fds) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
      (Located (FunDep (Located RdrName)) -> Annotated ())
-> Int -> [Located (FunDep (Located RdrName))] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel Located (FunDep (Located RdrName)) -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated 2 [LHsFunDep GhcPs]
[Located (FunDep (Located RdrName))]
fds
    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
    -- AZ:TODO: we end up with both the tyVars and the following body of the
    -- class defn in annSortKey for the class. This could cause problems when
    -- changing things.
    Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
InClassDecl) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$
      [(SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotationsLayout
                           ([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]
++ [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
meths)
                         [(SrcSpan, Annotated ())]
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LFamilyDecl GhcPs] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [LFamilyDecl GhcPs]
ats
                         [(SrcSpan, Annotated ())]
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [LTyFamDefltEqn GhcPs] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [LTyFamDefltEqn GhcPs]
atdefs
                         [(SrcSpan, Annotated ())]
-> [(SrcSpan, Annotated ())] -> [(SrcSpan, Annotated ())]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpan DocDecl] -> [(SrcSpan, Annotated ())]
forall a. Annotate a => [Located a] -> [(SrcSpan, Annotated ())]
prepareListAnnotation [GenLocated SrcSpan DocDecl]
docs
                           )
    AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC -- '}'
    Annotated ()
markTrailingSemi
{-
  | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs
                tcdCtxt    :: LHsContext pass,         -- ^ Context...
                tcdLName   :: Located (IdP pass),      -- ^ Name of the class
                tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables
                tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration
                tcdFDs     :: [Located (FunDep (Located (IdP pass)))],
                                                        -- ^ Functional deps
                tcdSigs    :: [LSig pass],              -- ^ Methods' signatures
                tcdMeths   :: LHsBinds pass,            -- ^ Default methods
                tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;
                tcdATDefs  :: [LTyFamDefltEqn pass],
                                                   -- ^ Associated type defaults
                tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
    }

-}

  markAST _ (GHC.SynDecl _ _ (GHC.XLHsQTyVars _) _ _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for TyClDecl"
  markAST _ (GHC.DataDecl _ _ (GHC.HsQTvs _ _) _ (GHC.XHsDataDefn _))
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for TyClDecl"
  markAST _ (GHC.DataDecl _ _ (GHC.XLHsQTyVars _) _ _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for TyClDecl"
  markAST _ (GHC.ClassDecl _ _ _ (GHC.XLHsQTyVars _) _ _ _ _ _ _ _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for TyClDecl"
  markAST _ (GHC.XTyClDecl _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "extension hit for TyClDecl"

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

markTypeApp :: GHC.SrcSpan -> Annotated ()
markTypeApp :: SrcSpan -> Annotated ()
markTypeApp loc :: SrcSpan
loc = do
  let l :: SrcSpan
l = SrcSpan -> SrcSpan
GHC.srcSpanFirstCharacter SrcSpan
loc
  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal "@"

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

markTyClassArgs :: (Annotate a, GHC.HasOccName a)
            => Maybe [GHC.LHsTyVarBndr GhcPs] -> GHC.LexicalFixity
            -- -> GHC.Located a -> [ast] -> Annotated ()
            -> GHC.Located a -> [GHC.LHsTypeArg GhcPs] -> Annotated ()
markTyClassArgs :: Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> HsTyPats GhcPs -> Annotated ()
markTyClassArgs mbndrs :: Maybe [LHsTyVarBndr GhcPs]
mbndrs fixity :: LexicalFixity
fixity ln :: Located a
ln tyVars :: HsTyPats GhcPs
tyVars = do
  let
    cvt :: HsArg ast ast -> Annotated ()
cvt (GHC.HsValArg  val :: ast
val) = ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated ast
val
    cvt (GHC.HsTypeArg loc :: SrcSpan
loc typ :: ast
typ) = do
      SrcSpan -> Annotated ()
markTypeApp SrcSpan
loc
      -- let l = GHC.srcSpanFirstCharacter loc
      -- markExternal l GHC.AnnVal "@"
      ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated ast
typ
    cvt (GHC.HsArgPar _ss :: SrcSpan
_ss) = Annotated ()
forall a. HasCallStack => a
undefined
  (HsArg (LHsType GhcPs) (LHsType GhcPs) -> Annotated ())
-> Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located a
-> HsTyPats GhcPs
-> Annotated ()
forall a b.
(Annotate a, HasOccName a) =>
(b -> Annotated ())
-> Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located a
-> [b]
-> Annotated ()
markTyClassWorker HsArg (LHsType GhcPs) (LHsType GhcPs) -> Annotated ()
forall ast ast.
(Annotate ast, Annotate ast, HasSrcSpan ast, HasSrcSpan ast,
 Data (SrcSpanLess ast), Data (SrcSpanLess ast)) =>
HsArg ast ast -> Annotated ()
cvt Maybe [LHsTyVarBndr GhcPs]
mbndrs LexicalFixity
fixity Located a
ln HsTyPats GhcPs
tyVars
    {-
type LHsTypeArg p = HsArg (LHsType p) (LHsKind p)

data HsArg tm ty
  = HsValArg tm   -- Argument is an ordinary expression     (f arg)
  | HsTypeArg  ty -- Argument is a visible type application (f @ty)
  | HsArgPar SrcSpan -- See Note [HsArgPar]
-}

-- TODO:AZ: simplify
markTyClass :: (Data (GHC.SrcSpanLess ast), Annotate a, GHC.HasOccName a, Annotate ast,GHC.HasSrcSpan ast)
            => Maybe [GHC.LHsTyVarBndr GhcPs] -> GHC.LexicalFixity
            -> GHC.Located a -> [ast] -> Annotated ()
markTyClass :: Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> [ast] -> Annotated ()
markTyClass = (ast -> Annotated ())
-> Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located a
-> [ast]
-> Annotated ()
forall a b.
(Annotate a, HasOccName a) =>
(b -> Annotated ())
-> Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located a
-> [b]
-> Annotated ()
markTyClassWorker ast -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated

markTyClassWorker :: (Annotate a, GHC.HasOccName a)
            => (b -> Annotated ()) -> Maybe [GHC.LHsTyVarBndr GhcPs] -> GHC.LexicalFixity
            -- -> GHC.Located a -> [ast] -> Annotated ()
            -> GHC.Located a -> [b] -> Annotated ()
markTyClassWorker :: (b -> Annotated ())
-> Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located a
-> [b]
-> Annotated ()
markTyClassWorker markFn :: b -> Annotated ()
markFn mbndrs :: Maybe [LHsTyVarBndr GhcPs]
mbndrs fixity :: LexicalFixity
fixity ln :: Located a
ln tyVars :: [b]
tyVars = do
    let processBinders :: Annotated ()
processBinders =
          case Maybe [LHsTyVarBndr GhcPs]
mbndrs of
            Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just bndrs :: [LHsTyVarBndr 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]
bndrs
              AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDot

    -- There may be arbitrary parens around parts of the constructor
    -- Turn these into comments so that they feed into the right place automatically
    [AnnKeywordId] -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
[AnnKeywordId] -> m ()
annotationsToComments [AnnKeywordId
GHC.AnnOpenP,AnnKeywordId
GHC.AnnCloseP]
    let markParens :: AnnKeywordId -> Annotated ()
markParens = if LexicalFixity
fixity LexicalFixity -> LexicalFixity -> Bool
forall a. Eq a => a -> a -> Bool
== LexicalFixity
GHC.Infix Bool -> Bool -> Bool
&& [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
tyVars Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2
          then AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany
          else AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional
    if LexicalFixity
fixity LexicalFixity -> LexicalFixity -> Bool
forall a. Eq a => a -> a -> Bool
== LexicalFixity
GHC.Prefix
      then do
        AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional AnnKeywordId
GHC.AnnOpenP
        Annotated ()
processBinders
        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 a -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located a
ln
        -- setContext (Set.singleton PrefixOp) $ mapM_ markLocated tyVars
        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
$ (b -> Annotated ()) -> [b] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> Annotated ()
markFn ([b] -> Annotated ()) -> [b] -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
take 2 [b]
tyVars
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
tyVars Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
          AnnKeywordId -> Annotated ()
markParens AnnKeywordId
GHC.AnnCloseP
          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
$ (b -> Annotated ()) -> [b] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> Annotated ()
markFn ([b] -> Annotated ()) -> [b] -> Annotated ()
forall a b. (a -> b) -> a -> b
$ Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
drop 2 [b]
tyVars
        AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional AnnKeywordId
GHC.AnnCloseP
      else do
        case [b]
tyVars of
          (x :: b
x:y :: b
y:xs :: [b]
xs) -> do
            AnnKeywordId -> Annotated ()
markParens AnnKeywordId
GHC.AnnOpenP
            Annotated ()
processBinders
            b -> Annotated ()
markFn b
x
            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 a -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located a
ln
            b -> Annotated ()
markFn b
y
            AnnKeywordId -> Annotated ()
markParens AnnKeywordId
GHC.AnnCloseP
            (b -> Annotated ()) -> [b] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> Annotated ()
markFn [b]
xs
            AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional AnnKeywordId
GHC.AnnCloseP
          _ -> String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "markTyClass: Infix op without operands"

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

instance Annotate [GHC.LHsDerivingClause GHC.GhcPs] where
  markAST :: SrcSpan -> [LHsDerivingClause GhcPs] -> Annotated ()
markAST _ ds :: [LHsDerivingClause GhcPs]
ds = (LHsDerivingClause GhcPs -> Annotated ())
-> [LHsDerivingClause GhcPs] -> Annotated ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LHsDerivingClause GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated [LHsDerivingClause GhcPs]
ds

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

instance Annotate (GHC.HsDerivingClause GHC.GhcPs) where
  markAST :: SrcSpan -> HsDerivingClause GhcPs -> Annotated ()
markAST _ (GHC.HsDerivingClause _ mstrategy :: Maybe (LDerivStrategy GhcPs)
mstrategy typs :: Located [HsImplicitBndrs GhcPs (LHsType GhcPs)]
typs) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDeriving
    case Maybe (LDerivStrategy GhcPs)
mstrategy of
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (GHC.L _ (GHC.ViaStrategy{})) -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just s :: LDerivStrategy GhcPs
s -> LDerivStrategy GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LDerivStrategy GhcPs
s
    Located [HsImplicitBndrs GhcPs (LHsType GhcPs)] -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated Located [HsImplicitBndrs GhcPs (LHsType GhcPs)]
typs
    case Maybe (LDerivStrategy GhcPs)
mstrategy of
      Just s :: LDerivStrategy GhcPs
s@(GHC.L _ (GHC.ViaStrategy{})) -> LDerivStrategy GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LDerivStrategy GhcPs
s
      _ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

{-
  = HsDerivingClause
    { deriv_clause_ext :: XCHsDerivingClause pass
    , deriv_clause_strategy :: Maybe (LDerivStrategy pass)
      -- ^ The user-specified strategy (if any) to use when deriving
      -- 'deriv_clause_tys'.
    , deriv_clause_tys :: Located [LHsSigType pass]
      -- ^ The types to derive.
      --
      -- It uses 'LHsSigType's because, with @-XGeneralizedNewtypeDeriving@,
      -- we can mention type variables that aren't bound by the datatype, e.g.
      --
      -- > data T b = ... deriving (C [a])
      --
      -- should produce a derived instance for @C [a] (T b)@.
    }

-}

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

instance Annotate (GHC.FamilyDecl GHC.GhcPs) where
  markAST :: SrcSpan -> FamilyDecl GhcPs -> Annotated ()
markAST _ (GHC.FamilyDecl _ info :: FamilyInfo GhcPs
info ln :: Located (IdP GhcPs)
ln (GHC.HsQTvs _ tyvars :: [LHsTyVarBndr GhcPs]
tyvars) fixity :: LexicalFixity
fixity rsig :: LFamilyResultSig GhcPs
rsig minj :: Maybe (LInjectivityAnn GhcPs)
minj) = do
    case FamilyInfo GhcPs
info of
      GHC.DataFamily -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnData
      _              -> AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType

    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnFamily

    Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> [LHsTyVarBndr GhcPs]
-> Annotated ()
forall ast a.
(Data (SrcSpanLess ast), Annotate a, HasOccName a, Annotate ast,
 HasSrcSpan ast) =>
Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> [ast] -> Annotated ()
markTyClass Maybe [LHsTyVarBndr GhcPs]
forall a. Maybe a
Nothing LexicalFixity
fixity Located (IdP GhcPs)
Located RdrName
ln [LHsTyVarBndr GhcPs]
tyvars
    case LFamilyResultSig GhcPs -> SrcSpanLess (LFamilyResultSig GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc LFamilyResultSig GhcPs
rsig of
      GHC.NoSig _ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      GHC.KindSig _ _ -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
        LFamilyResultSig GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LFamilyResultSig GhcPs
rsig
      GHC.TyVarSig _ _ -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
        LFamilyResultSig GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LFamilyResultSig GhcPs
rsig
      (GHC.XFamilyResultSig x) -> String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "FamilyDecl:got XFamilyResultSig for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXFamilyResultSig GhcPs
x
    case Maybe (LInjectivityAnn GhcPs)
minj of
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just inj :: LInjectivityAnn GhcPs
inj -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnVbar
        LInjectivityAnn GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LInjectivityAnn GhcPs
inj
    case FamilyInfo GhcPs
info of
      GHC.ClosedTypeFamily (Just eqns :: [LTyFamInstEqn GhcPs]
eqns) -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnOpenC -- {
        [LTyFamInstEqn GhcPs] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LTyFamInstEqn GhcPs]
eqns
        AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnCloseC -- }
      GHC.ClosedTypeFamily Nothing -> do
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnWhere
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnOpenC -- {
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDotdot
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnCloseC -- }
      _ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Annotated ()
markTrailingSemi

  markAST _ (GHC.FamilyDecl _ _ _ (GHC.XLHsQTyVars _) _ _ _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "got extension for FamilyDecl"
  markAST _ (GHC.XFamilyDecl _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "got extension for FamilyDecl"

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

instance Annotate (GHC.FamilyResultSig GHC.GhcPs) where
  markAST :: SrcSpan -> FamilyResultSig GhcPs -> Annotated ()
markAST _ (GHC.NoSig _)        = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  markAST _ (GHC.KindSig _ k :: LHsType GhcPs
k)    = LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
k
  markAST _ (GHC.TyVarSig _ ltv :: LHsTyVarBndr GhcPs
ltv) = LHsTyVarBndr GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsTyVarBndr GhcPs
ltv
  markAST _ (GHC.XFamilyResultSig x :: XXFamilyResultSig GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XFamilyResultSig for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXFamilyResultSig GhcPs
x

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

instance Annotate (GHC.InjectivityAnn GHC.GhcPs) where
  markAST :: SrcSpan -> InjectivityAnn GhcPs -> Annotated ()
markAST _ (GHC.InjectivityAnn ln :: Located (IdP GhcPs)
ln lns :: [Located (IdP GhcPs)]
lns) = 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.AnnRarrow
    (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]
lns

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

instance Annotate (GHC.TyFamInstEqn GHC.GhcPs) where
{-
type TyFamInstEqn pass = FamInstEqn pass (LHsType pass)

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

type HsTyPats pass = [LHsTypeArg pass]

-}
  markAST :: SrcSpan
-> HsImplicitBndrs
     GhcPs (FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs))
-> Annotated ()
markAST _ (GHC.HsIB _ eqn :: FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs)
eqn) = do
    FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs) -> Annotated ()
markFamEqn FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs)
eqn
    Annotated ()
markTrailingSemi
  markAST _ (GHC.XHsImplicitBndrs x :: XXHsImplicitBndrs
  GhcPs (FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs))
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XHsImplicitBndrs for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXHsImplicitBndrs
  GhcPs (FamEqn GhcPs (HsTyPats GhcPs) (LHsType GhcPs))
x

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

instance Annotate (GHC.TyFamDefltEqn GHC.GhcPs) where

  markAST :: SrcSpan -> TyFamDefltEqn GhcPs -> Annotated ()
markAST _ (GHC.FamEqn _ ln :: Located (IdP GhcPs)
ln mbndrs :: Maybe [LHsTyVarBndr GhcPs]
mbndrs (GHC.HsQTvs _ bndrs :: [LHsTyVarBndr GhcPs]
bndrs) fixity :: LexicalFixity
fixity typ :: LHsType GhcPs
typ) = do
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnType
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnInstance
    Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity
-> Located RdrName
-> [LHsTyVarBndr GhcPs]
-> Annotated ()
forall ast a.
(Data (SrcSpanLess ast), Annotate a, HasOccName a, Annotate ast,
 HasSrcSpan ast) =>
Maybe [LHsTyVarBndr GhcPs]
-> LexicalFixity -> Located a -> [ast] -> Annotated ()
markTyClass Maybe [LHsTyVarBndr GhcPs]
mbndrs LexicalFixity
fixity Located (IdP GhcPs)
Located RdrName
ln [LHsTyVarBndr GhcPs]
bndrs
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
{-
type TyFamDefltEqn pass = FamEqn pass (LHsQTyVars pass) (LHsType pass)

data LHsQTyVars pass   -- See Note [HsType binders]
  = HsQTvs { hsq_ext :: XHsQTvs pass

           , hsq_explicit :: [LHsTyVarBndr pass]
                -- Explicit variables, written by the user
                -- See Note [HsForAllTy tyvar binders]
    }


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
       }
-}

  markAST _ (GHC.FamEqn _ _ _ (GHC.XLHsQTyVars _) _ _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "TyFamDefltEqn hit extension point"
  markAST _ (GHC.XFamEqn _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "TyFamDefltEqn hit extension point"

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

-- TODO: modify lexer etc, in the meantime to not set haddock flag
instance Annotate GHC.DocDecl where
  markAST :: SrcSpan -> DocDecl -> Annotated ()
markAST l :: SrcSpan
l v :: DocDecl
v =
    let str :: String
str =
          case DocDecl
v of
            (GHC.DocCommentNext ds :: HsDocString
ds)     -> HsDocString -> String
GHC.unpackHDS HsDocString
ds
            (GHC.DocCommentPrev ds :: HsDocString
ds)     -> HsDocString -> String
GHC.unpackHDS HsDocString
ds
            (GHC.DocCommentNamed _s :: String
_s ds :: HsDocString
ds) -> HsDocString -> String
GHC.unpackHDS HsDocString
ds
            (GHC.DocGroup _i :: Int
_i ds :: HsDocString
ds)        -> HsDocString -> String
GHC.unpackHDS HsDocString
ds
    in
      SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
str Annotated () -> Annotated () -> Annotated ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Annotated ()
markTrailingSemi
{-
data DocDecl
  = DocCommentNext HsDocString
  | DocCommentPrev HsDocString
  | DocCommentNamed String HsDocString
  | DocGroup Int HsDocString

-}

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

markDataDefn :: GHC.SrcSpan -> GHC.HsDataDefn GHC.GhcPs -> Annotated ()
markDataDefn :: SrcSpan -> HsDataDefn GhcPs -> Annotated ()
markDataDefn _ (GHC.HsDataDefn _ _ ctx :: LHsContext GhcPs
ctx typ :: Maybe (Located CType)
typ _mk :: Maybe (LHsType GhcPs)
_mk cons :: [LConDecl GhcPs]
cons derivs :: HsDeriving GhcPs
derivs) = do
  LHsContext GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsContext GhcPs
ctx
  Maybe (Located CType) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (Located CType)
typ
  if [LConDecl GhcPs] -> Bool
forall name. [LConDecl name] -> Bool
isGadt [LConDecl GhcPs]
cons
    then [LConDecl GhcPs] -> Annotated ()
forall ast. Annotate ast => [Located ast] -> Annotated ()
markListWithLayout [LConDecl GhcPs]
cons
    else (LConDecl GhcPs -> Annotated ())
-> Int -> [LConDecl GhcPs] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel LConDecl GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated 2 [LConDecl GhcPs]
cons
  Set AstContext -> Annotated () -> Annotated ()
setContext (AstContext -> Set AstContext
forall a. a -> Set a
Set.singleton AstContext
Deriving) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ HsDeriving GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated HsDeriving GhcPs
derivs
markDataDefn _ (GHC.XHsDataDefn x :: XXHsDataDefn GhcPs
x) = String -> Annotated ()
forall a. HasCallStack => String -> a
error (String -> Annotated ()) -> String -> Annotated ()
forall a b. (a -> b) -> a -> b
$ "got XHsDataDefn for:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoExt -> String
forall a. Outputable a => a -> String
showGhc NoExt
XXHsDataDefn GhcPs
x

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

-- Note: GHC.HsContext name aliases to here too
instance Annotate [GHC.LHsType GHC.GhcPs] where
  markAST :: SrcSpan -> [LHsType GhcPs] -> Annotated ()
markAST l :: SrcSpan
l ts :: [LHsType GhcPs]
ts = do
    -- Note: A single item in parens in a standalone deriving clause
    -- is parsed as a HsSigType, which is always a HsForAllTy or
    -- HsQualTy. Without parens it is always a HsVar. So for round
    -- trip pretty printing we need to take this into account.
    let
      parenIfNeeded' :: AnnKeywordId -> Annotated ()
parenIfNeeded' pa :: AnnKeywordId
pa =
        case [LHsType GhcPs]
ts of
          []  -> if SrcSpan
l SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
GHC.noSrcSpan
            then AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional AnnKeywordId
pa
            else AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany AnnKeywordId
pa
          [GHC.L _ GHC.HsForAllTy{}] -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany AnnKeywordId
pa
          [GHC.L _ GHC.HsQualTy{}] -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany AnnKeywordId
pa
          [_] -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional AnnKeywordId
pa
          _   -> AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany         AnnKeywordId
pa

      parenIfNeeded'' :: AnnKeywordId -> Annotated ()
parenIfNeeded'' pa :: AnnKeywordId
pa =
        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
Parens) -- AZ:TODO: this is never set?
          (AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markMany AnnKeywordId
pa)
          (AnnKeywordId -> Annotated ()
parenIfNeeded' AnnKeywordId
pa)

      parenIfNeeded :: AnnKeywordId -> Annotated ()
parenIfNeeded pa :: AnnKeywordId
pa =
        case [LHsType GhcPs]
ts of
          [GHC.L _ GHC.HsParTy{}] -> AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
pa
          _ -> AnnKeywordId -> Annotated ()
parenIfNeeded'' AnnKeywordId
pa

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

    AnnKeywordId -> Annotated ()
parenIfNeeded AnnKeywordId
GHC.AnnOpenP

    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
$ (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 2 [LHsType GhcPs]
ts

    AnnKeywordId -> Annotated ()
parenIfNeeded AnnKeywordId
GHC.AnnCloseP

    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
NoDarrow)
      (() -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      (if [LHsType GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsType GhcPs]
ts Bool -> Bool -> Bool
&& (SrcSpan
l SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan
GHC.noSrcSpan)
         then AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
GHC.AnnDarrow
         else AnnKeywordId -> Annotated ()
mark         AnnKeywordId
GHC.AnnDarrow)

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

instance Annotate (GHC.ConDecl GHC.GhcPs) where
  markAST :: SrcSpan -> ConDecl GhcPs -> Annotated ()
markAST _ (GHC.ConDeclH98 _ ln :: Located (IdP GhcPs)
ln _fa :: Located Bool
_fa mqtvs :: [LHsTyVarBndr GhcPs]
mqtvs mctx :: Maybe (LHsContext GhcPs)
mctx
                         dets :: HsConDeclDetails GhcPs
dets _) = do
    case [LHsTyVarBndr GhcPs]
mqtvs of
      [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      bndrs :: [LHsTyVarBndr 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]
bndrs
        AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDot

    case Maybe (LHsContext GhcPs)
mctx of
      Just ctx :: LHsContext GhcPs
ctx -> do
        Set AstContext -> Annotated () -> Annotated ()
setContext ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
NoDarrow]) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsContext GhcPs
ctx
        Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsType GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LHsType GhcPs] -> Bool) -> [LHsType GhcPs] -> Bool
forall a b. (a -> b) -> a -> b
$ LHsContext GhcPs -> SrcSpanLess (LHsContext GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
GHC.unLoc LHsContext GhcPs
ctx) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDarrow
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    case HsConDeclDetails GhcPs
dets of
      GHC.InfixCon _ _ -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      _ -> 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

    Bool
-> Bool
-> [Located RdrName]
-> HsConDeclDetails GhcPs
-> Annotated ()
markHsConDeclDetails Bool
False Bool
False [Located (IdP GhcPs)
Located RdrName
ln] HsConDeclDetails GhcPs
dets

    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.AnnVbar
    Annotated ()
markTrailingSemi
{-
  | ConDeclH98
      { con_ext     :: XConDeclH98 pass
      , con_name    :: Located (IdP pass)

      , con_forall  :: Bool   -- ^ True <=> explicit user-written forall
                              --     e.g. data T a = forall b. MkT b (b->a)
                              --     con_ex_tvs = {b}
                              -- False => con_ex_tvs is empty
      , con_ex_tvs :: [LHsTyVarBndr pass]      -- ^ Existentials only
      , con_mb_cxt :: Maybe (LHsContext pass)  -- ^ User-written context (if any)
      , con_args   :: HsConDeclDetails pass    -- ^ Arguments; can be InfixCon

      , con_doc       :: Maybe LHsDocString
          -- ^ A possible Haddock comment.
      }

-}
  markAST _ (GHC.ConDeclGADT _ lns :: [Located (IdP GhcPs)]
lns (GHC.L l :: SrcSpan
l forall :: Bool
forall) (GHC.HsQTvs _ qvars :: [LHsTyVarBndr GhcPs]
qvars) mbCxt :: Maybe (LHsContext GhcPs)
mbCxt args :: HsConDeclDetails GhcPs
args typ :: LHsType GhcPs
typ _) = 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 ()
markListIntercalate [Located (IdP GhcPs)]
[Located RdrName]
lns
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDcolon
    [AnnKeywordId] -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
[AnnKeywordId] -> m ()
annotationsToComments [AnnKeywordId
GHC.AnnOpenP]
    GenLocated SrcSpan ResTyGADTHook -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated (SrcSpan -> ResTyGADTHook -> GenLocated SrcSpan ResTyGADTHook
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
l (Bool -> [LHsTyVarBndr GhcPs] -> ResTyGADTHook
ResTyGADTHook Bool
forall [LHsTyVarBndr GhcPs]
qvars))
    Maybe (LHsContext GhcPs) -> Annotated ()
forall ast. Annotate ast => Maybe (Located ast) -> Annotated ()
markMaybe Maybe (LHsContext GhcPs)
mbCxt
    Bool
-> Bool
-> [Located RdrName]
-> HsConDeclDetails GhcPs
-> Annotated ()
markHsConDeclDetails Bool
False Bool
True [Located (IdP GhcPs)]
[Located RdrName]
lns HsConDeclDetails GhcPs
args
    LHsType GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LHsType GhcPs
typ
    AnnKeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> m ()
markManyOptional AnnKeywordId
GHC.AnnCloseP
    Annotated ()
markTrailingSemi
{-
  = ConDeclGADT
      { con_g_ext   :: XConDeclGADT pass
      , con_names   :: [Located (IdP pass)]

      -- The next four fields describe the type after the '::'
      -- See Note [GADT abstract syntax]
      , con_forall  :: Located Bool      -- ^ True <=> explicit forall
                                         --   False => hsq_explicit is empty
      , con_qvars   :: LHsQTyVars pass
                       -- Whether or not there is an /explicit/ forall, we still
                       -- need to capture the implicitly-bound type/kind variables

      , con_mb_cxt  :: Maybe (LHsContext pass) -- ^ User-written context (if any)
      , con_args    :: HsConDeclDetails pass   -- ^ Arguments; never InfixCon
      , con_res_ty  :: LHsType pass            -- ^ Result type

      , con_doc     :: Maybe LHsDocString
          -- ^ A possible Haddock comment.
      }

-}

  markAST _ (GHC.ConDeclGADT _ _ (GHC.L _ _) (GHC.XLHsQTyVars _) _ _ _ _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension point in ConDecl"
  markAST _ (GHC.XConDecl _)
    = String -> Annotated ()
forall a. HasCallStack => String -> a
error "hit extension point in ConDecl"

-- ResTyGADT has a SrcSpan for the original sigtype, we need to create
-- a type for exactPC and annotatePC
data ResTyGADTHook = ResTyGADTHook Bool [GHC.LHsTyVarBndr GHC.GhcPs]
                   deriving (Typeable)
deriving instance Data (ResTyGADTHook)

instance GHC.Outputable ResTyGADTHook where
  ppr :: ResTyGADTHook -> SDoc
ppr (ResTyGADTHook b :: Bool
b bs :: [LHsTyVarBndr GhcPs]
bs) = String -> SDoc
GHC.text "ResTyGADTHook" SDoc -> SDoc -> SDoc
GHC.<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr Bool
b SDoc -> SDoc -> SDoc
GHC.<+> [LHsTyVarBndr GhcPs] -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr [LHsTyVarBndr GhcPs]
bs


-- WildCardAnon exists because the GHC anonymous wildcard type is defined as
--      = AnonWildCard (PostRn name Name)
-- We need to reconstruct this from the typed hole SrcSpan in an HsForAllTy, but
-- the instance doing this is parameterised on name, so we cannot put a value in
-- for the (PostRn name Name) field. This is used instead.
data WildCardAnon = WildCardAnon deriving (Int -> WildCardAnon -> String -> String
[WildCardAnon] -> String -> String
WildCardAnon -> String
(Int -> WildCardAnon -> String -> String)
-> (WildCardAnon -> String)
-> ([WildCardAnon] -> String -> String)
-> Show WildCardAnon
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [WildCardAnon] -> String -> String
$cshowList :: [WildCardAnon] -> String -> String
show :: WildCardAnon -> String
$cshow :: WildCardAnon -> String
showsPrec :: Int -> WildCardAnon -> String -> String
$cshowsPrec :: Int -> WildCardAnon -> String -> String
Show,Typeable WildCardAnon
DataType
Constr
Typeable WildCardAnon =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> WildCardAnon -> c WildCardAnon)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WildCardAnon)
-> (WildCardAnon -> Constr)
-> (WildCardAnon -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WildCardAnon))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WildCardAnon))
-> ((forall b. Data b => b -> b) -> WildCardAnon -> WildCardAnon)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r)
-> (forall u. (forall d. Data d => d -> u) -> WildCardAnon -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WildCardAnon -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon)
-> Data WildCardAnon
WildCardAnon -> DataType
WildCardAnon -> Constr
(forall b. Data b => b -> b) -> WildCardAnon -> WildCardAnon
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WildCardAnon -> c WildCardAnon
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WildCardAnon
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WildCardAnon -> u
forall u. (forall d. Data d => d -> u) -> WildCardAnon -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WildCardAnon
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WildCardAnon -> c WildCardAnon
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WildCardAnon)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WildCardAnon)
$cWildCardAnon :: Constr
$tWildCardAnon :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
gmapMp :: (forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
gmapM :: (forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WildCardAnon -> m WildCardAnon
gmapQi :: Int -> (forall d. Data d => d -> u) -> WildCardAnon -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WildCardAnon -> u
gmapQ :: (forall d. Data d => d -> u) -> WildCardAnon -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WildCardAnon -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WildCardAnon -> r
gmapT :: (forall b. Data b => b -> b) -> WildCardAnon -> WildCardAnon
$cgmapT :: (forall b. Data b => b -> b) -> WildCardAnon -> WildCardAnon
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WildCardAnon)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c WildCardAnon)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WildCardAnon)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WildCardAnon)
dataTypeOf :: WildCardAnon -> DataType
$cdataTypeOf :: WildCardAnon -> DataType
toConstr :: WildCardAnon -> Constr
$ctoConstr :: WildCardAnon -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WildCardAnon
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WildCardAnon
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WildCardAnon -> c WildCardAnon
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WildCardAnon -> c WildCardAnon
$cp1Data :: Typeable WildCardAnon
Data,Typeable)

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

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

instance Annotate ResTyGADTHook where
  markAST :: SrcSpan -> ResTyGADTHook -> Annotated ()
markAST _ (ResTyGADTHook forall :: Bool
forall bndrs :: [LHsTyVarBndr GhcPs]
bndrs) = do
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LHsTyVarBndr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LHsTyVarBndr GhcPs]
bndrs) (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forall (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ 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]
bndrs
      Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
forall (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnDot

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

instance Annotate (GHC.HsRecField GHC.GhcPs (GHC.LPat GHC.GhcPs)) where
  markAST :: SrcSpan -> HsRecField GhcPs (LPat GhcPs) -> Annotated ()
markAST _ (GHC.HsRecField n :: LFieldOcc GhcPs
n e :: LPat GhcPs
e punFlag :: Bool
punFlag) = 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
$ LFieldOcc GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LFieldOcc GhcPs
n
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
punFlag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
      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
$ LPat GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LPat GhcPs
e
    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.HsRecField GHC.GhcPs (GHC.LHsExpr GHC.GhcPs)) where
  markAST :: SrcSpan
-> HsRecField GhcPs (Located (HsExpr GhcPs)) -> Annotated ()
markAST _ (GHC.HsRecField n :: LFieldOcc GhcPs
n e :: Located (HsExpr GhcPs)
e punFlag :: Bool
punFlag) = 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
$ LFieldOcc GhcPs -> Annotated ()
forall ast.
(Data (SrcSpanLess ast), Annotate ast, HasSrcSpan ast) =>
ast -> Annotated ()
markLocated LFieldOcc GhcPs
n
    Bool -> Annotated () -> Annotated ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
punFlag (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ do
      AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnEqual
      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)
e
    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.FunDep (GHC.Located GHC.RdrName)) where

  markAST :: SrcSpan -> FunDep (Located RdrName) -> Annotated ()
markAST _ (ls :: [Located RdrName]
ls,rs :: [Located RdrName]
rs) = do
    (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]
ls
    AnnKeywordId -> Annotated ()
mark AnnKeywordId
GHC.AnnRarrow
    (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]
rs
    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.CType where
  markAST :: SrcSpan -> CType -> Annotated ()
markAST _ (GHC.CType src :: SourceText
src mh :: Maybe Header
mh f :: (SourceText, FastString)
f) = do
    -- markWithString GHC.AnnOpen src
    SourceText -> String -> Annotated ()
markAnnOpen SourceText
src ""
    case Maybe Header
mh of
      Nothing -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (GHC.Header srcH :: SourceText
srcH _h :: FastString
_h) ->
         -- markWithString GHC.AnnHeader srcH
         AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnHeader (SourceText -> String -> String -> String
forall a. Show a => SourceText -> a -> String -> String
toSourceTextWithSuffix SourceText
srcH "" "")
    -- markWithString GHC.AnnVal (fst f)
    SourceText -> String -> Annotated ()
markSourceText  ((SourceText, FastString) -> SourceText
forall a b. (a, b) -> a
fst (SourceText, FastString)
f) (FastString -> String
GHC.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ (SourceText, FastString) -> FastString
forall a b. (a, b) -> b
snd (SourceText, FastString)
f)
    AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnClose "#-}"

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

stringLiteralToString :: GHC.StringLiteral -> String
stringLiteralToString :: StringLiteral -> String
stringLiteralToString (GHC.StringLiteral st :: SourceText
st fs :: FastString
fs) =
  case SourceText
st of
    GHC.NoSourceText   -> FastString -> String
GHC.unpackFS FastString
fs
    GHC.SourceText src :: String
src -> String
src