{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.GHC.ExactPrint.AnnotateTypes
where
#if __GLASGOW_HASKELL__ <= 710
import Data.Ord ( comparing )
import Data.List ( sortBy )
#endif
import Language.Haskell.GHC.ExactPrint.Types
#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Types.Basic as GHC
#elif __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
{-# ANN module "HLint: ignore Eta reduce" #-}
{-# ANN module "HLint: ignore Redundant do" #-}
{-# ANN module "HLint: ignore Reduce duplication" #-}
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) && (__GLASGOW_HASKELL__ < 900)
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 :: [(AnnSpan, Annotated ())] -> next -> AnnotationF next
SetLayoutFlag :: Rigidity -> Annotated () -> next -> AnnotationF next
MarkAnnBeforeAnn :: GHC.AnnKeywordId -> GHC.AnnKeywordId -> next -> AnnotationF next
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
:: [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
SetContextLevel :: Set.Set AstContext -> Int -> Annotated () -> next -> AnnotationF next
UnsetContext :: AstContext -> Annotated () -> next -> AnnotationF next
IfInContext :: Set.Set AstContext -> Annotated () -> Annotated () -> next -> AnnotationF next
WithSortKeyContexts :: ListContexts -> [(AnnSpan, 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
#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
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
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 ())
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) && (__GLASGOW_HASKELL__ < 900)
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
withSortKeyContextsHelper :: (Monad m) => (Annotated () -> m ()) -> ListContexts -> [(AnnSpan, 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
applyListAnnotations :: [(AnnSpan, 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 -> [(AnnSpan, 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 :: [(AnnSpan, 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