{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-} -- Needed for the DataId constraint on ResTyGADTHook
{-# 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.AnnotateTypes
       -- (
       --   AnnotationF(..)
       -- , Annotated
       -- , Annotate(..)

       -- )
      where

#if __GLASGOW_HASKELL__ <= 710
import Data.Ord ( comparing )
import Data.List ( sortBy )
#endif

import Language.Haskell.GHC.ExactPrint.Types

#if __GLASGOW_HASKELL__ > 800
import qualified BasicTypes     as GHC
#endif
import qualified GHC            as GHC
#if __GLASGOW_HASKELL__ <= 710
import qualified BooleanFormula as GHC
import qualified Outputable     as GHC
#endif

import Control.Monad.Trans.Free
import Control.Monad.Free.TH (makeFreeCon)
import Control.Monad.Identity
import Data.Data

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

-- | ['MarkPrim'] The main constructor. Marks that a specific AnnKeywordId could
-- appear with an optional String which is used when printing.
-- ['MarkPPOptional'] Used to flag elements, such as optional braces, that are
--   not used in the pretty printer. This functions identically to 'MarkPrim'
--   for the other interpreters.
-- ['MarkEOF']
--    Special constructor which marks the end of file marker.
-- ['MarkExternal'] TODO
-- ['MarkOutside']  A @AnnKeywordId@ which is precisely located but not inside the
--    current context. This is usually used to reassociated located
--    @RdrName@ which are more naturally associated with their parent than
--    in their own annotation.
-- ['MarkInside']
--    The dual of MarkOutside. If we wish to mark a non-separating comma
--    or semi-colon then we must use this constructor.
-- ['MarkMany'] Some syntax elements allow an arbritary number of puncuation marks
-- without reflection in the AST. This construction greedily takes all of
-- the specified @AnnKeywordId@.
-- ['MarkOffsetPrim'] Some syntax elements have repeated @AnnKeywordId@ which are
--  seperated by different @AnnKeywordId@. Thus using MarkMany is
--  unsuitable and instead we provide an index to specify which specific
--  instance to choose each time.
-- ['WithAST'] TODO
-- ['CountAnns'] Sometimes the AST does not reflect the concrete source code and the
--  only way to tell what the concrete source was is to count a certain
--  kind of @AnnKeywordId@.
-- ['WithSortKey'] There are many places where the syntactic ordering of elements is
-- thrown away by the AST. This constructor captures the original
-- ordering and reflects any changes in ordered as specified by the
-- @annSortKey@ field in @Annotation@.
-- ['SetLayoutFlag'] It is important to know precisely where layout rules apply. This
--  constructor wraps a computation to indicate that LayoutRules apply to
--  the corresponding construct.
-- ['StoreOriginalSrcSpan'] TODO
-- ['GetSrcSpanFromKw'] TODO
-- ['StoreString'] TODO
-- ['AnnotationsToComments'] Used when the AST is sufficiently vague that there is no other
-- option but to convert a fragment of source code into a comment. This
-- means it is impossible to edit such a fragment but means that
-- processing files with such fragments is still possible.
data AnnotationF next where
  MarkPrim         :: GHC.AnnKeywordId -> Maybe String                     -> next -> AnnotationF next
  MarkPPOptional   :: GHC.AnnKeywordId -> Maybe String                     -> next -> AnnotationF next
  MarkEOF          ::                                                         next -> AnnotationF next
  MarkExternal     :: GHC.SrcSpan -> GHC.AnnKeywordId -> String            -> next -> AnnotationF next
#if __GLASGOW_HASKELL__ >= 800
  MarkInstead      :: GHC.AnnKeywordId -> KeywordId                        -> next -> AnnotationF next
#endif
  MarkOutside      :: GHC.AnnKeywordId -> KeywordId                        -> next -> AnnotationF next
  MarkInside       :: GHC.AnnKeywordId                                     -> next -> AnnotationF next
  MarkMany         :: GHC.AnnKeywordId                                     -> next -> AnnotationF next
  MarkManyOptional :: GHC.AnnKeywordId                                     -> next -> AnnotationF next
  MarkOffsetPrim   :: GHC.AnnKeywordId -> Int -> Maybe String              -> next -> AnnotationF next
  MarkOffsetPrimOptional :: GHC.AnnKeywordId -> Int -> Maybe String        -> next -> AnnotationF next
#if __GLASGOW_HASKELL__ > 806
  WithAST         :: (Data a,Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a) =>
                           a -> Annotated b                                -> next -> AnnotationF next
#else
  WithAST          :: Data a => GHC.Located a
                             -> Annotated b                                -> next -> AnnotationF next
#endif
  CountAnns        :: GHC.AnnKeywordId                        -> (Int     -> next) -> AnnotationF next
  WithSortKey      :: [(GHC.SrcSpan, Annotated ())]                        -> next -> AnnotationF next

  SetLayoutFlag    ::  Rigidity -> Annotated ()                            -> next -> AnnotationF next
  MarkAnnBeforeAnn :: GHC.AnnKeywordId -> GHC.AnnKeywordId                 -> next -> AnnotationF next

  -- Required to work around deficiencies in the GHC AST
  StoreOriginalSrcSpan :: GHC.SrcSpan -> AnnKey         -> (AnnKey -> next) -> AnnotationF next
  GetSrcSpanForKw :: GHC.SrcSpan -> GHC.AnnKeywordId -> (GHC.SrcSpan -> next) -> AnnotationF next
#if __GLASGOW_HASKELL__ <= 710
  StoreString :: String -> GHC.SrcSpan                  -> next -> AnnotationF next
#endif
  AnnotationsToComments :: [GHC.AnnKeywordId]           -> next -> AnnotationF next
#if __GLASGOW_HASKELL__ <= 710
  AnnotationsToCommentsBF :: (GHC.Outputable a) => GHC.BooleanFormula (GHC.Located a) -> [GHC.AnnKeywordId] -> next -> AnnotationF next
  FinalizeBF :: GHC.SrcSpan -> next -> AnnotationF next
#endif

  -- AZ experimenting with pretty printing
  -- Set the context for child element
  SetContextLevel :: Set.Set AstContext -> Int -> Annotated () -> next -> AnnotationF next
  UnsetContext    ::         AstContext        -> Annotated () -> next -> AnnotationF next
  -- Query the context while in a child element
  IfInContext  :: Set.Set AstContext -> Annotated () -> Annotated ()   -> next -> AnnotationF next
  WithSortKeyContexts :: ListContexts -> [(GHC.SrcSpan, Annotated ())] -> next -> AnnotationF next
  --
  TellContext :: Set.Set AstContext -> next -> AnnotationF next

deriving instance Functor AnnotationF

type Annotated = FreeT AnnotationF Identity


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

makeFreeCon  'MarkEOF
makeFreeCon  'MarkPrim
makeFreeCon  'MarkPPOptional
#if __GLASGOW_HASKELL__ >= 800
makeFreeCon  'MarkInstead
#endif
makeFreeCon  'MarkOutside
makeFreeCon  'MarkInside
makeFreeCon  'MarkExternal
makeFreeCon  'MarkMany
makeFreeCon  'MarkManyOptional
makeFreeCon  'MarkOffsetPrim
makeFreeCon  'MarkOffsetPrimOptional
makeFreeCon  'CountAnns
makeFreeCon  'StoreOriginalSrcSpan
makeFreeCon  'GetSrcSpanForKw
#if __GLASGOW_HASKELL__ <= 710
makeFreeCon  'StoreString
#endif
makeFreeCon  'AnnotationsToComments
#if __GLASGOW_HASKELL__ <= 710
makeFreeCon  'AnnotationsToCommentsBF
makeFreeCon  'FinalizeBF
#endif
makeFreeCon  'WithSortKey
makeFreeCon  'SetContextLevel
makeFreeCon  'UnsetContext
makeFreeCon  'IfInContext
makeFreeCon  'WithSortKeyContexts
makeFreeCon  'TellContext
makeFreeCon  'MarkAnnBeforeAnn

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

setContext :: Set.Set AstContext -> Annotated () -> Annotated ()
setContext :: Set AstContext -> Annotated () -> Annotated ()
setContext Set AstContext
ctxt Annotated ()
action = AnnotationF () -> Annotated ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (Set AstContext -> Int -> Annotated () -> () -> AnnotationF ()
forall next.
Set AstContext -> Int -> Annotated () -> next -> AnnotationF next
SetContextLevel Set AstContext
ctxt Int
3 Annotated ()
action ())

setLayoutFlag :: Annotated () -> Annotated ()
setLayoutFlag :: Annotated () -> Annotated ()
setLayoutFlag Annotated ()
action = AnnotationF () -> Annotated ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (Rigidity -> Annotated () -> () -> AnnotationF ()
forall next. Rigidity -> Annotated () -> next -> AnnotationF next
SetLayoutFlag Rigidity
NormalLayout Annotated ()
action ())

setRigidFlag :: Annotated () -> Annotated ()
setRigidFlag :: Annotated () -> Annotated ()
setRigidFlag Annotated ()
action = AnnotationF () -> Annotated ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (Rigidity -> Annotated () -> () -> AnnotationF ()
forall next. Rigidity -> Annotated () -> next -> AnnotationF next
SetLayoutFlag Rigidity
RigidLayout Annotated ()
action ())

inContext :: Set.Set AstContext -> Annotated () -> Annotated ()
inContext :: Set AstContext -> Annotated () -> Annotated ()
inContext Set AstContext
ctxt Annotated ()
action = AnnotationF () -> Annotated ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (Set AstContext
-> Annotated () -> Annotated () -> () -> AnnotationF ()
forall next.
Set AstContext
-> Annotated () -> Annotated () -> next -> AnnotationF next
IfInContext Set AstContext
ctxt Annotated ()
action (() -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ())

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

#if __GLASGOW_HASKELL__ <= 710
workOutString :: GHC.SrcSpan -> GHC.AnnKeywordId -> (GHC.SrcSpan -> String) -> Annotated ()
workOutString l kw f = do
  ss <- getSrcSpanForKw l kw
  storeString (f ss) ss
#endif

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

-- |Main driver point for annotations.
#if __GLASGOW_HASKELL__ > 806
withAST :: (Data a, Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a)
        => a -> Annotated () -> Annotated ()
#else
withAST :: Data a => GHC.Located a -> Annotated () -> Annotated ()
#endif
withAST :: a -> Annotated () -> Annotated ()
withAST a
lss Annotated ()
action = AnnotationF () -> Annotated ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (a -> Annotated () -> () -> AnnotationF ()
forall a b next.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Annotated b -> next -> AnnotationF next
WithAST a
lss Annotated ()
action ())

-- ---------------------------------------------------------------------
-- Additional smart constructors

mark :: GHC.AnnKeywordId -> Annotated ()
mark :: AnnKeywordId -> Annotated ()
mark AnnKeywordId
kwid = AnnKeywordId -> Maybe String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> Maybe String -> m ()
markPrim AnnKeywordId
kwid Maybe String
forall a. Maybe a
Nothing

markOptional :: GHC.AnnKeywordId -> Annotated ()
markOptional :: AnnKeywordId -> Annotated ()
markOptional AnnKeywordId
kwid = AnnKeywordId -> Maybe String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> Maybe String -> m ()
markPPOptional AnnKeywordId
kwid Maybe String
forall a. Maybe a
Nothing

markWithString :: GHC.AnnKeywordId -> String -> Annotated ()
markWithString :: AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
kwid String
s = AnnKeywordId -> Maybe String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> Maybe String -> m ()
markPrim AnnKeywordId
kwid (String -> Maybe String
forall a. a -> Maybe a
Just String
s)

markWithStringOptional :: GHC.AnnKeywordId -> String -> Annotated ()
markWithStringOptional :: AnnKeywordId -> String -> Annotated ()
markWithStringOptional AnnKeywordId
kwid String
s = AnnKeywordId -> Maybe String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> Maybe String -> m ()
markPPOptional AnnKeywordId
kwid (String -> Maybe String
forall a. a -> Maybe a
Just String
s)

markOffsetWithString :: GHC.AnnKeywordId -> Int -> String -> Annotated ()
markOffsetWithString :: AnnKeywordId -> Int -> String -> Annotated ()
markOffsetWithString AnnKeywordId
kwid Int
n String
s = AnnKeywordId -> Int -> Maybe String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> Int -> Maybe String -> m ()
markOffsetPrim AnnKeywordId
kwid Int
n (String -> Maybe String
forall a. a -> Maybe a
Just String
s)

markOffset :: GHC.AnnKeywordId -> Int -> Annotated ()
markOffset :: AnnKeywordId -> Int -> Annotated ()
markOffset AnnKeywordId
kwid Int
n = AnnKeywordId -> Int -> Maybe String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> Int -> Maybe String -> m ()
markOffsetPrim AnnKeywordId
kwid Int
n Maybe String
forall a. Maybe a
Nothing

markOffsetOptional :: GHC.AnnKeywordId -> Int -> Annotated ()
markOffsetOptional :: AnnKeywordId -> Int -> Annotated ()
markOffsetOptional AnnKeywordId
kwid Int
n = AnnKeywordId -> Int -> Maybe String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> Int -> Maybe String -> m ()
markOffsetPrimOptional AnnKeywordId
kwid Int
n Maybe String
forall a. Maybe a
Nothing

markTrailingSemi :: Annotated ()
markTrailingSemi :: Annotated ()
markTrailingSemi = AnnKeywordId -> KeywordId -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
AnnKeywordId -> KeywordId -> m ()
markOutside AnnKeywordId
GHC.AnnSemi KeywordId
AnnSemiSep

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

#if __GLASGOW_HASKELL__ > 806
withLocated :: (Data a, Data (GHC.SrcSpanLess a), GHC.HasSrcSpan a)
            => a
            -> (GHC.SrcSpan -> a -> Annotated ())
            -> Annotated ()
withLocated :: a -> (SrcSpan -> a -> Annotated ()) -> Annotated ()
withLocated a :: a
a@(a -> Located (SrcSpanLess a)
forall a. HasSrcSpan a => a -> Located (SrcSpanLess a)
GHC.dL->GHC.L SrcSpan
l SrcSpanLess a
_) SrcSpan -> a -> Annotated ()
action =
  a -> Annotated () -> Annotated ()
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Annotated () -> Annotated ()
withAST a
a (SrcSpan -> a -> Annotated ()
action SrcSpan
l a
a)
#else
withLocated :: Data a
            => GHC.Located a
            -> (GHC.SrcSpan -> a -> Annotated ())
            -> Annotated ()
withLocated a@(GHC.L l t) action =
  withAST a (action l t)
#endif

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


markListIntercalateWithFun :: (t -> Annotated ()) -> [t] -> Annotated ()
markListIntercalateWithFun :: (t -> Annotated ()) -> [t] -> Annotated ()
markListIntercalateWithFun t -> Annotated ()
f [t]
ls = (t -> Annotated ()) -> Int -> [t] -> Annotated ()
forall t. (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel t -> Annotated ()
f Int
2 [t]
ls

markListIntercalateWithFunLevel :: (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel :: (t -> Annotated ()) -> Int -> [t] -> Annotated ()
markListIntercalateWithFunLevel t -> Annotated ()
f Int
level [t]
ls = (t -> Annotated ()) -> Int -> AstContext -> [t] -> Annotated ()
forall t.
(t -> Annotated ()) -> Int -> AstContext -> [t] -> Annotated ()
markListIntercalateWithFunLevelCtx t -> Annotated ()
f Int
level AstContext
Intercalate [t]
ls

markListIntercalateWithFunLevelCtx :: (t -> Annotated ()) -> Int -> AstContext -> [t] -> Annotated ()
markListIntercalateWithFunLevelCtx :: (t -> Annotated ()) -> Int -> AstContext -> [t] -> Annotated ()
markListIntercalateWithFunLevelCtx t -> Annotated ()
f Int
level AstContext
ctx [t]
ls = [t] -> Annotated ()
go [t]
ls
  where
    go :: [t] -> Annotated ()
go []  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go [t
x] = t -> Annotated ()
f t
x
    go (t
x:[t]
xs) = 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
ctx) Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ t -> Annotated ()
f t
x
      [t] -> Annotated ()
go [t]
xs

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

markListWithContextsFunction ::
                         ListContexts
                      -> (t -> Annotated ())
                      -> [t] -> Annotated ()
markListWithContextsFunction :: ListContexts -> (t -> Annotated ()) -> [t] -> Annotated ()
markListWithContextsFunction (LC Set AstContext
ctxOnly Set AstContext
ctxInitial Set AstContext
ctxMiddle Set AstContext
ctxLast) t -> Annotated ()
f [t]
ls =
  case [t]
ls of
    [] -> () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [t
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
$ t -> Annotated ()
f t
x
    (t
x:[t]
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
$ t -> Annotated ()
f t
x
      [t] -> Annotated ()
go [t]
xs
  where
    level :: Int
level = Int
2
    go :: [t] -> Annotated ()
go []  = () -> Annotated ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go [t
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
$ t -> Annotated ()
f t
x
    go (t
x:[t]
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
$ t -> Annotated ()
f t
x
      [t] -> Annotated ()
go [t]
xs

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


-- Expects the kws to be ordered already
withSortKeyContextsHelper :: (Monad m) => (Annotated () -> m ()) -> ListContexts -> [(GHC.SrcSpan, Annotated ())] -> m ()
withSortKeyContextsHelper :: (Annotated () -> m ())
-> ListContexts -> [(SrcSpan, Annotated ())] -> m ()
withSortKeyContextsHelper Annotated () -> m ()
interpret (LC Set AstContext
ctxOnly Set AstContext
ctxInitial Set AstContext
ctxMiddle Set AstContext
ctxLast) [(SrcSpan, Annotated ())]
kws = do
  case [(SrcSpan, Annotated ())]
kws of
    [] -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [(SrcSpan, Annotated ())
x] -> Annotated () -> m ()
interpret (Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel (AstContext -> Set AstContext -> Set AstContext
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> AstContext
CtxPos Int
0) Set AstContext
ctxOnly) Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Annotated ()) -> Annotated ()
forall a b. (a, b) -> b
snd (SrcSpan, Annotated ())
x)
    ((SrcSpan, Annotated ())
x:[(SrcSpan, Annotated ())]
xs) -> do
      Annotated () -> m ()
interpret (Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel (AstContext -> Set AstContext -> Set AstContext
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> AstContext
CtxPos Int
0) Set AstContext
ctxInitial) Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Annotated ()) -> Annotated ()
forall a b. (a, b) -> b
snd (SrcSpan, Annotated ())
x)
      Int -> [(SrcSpan, Annotated ())] -> m ()
go Int
1 [(SrcSpan, Annotated ())]
xs
  where
    level :: Int
level = Int
2
    go :: Int -> [(SrcSpan, Annotated ())] -> m ()
go Int
_ []  = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go Int
n [(SrcSpan, Annotated ())
x] = Annotated () -> m ()
interpret (Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel (AstContext -> Set AstContext -> Set AstContext
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> AstContext
CtxPos Int
n) Set AstContext
ctxLast) Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Annotated ()) -> Annotated ()
forall a b. (a, b) -> b
snd (SrcSpan, Annotated ())
x)
    go Int
n ((SrcSpan, Annotated ())
x:[(SrcSpan, Annotated ())]
xs) = do
      Annotated () -> m ()
interpret (Set AstContext -> Int -> Annotated () -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
Set AstContext -> Int -> Annotated () -> m ()
setContextLevel (AstContext -> Set AstContext -> Set AstContext
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> AstContext
CtxPos Int
n) Set AstContext
ctxMiddle) Int
level (Annotated () -> Annotated ()) -> Annotated () -> Annotated ()
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Annotated ()) -> Annotated ()
forall a b. (a, b) -> b
snd (SrcSpan, Annotated ())
x)
      Int -> [(SrcSpan, Annotated ())] -> m ()
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(SrcSpan, Annotated ())]
xs

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


applyListAnnotations :: [(GHC.SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotations :: [(SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotations [(SrcSpan, Annotated ())]
ls = [(SrcSpan, Annotated ())] -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
[(SrcSpan, Annotated ())] -> m ()
withSortKey [(SrcSpan, Annotated ())]
ls

applyListAnnotationsContexts :: ListContexts -> [(GHC.SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotationsContexts :: ListContexts -> [(SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotationsContexts ListContexts
ctxt [(SrcSpan, Annotated ())]
ls = ListContexts -> [(SrcSpan, Annotated ())] -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
ListContexts -> [(SrcSpan, Annotated ())] -> m ()
withSortKeyContexts ListContexts
ctxt [(SrcSpan, Annotated ())]
ls

#if __GLASGOW_HASKELL__ <= 710
lexicalSortLocated :: [GHC.Located a] -> [GHC.Located a]
lexicalSortLocated = sortBy (comparing GHC.getLoc)
#endif

applyListAnnotationsLayout :: [(GHC.SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotationsLayout :: [(SrcSpan, Annotated ())] -> Annotated ()
applyListAnnotationsLayout [(SrcSpan, Annotated ())]
ls = 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 -> [(SrcSpan, Annotated ())] -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
ListContexts -> [(SrcSpan, Annotated ())] -> m ()
withSortKeyContexts ListContexts
listContexts [(SrcSpan, Annotated ())]
ls

listContexts :: ListContexts
listContexts :: ListContexts
listContexts = Set AstContext
-> Set AstContext
-> Set AstContext
-> Set AstContext
-> ListContexts
LC ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxOnly,AstContext
ListStart])
                  ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxFirst,AstContext
ListStart,AstContext
Intercalate])
                  ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxMiddle,AstContext
ListItem,AstContext
Intercalate])
                  ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxLast,AstContext
ListItem])

listContexts' :: ListContexts
listContexts' :: ListContexts
listContexts' = Set AstContext
-> Set AstContext
-> Set AstContext
-> Set AstContext
-> ListContexts
LC ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxOnly,  AstContext
ListStart])
                   ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxFirst, AstContext
ListStart])
                   ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxMiddle,AstContext
ListItem])
                   ([AstContext] -> Set AstContext
forall a. Ord a => [a] -> Set a
Set.fromList [AstContext
CtxLast,  AstContext
ListItem])

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


#if __GLASGOW_HASKELL__ > 800
markAnnOpen :: GHC.SourceText -> String -> Annotated ()
markAnnOpen :: SourceText -> String -> Annotated ()
markAnnOpen SourceText
GHC.NoSourceText String
txt   =  AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
txt
markAnnOpen (GHC.SourceText String
txt) String
_ =  AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnOpen String
txt

markSourceText :: GHC.SourceText -> String -> Annotated ()
markSourceText :: SourceText -> String -> Annotated ()
markSourceText SourceText
GHC.NoSourceText String
txt   =  AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnVal String
txt
markSourceText (GHC.SourceText String
txt) String
_ =  AnnKeywordId -> String -> Annotated ()
markWithString AnnKeywordId
GHC.AnnVal String
txt

markExternalSourceText :: GHC.SrcSpan -> GHC.SourceText -> String -> Annotated ()
markExternalSourceText :: SrcSpan -> SourceText -> String -> Annotated ()
markExternalSourceText SrcSpan
l SourceText
GHC.NoSourceText String
txt   =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
txt
markExternalSourceText SrcSpan
l (GHC.SourceText String
txt) String
_ =  SrcSpan -> AnnKeywordId -> String -> Annotated ()
forall (m :: * -> *).
MonadFree AnnotationF m =>
SrcSpan -> AnnKeywordId -> String -> m ()
markExternal SrcSpan
l AnnKeywordId
GHC.AnnVal String
txt

sourceTextToString :: GHC.SourceText -> String -> String
sourceTextToString :: SourceText -> String -> String
sourceTextToString SourceText
GHC.NoSourceText String
alt   = String
alt
sourceTextToString (GHC.SourceText String
txt) String
_ = String
txt
#endif

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