module GHC.Parser.Annotation (
AnnKeywordId(..),
EpaComment(..), EpaCommentTok(..),
IsUnicodeSyntax(..),
unicodeAnn,
HasE(..),
AddEpAnn(..),
EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn,
DeltaPos(..), deltaPos, getDeltaLine,
EpAnn(..), Anchor(..), AnchorOperation(..),
spanAsAnchor, realSpanAsAnchor,
noAnn,
EpAnnComments(..), LEpaComment, emptyComments,
getFollowingComments, setFollowingComments, setPriorComments,
EpAnnCO,
LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP,
SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN,
SrcSpanAnn'(..), SrcAnn,
AnnListItem(..), AnnList(..),
AnnParen(..), ParenType(..), parenTypeKws,
AnnPragma(..),
AnnContext(..),
NameAnn(..), NameAdornment(..),
NoEpAnns(..),
AnnSortKey(..),
TrailingAnn(..), addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN,
la2na, na2la, n2l, l2n, l2l, la2la,
reLoc, reLocA, reLocL, reLocC, reLocN,
la2r, realSrcSpan,
extraToAnnList, reAnn,
reAnnL, reAnnC,
addAnns, addAnnsA, widenSpan, widenAnchor, widenAnchorR, widenLocatedAn,
getLocAnn,
epAnnAnns, epAnnAnnsL,
annParen2AddEpAnn,
epAnnComments,
sortLocatedA,
mapLocA,
combineLocsA,
combineSrcSpansA,
addCLocA, addCLocAA,
noLocA, getLocA,
noSrcSpanA,
noAnnSrcSpan,
noComments, comment, addCommentsToSrcAnn, setCommentsSrcAnn,
addCommentsToEpAnn, setCommentsEpAnn,
transferAnnsA, commentsOnlyA, removeCommentsA,
placeholderRealSpan,
) where
import GHC.Prelude
import Data.Data
import Data.Function (on)
import Data.List (sortBy)
import Data.Semigroup
import GHC.Data.FastString
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Utils.Binary
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Utils.Panic
data AnnKeywordId
= AnnAnyclass
| AnnAs
| AnnAt
| AnnBang
| AnnBackquote
| AnnBy
| AnnCase
| AnnClass
| AnnClose
| AnnCloseB
| AnnCloseBU
| AnnCloseC
| AnnCloseQ
| AnnCloseQU
| AnnCloseP
| AnnClosePH
| AnnCloseS
| AnnColon
| AnnComma
| AnnCommaTuple
| AnnDarrow
| AnnDarrowU
| AnnData
| AnnDcolon
| AnnDcolonU
| AnnDefault
| AnnDeriving
| AnnDo
| AnnDot
| AnnDotdot
| AnnElse
| AnnEqual
| AnnExport
| AnnFamily
| AnnForall
| AnnForallU
| AnnForeign
| AnnFunId
| AnnGroup
| AnnHeader
| AnnHiding
| AnnIf
| AnnImport
| AnnIn
| AnnInfix
| AnnInstance
| AnnLam
| AnnLarrow
| AnnLarrowU
| AnnLet
| AnnLollyU
| AnnMdo
| AnnMinus
| AnnModule
| AnnNewtype
| AnnName
| AnnOf
| AnnOpen
| AnnOpenB
| AnnOpenBU
| AnnOpenC
| AnnOpenE
| AnnOpenEQ
| AnnOpenEQU
| AnnOpenP
| AnnOpenS
| AnnOpenPH
| AnnDollar
| AnnDollarDollar
| AnnPackageName
| AnnPattern
| AnnPercent
| AnnPercentOne
| AnnProc
| AnnQualified
| AnnRarrow
| AnnRarrowU
| AnnRec
| AnnRole
| AnnSafe
| AnnSemi
| AnnSimpleQuote
| AnnSignature
| AnnStatic
| AnnStock
| AnnThen
| AnnThTyQuote
| AnnTilde
| AnnType
| AnnUnit
| AnnUsing
| AnnVal
| AnnValStr
| AnnVbar
| AnnVia
| AnnWhere
| Annlarrowtail
| AnnlarrowtailU
| Annrarrowtail
| AnnrarrowtailU
| AnnLarrowtail
| AnnLarrowtailU
| AnnRarrowtail
| AnnRarrowtailU
deriving (Eq, Ord, Data, Show)
instance Outputable AnnKeywordId where
ppr x = text (show x)
data IsUnicodeSyntax = UnicodeSyntax | NormalSyntax
deriving (Eq, Ord, Data, Show)
unicodeAnn :: AnnKeywordId -> AnnKeywordId
unicodeAnn AnnForall = AnnForallU
unicodeAnn AnnDcolon = AnnDcolonU
unicodeAnn AnnLarrow = AnnLarrowU
unicodeAnn AnnRarrow = AnnRarrowU
unicodeAnn AnnDarrow = AnnDarrowU
unicodeAnn Annlarrowtail = AnnlarrowtailU
unicodeAnn Annrarrowtail = AnnrarrowtailU
unicodeAnn AnnLarrowtail = AnnLarrowtailU
unicodeAnn AnnRarrowtail = AnnRarrowtailU
unicodeAnn AnnOpenB = AnnOpenBU
unicodeAnn AnnCloseB = AnnCloseBU
unicodeAnn AnnOpenEQ = AnnOpenEQU
unicodeAnn AnnCloseQ = AnnCloseQU
unicodeAnn ann = ann
data HasE = HasE | NoE
deriving (Eq, Ord, Data, Show)
data EpaComment =
EpaComment
{ ac_tok :: EpaCommentTok
, ac_prior_tok :: RealSrcSpan
}
deriving (Eq, Ord, Data, Show)
data EpaCommentTok =
EpaDocCommentNext String
| EpaDocCommentPrev String
| EpaDocCommentNamed String
| EpaDocSection Int String
| EpaDocOptions String
| EpaLineComment String
| EpaBlockComment String
| EpaEofComment
deriving (Eq, Ord, Data, Show)
instance Outputable EpaComment where
ppr x = text (show x)
data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Eq)
data EpaLocation = EpaSpan !RealSrcSpan
| EpaDelta !DeltaPos ![LEpaComment]
deriving (Data,Eq,Ord)
data DeltaPos
= SameLine { deltaColumn :: !Int }
| DifferentLine
{ deltaLine :: !Int,
deltaColumn :: !Int
} deriving (Show,Eq,Ord,Data)
deltaPos :: Int -> Int -> DeltaPos
deltaPos l c = case l of
0 -> SameLine c
_ -> DifferentLine l c
getDeltaLine :: DeltaPos -> Int
getDeltaLine (SameLine _) = 0
getDeltaLine (DifferentLine r _) = r
epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan (EpaSpan r) = r
epaLocationRealSrcSpan (EpaDelta _ _) = panic "epaLocationRealSrcSpan"
epaLocationFromSrcAnn :: SrcAnn ann -> EpaLocation
epaLocationFromSrcAnn (SrcSpanAnn EpAnnNotUsed l) = EpaSpan (realSrcSpan l)
epaLocationFromSrcAnn (SrcSpanAnn (EpAnn anc _ _) _) = EpaSpan (anchor anc)
instance Outputable EpaLocation where
ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
ppr (EpaDelta d cs) = text "EpaDelta" <+> ppr d <+> ppr cs
instance Outputable AddEpAnn where
ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss
instance Ord AddEpAnn where
compare (AddEpAnn kw1 loc1) (AddEpAnn kw2 loc2) = compare (loc1, kw1) (loc2,kw2)
data EpAnn ann
= EpAnn { entry :: !Anchor
, anns :: !ann
, comments :: !EpAnnComments
}
| EpAnnNotUsed
deriving (Data, Eq, Functor)
data Anchor = Anchor { anchor :: RealSrcSpan
, anchor_op :: AnchorOperation }
deriving (Data, Eq, Show)
data AnchorOperation = UnchangedAnchor
| MovedAnchor DeltaPos
deriving (Data, Eq, Show)
spanAsAnchor :: SrcSpan -> Anchor
spanAsAnchor s = Anchor (realSrcSpan s) UnchangedAnchor
realSpanAsAnchor :: RealSrcSpan -> Anchor
realSpanAsAnchor s = Anchor s UnchangedAnchor
data EpAnnComments = EpaComments
{ priorComments :: ![LEpaComment] }
| EpaCommentsBalanced
{ priorComments :: ![LEpaComment]
, followingComments :: ![LEpaComment] }
deriving (Data, Eq)
type LEpaComment = GenLocated Anchor EpaComment
emptyComments :: EpAnnComments
emptyComments = EpaComments []
data SrcSpanAnn' a = SrcSpanAnn { ann :: !a, locA :: !SrcSpan }
deriving (Data, Eq)
type SrcAnn ann = SrcSpanAnn' (EpAnn ann)
type LocatedA = GenLocated SrcSpanAnnA
type LocatedN = GenLocated SrcSpanAnnN
type LocatedL = GenLocated SrcSpanAnnL
type LocatedP = GenLocated SrcSpanAnnP
type LocatedC = GenLocated SrcSpanAnnC
type SrcSpanAnnA = SrcAnn AnnListItem
type SrcSpanAnnN = SrcAnn NameAnn
type SrcSpanAnnL = SrcAnn AnnList
type SrcSpanAnnP = SrcAnn AnnPragma
type SrcSpanAnnC = SrcAnn AnnContext
type LocatedAn an = GenLocated (SrcAnn an)
data TrailingAnn
= AddSemiAnn EpaLocation
| AddCommaAnn EpaLocation
| AddVbarAnn EpaLocation
| AddRarrowAnn EpaLocation
| AddRarrowAnnU EpaLocation
| AddLollyAnnU EpaLocation
deriving (Data,Eq, Ord)
instance Outputable TrailingAnn where
ppr (AddSemiAnn ss) = text "AddSemiAnn" <+> ppr ss
ppr (AddCommaAnn ss) = text "AddCommaAnn" <+> ppr ss
ppr (AddVbarAnn ss) = text "AddVbarAnn" <+> ppr ss
ppr (AddRarrowAnn ss) = text "AddRarrowAnn" <+> ppr ss
ppr (AddRarrowAnnU ss) = text "AddRarrowAnnU" <+> ppr ss
ppr (AddLollyAnnU ss) = text "AddLollyAnnU" <+> ppr ss
data AnnListItem
= AnnListItem {
lann_trailing :: [TrailingAnn]
}
deriving (Data, Eq)
data AnnList
= AnnList {
al_anchor :: Maybe Anchor,
al_open :: Maybe AddEpAnn,
al_close :: Maybe AddEpAnn,
al_rest :: [AddEpAnn],
al_trailing :: [TrailingAnn]
} deriving (Data,Eq)
data AnnParen
= AnnParen {
ap_adornment :: ParenType,
ap_open :: EpaLocation,
ap_close :: EpaLocation
} deriving (Data)
data ParenType
= AnnParens
| AnnParensHash
| AnnParensSquare
deriving (Eq, Ord, Data)
parenTypeKws :: ParenType -> (AnnKeywordId, AnnKeywordId)
parenTypeKws AnnParens = (AnnOpenP, AnnCloseP)
parenTypeKws AnnParensHash = (AnnOpenPH, AnnClosePH)
parenTypeKws AnnParensSquare = (AnnOpenS, AnnCloseS)
data AnnContext
= AnnContext {
ac_darrow :: Maybe (IsUnicodeSyntax, EpaLocation),
ac_open :: [EpaLocation],
ac_close :: [EpaLocation]
} deriving (Data)
data NameAnn
= NameAnn {
nann_adornment :: NameAdornment,
nann_open :: EpaLocation,
nann_name :: EpaLocation,
nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
| NameAnnCommas {
nann_adornment :: NameAdornment,
nann_open :: EpaLocation,
nann_commas :: [EpaLocation],
nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
| NameAnnOnly {
nann_adornment :: NameAdornment,
nann_open :: EpaLocation,
nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
| NameAnnRArrow {
nann_name :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
| NameAnnQuote {
nann_quote :: EpaLocation,
nann_quoted :: SrcSpanAnnN,
nann_trailing :: [TrailingAnn]
}
| NameAnnTrailing {
nann_trailing :: [TrailingAnn]
}
deriving (Data, Eq)
data NameAdornment
= NameParens
| NameParensHash
| NameBackquotes
| NameSquare
deriving (Eq, Ord, Data)
data AnnPragma
= AnnPragma {
apr_open :: AddEpAnn,
apr_close :: AddEpAnn,
apr_rest :: [AddEpAnn]
} deriving (Data,Eq)
data AnnSortKey
= NoAnnSortKey
| AnnSortKey [RealSrcSpan]
deriving (Data, Eq)
addTrailingAnnToL :: SrcSpan -> TrailingAnn -> EpAnnComments
-> EpAnn AnnList -> EpAnn AnnList
addTrailingAnnToL s t cs EpAnnNotUsed
= EpAnn (spanAsAnchor s) (AnnList (Just $ spanAsAnchor s) Nothing Nothing [] [t]) cs
addTrailingAnnToL _ t cs n = n { anns = addTrailing (anns n)
, comments = comments n <> cs }
where
addTrailing n = n { al_trailing = al_trailing n ++ [t]}
addTrailingAnnToA :: SrcSpan -> TrailingAnn -> EpAnnComments
-> EpAnn AnnListItem -> EpAnn AnnListItem
addTrailingAnnToA s t cs EpAnnNotUsed
= EpAnn (spanAsAnchor s) (AnnListItem [t]) cs
addTrailingAnnToA _ t cs n = n { anns = addTrailing (anns n)
, comments = comments n <> cs }
where
addTrailing n = n { lann_trailing = lann_trailing n ++ [t] }
addTrailingCommaToN :: SrcSpan -> EpAnn NameAnn -> EpaLocation -> EpAnn NameAnn
addTrailingCommaToN s EpAnnNotUsed l
= EpAnn (spanAsAnchor s) (NameAnnTrailing [AddCommaAnn l]) emptyComments
addTrailingCommaToN _ n l = n { anns = addTrailing (anns n) l }
where
addTrailing :: NameAnn -> EpaLocation -> NameAnn
addTrailing n l = n { nann_trailing = nann_trailing n ++ [AddCommaAnn l]}
l2n :: LocatedAn a1 a2 -> LocatedN a2
l2n (L la a) = L (noAnnSrcSpan (locA la)) a
n2l :: LocatedN a -> LocatedA a
n2l (L la a) = L (na2la la) a
la2na :: SrcSpanAnn' a -> SrcSpanAnnN
la2na l = noAnnSrcSpan (locA l)
la2la :: LocatedAn ann1 a2 -> LocatedAn ann2 a2
la2la (L la a) = L (noAnnSrcSpan (locA la)) a
l2l :: SrcSpanAnn' a -> SrcAnn ann
l2l l = noAnnSrcSpan (locA l)
na2la :: SrcSpanAnn' a -> SrcAnn ann
na2la l = noAnnSrcSpan (locA l)
reLoc :: LocatedAn a e -> Located e
reLoc (L (SrcSpanAnn _ l) a) = L l a
reLocA :: Located e -> LocatedAn ann e
reLocA (L l a) = (L (SrcSpanAnn EpAnnNotUsed l) a)
reLocL :: LocatedN e -> LocatedA e
reLocL (L l a) = (L (na2la l) a)
reLocC :: LocatedN e -> LocatedC e
reLocC (L l a) = (L (na2la l) a)
reLocN :: LocatedN a -> Located a
reLocN (L (SrcSpanAnn _ l) a) = L l a
realSrcSpan :: SrcSpan -> RealSrcSpan
realSrcSpan (RealSrcSpan s _) = s
realSrcSpan _ = mkRealSrcSpan l l
where
l = mkRealSrcLoc (fsLit "foo") (1) (1)
la2r :: SrcSpanAnn' a -> RealSrcSpan
la2r l = realSrcSpan (locA l)
extraToAnnList :: AnnList -> [AddEpAnn] -> AnnList
extraToAnnList (AnnList a o c e t) as = AnnList a o c (e++as) t
reAnn :: [TrailingAnn] -> EpAnnComments -> Located a -> LocatedA a
reAnn anns cs (L l a) = L (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnListItem anns) cs) l) a
reAnnC :: AnnContext -> EpAnnComments -> Located a -> LocatedC a
reAnnC anns cs (L l a) = L (SrcSpanAnn (EpAnn (spanAsAnchor l) anns cs) l) a
reAnnL :: ann -> EpAnnComments -> Located e -> GenLocated (SrcAnn ann) e
reAnnL anns cs (L l a) = L (SrcSpanAnn (EpAnn (spanAsAnchor l) anns cs) l) a
getLocAnn :: Located a -> SrcSpanAnnA
getLocAnn (L l _) = SrcSpanAnn EpAnnNotUsed l
getLocA :: GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (L (SrcSpanAnn _ l) _) = l
noLocA :: a -> LocatedAn an a
noLocA = L (SrcSpanAnn EpAnnNotUsed noSrcSpan)
noAnnSrcSpan :: SrcSpan -> SrcAnn ann
noAnnSrcSpan l = SrcSpanAnn EpAnnNotUsed l
noSrcSpanA :: SrcAnn ann
noSrcSpanA = noAnnSrcSpan noSrcSpan
noAnn :: EpAnn a
noAnn = EpAnnNotUsed
addAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (EpAnn l as1 cs) as2 cs2
= EpAnn (widenAnchor l (as1 ++ as2)) (as1 ++ as2) (cs <> cs2)
addAnns EpAnnNotUsed [] (EpaComments []) = EpAnnNotUsed
addAnns EpAnnNotUsed [] (EpaCommentsBalanced [] []) = EpAnnNotUsed
addAnns EpAnnNotUsed as cs = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) as cs
addAnnsA :: SrcSpanAnnA -> [TrailingAnn] -> EpAnnComments -> SrcSpanAnnA
addAnnsA (SrcSpanAnn (EpAnn l as1 cs) loc) as2 cs2
= SrcSpanAnn (EpAnn l (AnnListItem (lann_trailing as1 ++ as2)) (cs <> cs2)) loc
addAnnsA (SrcSpanAnn EpAnnNotUsed loc) [] (EpaComments [])
= SrcSpanAnn EpAnnNotUsed loc
addAnnsA (SrcSpanAnn EpAnnNotUsed loc) [] (EpaCommentsBalanced [] [])
= SrcSpanAnn EpAnnNotUsed loc
addAnnsA (SrcSpanAnn EpAnnNotUsed loc) as cs
= SrcSpanAnn (EpAnn (spanAsAnchor loc) (AnnListItem as) cs) loc
widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan
widenSpan s as = foldl combineSrcSpans s (go as)
where
go [] = []
go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Nothing : go rest
go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
widenRealSpan :: RealSrcSpan -> [AddEpAnn] -> RealSrcSpan
widenRealSpan s as = foldl combineRealSrcSpans s (go as)
where
go [] = []
go (AddEpAnn _ (EpaSpan s):rest) = s : go rest
go (AddEpAnn _ (EpaDelta _ _):rest) = go rest
widenAnchor :: Anchor -> [AddEpAnn] -> Anchor
widenAnchor (Anchor s op) as = Anchor (widenRealSpan s as) op
widenAnchorR :: Anchor -> RealSrcSpan -> Anchor
widenAnchorR (Anchor s op) r = Anchor (combineRealSrcSpans s r) op
widenLocatedAn :: SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an
widenLocatedAn (SrcSpanAnn a l) as = SrcSpanAnn a (widenSpan l as)
epAnnAnnsL :: EpAnn a -> [a]
epAnnAnnsL EpAnnNotUsed = []
epAnnAnnsL (EpAnn _ anns _) = [anns]
epAnnAnns :: EpAnn [AddEpAnn] -> [AddEpAnn]
epAnnAnns EpAnnNotUsed = []
epAnnAnns (EpAnn _ anns _) = anns
annParen2AddEpAnn :: EpAnn AnnParen -> [AddEpAnn]
annParen2AddEpAnn EpAnnNotUsed = []
annParen2AddEpAnn (EpAnn _ (AnnParen pt o c) _)
= [AddEpAnn ai o, AddEpAnn ac c]
where
(ai,ac) = parenTypeKws pt
epAnnComments :: EpAnn an -> EpAnnComments
epAnnComments EpAnnNotUsed = EpaComments []
epAnnComments (EpAnn _ _ cs) = cs
sortLocatedA :: [GenLocated (SrcSpanAnn' a) e] -> [GenLocated (SrcSpanAnn' a) e]
sortLocatedA = sortBy (leftmost_smallest `on` getLocA)
mapLocA :: (a -> b) -> GenLocated SrcSpan a -> GenLocated (SrcAnn ann) b
mapLocA f (L l a) = L (noAnnSrcSpan l) (f a)
combineLocsA :: Semigroup a => GenLocated (SrcAnn a) e1 -> GenLocated (SrcAnn a) e2 -> SrcAnn a
combineLocsA (L a _) (L b _) = combineSrcSpansA a b
combineSrcSpansA :: Semigroup a => SrcAnn a -> SrcAnn a -> SrcAnn a
combineSrcSpansA (SrcSpanAnn aa la) (SrcSpanAnn ab lb)
= case SrcSpanAnn (aa <> ab) (combineSrcSpans la lb) of
SrcSpanAnn EpAnnNotUsed l -> SrcSpanAnn EpAnnNotUsed l
SrcSpanAnn (EpAnn anc an cs) l ->
SrcSpanAnn (EpAnn (widenAnchorR anc (realSrcSpan l)) an cs) l
addCLocA :: GenLocated (SrcSpanAnn' a) e1 -> GenLocated SrcSpan e2 -> e3 -> GenLocated (SrcAnn ann) e3
addCLocA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (getLoc b)) c
addCLocAA :: GenLocated (SrcSpanAnn' a1) e1 -> GenLocated (SrcSpanAnn' a2) e2 -> e3 -> GenLocated (SrcAnn ann) e3
addCLocAA a b c = L (noAnnSrcSpan $ combineSrcSpans (locA $ getLoc a) (locA $ getLoc b)) c
getFollowingComments :: EpAnnComments -> [LEpaComment]
getFollowingComments (EpaComments _) = []
getFollowingComments (EpaCommentsBalanced _ cs) = cs
setFollowingComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
setFollowingComments (EpaComments ls) cs = EpaCommentsBalanced ls cs
setFollowingComments (EpaCommentsBalanced ls _) cs = EpaCommentsBalanced ls cs
setPriorComments :: EpAnnComments -> [LEpaComment] -> EpAnnComments
setPriorComments (EpaComments _) cs = EpaComments cs
setPriorComments (EpaCommentsBalanced _ ts) cs = EpaCommentsBalanced cs ts
type EpAnnCO = EpAnn NoEpAnns
data NoEpAnns = NoEpAnns
deriving (Data,Eq,Ord)
noComments ::EpAnnCO
noComments = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) NoEpAnns emptyComments
placeholderRealSpan :: RealSrcSpan
placeholderRealSpan = realSrcLocSpan (mkRealSrcLoc (mkFastString "placeholder") (1) (1))
comment :: RealSrcSpan -> EpAnnComments -> EpAnnCO
comment loc cs = EpAnn (Anchor loc UnchangedAnchor) NoEpAnns cs
addCommentsToSrcAnn :: (Monoid ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn (SrcSpanAnn EpAnnNotUsed loc) cs
= SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc
addCommentsToSrcAnn (SrcSpanAnn (EpAnn a an cs) loc) cs'
= SrcSpanAnn (EpAnn a an (cs <> cs')) loc
setCommentsSrcAnn :: (Monoid ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn (SrcSpanAnn EpAnnNotUsed loc) cs
= SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc
setCommentsSrcAnn (SrcSpanAnn (EpAnn a an _) loc) cs
= SrcSpanAnn (EpAnn a an cs) loc
addCommentsToEpAnn :: (Monoid a)
=> SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
addCommentsToEpAnn loc EpAnnNotUsed cs
= EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
addCommentsToEpAnn _ (EpAnn a an ocs) ncs = EpAnn a an (ocs <> ncs)
setCommentsEpAnn :: (Monoid a)
=> SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
setCommentsEpAnn loc EpAnnNotUsed cs
= EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
setCommentsEpAnn _ (EpAnn a an _) cs = EpAnn a an cs
transferAnnsA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferAnnsA from@(SrcSpanAnn EpAnnNotUsed _) to = (from, to)
transferAnnsA (SrcSpanAnn (EpAnn a an cs) l) to
= ((SrcSpanAnn (EpAnn a mempty emptyComments) l), to')
where
to' = case to of
(SrcSpanAnn EpAnnNotUsed loc)
-> SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) an cs) loc
(SrcSpanAnn (EpAnn a an' cs') loc)
-> SrcSpanAnn (EpAnn a (an' <> an) (cs' <> cs)) loc
commentsOnlyA :: Monoid ann => SrcAnn ann -> SrcAnn ann
commentsOnlyA (SrcSpanAnn EpAnnNotUsed loc) = SrcSpanAnn EpAnnNotUsed loc
commentsOnlyA (SrcSpanAnn (EpAnn a _ cs) loc) = (SrcSpanAnn (EpAnn a mempty cs) loc)
removeCommentsA :: SrcAnn ann -> SrcAnn ann
removeCommentsA (SrcSpanAnn EpAnnNotUsed loc) = SrcSpanAnn EpAnnNotUsed loc
removeCommentsA (SrcSpanAnn (EpAnn a an _) loc)
= (SrcSpanAnn (EpAnn a an emptyComments) loc)
instance (Semigroup an) => Semigroup (SrcSpanAnn' an) where
(SrcSpanAnn a1 l1) <> (SrcSpanAnn a2 l2) = SrcSpanAnn (a1 <> a2) (combineSrcSpans l1 l2)
instance (Semigroup a) => Semigroup (EpAnn a) where
EpAnnNotUsed <> x = x
x <> EpAnnNotUsed = x
(EpAnn l1 a1 b1) <> (EpAnn l2 a2 b2) = EpAnn (l1 <> l2) (a1 <> a2) (b1 <> b2)
instance Ord Anchor where
compare (Anchor s1 _) (Anchor s2 _) = compare s1 s2
instance Semigroup Anchor where
Anchor r1 o1 <> Anchor r2 _ = Anchor (combineRealSrcSpans r1 r2) o1
instance Semigroup EpAnnComments where
EpaComments cs1 <> EpaComments cs2 = EpaComments (cs1 ++ cs2)
EpaComments cs1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) as2
EpaCommentsBalanced cs1 as1 <> EpaComments cs2 = EpaCommentsBalanced (cs1 ++ cs2) as1
EpaCommentsBalanced cs1 as1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) (as1++as2)
instance (Monoid a) => Monoid (EpAnn a) where
mempty = EpAnnNotUsed
instance Semigroup AnnListItem where
(AnnListItem l1) <> (AnnListItem l2) = AnnListItem (l1 <> l2)
instance Monoid AnnListItem where
mempty = AnnListItem []
instance Semigroup AnnList where
(AnnList a1 o1 c1 r1 t1) <> (AnnList a2 o2 c2 r2 t2)
= AnnList (a1 <> a2) (c o1 o2) (c c1 c2) (r1 <> r2) (t1 <> t2)
where
c Nothing x = x
c x Nothing = x
c f _ = f
instance Monoid AnnList where
mempty = AnnList Nothing Nothing Nothing [] []
instance Semigroup NameAnn where
_ <> _ = panic "semigroup nameann"
instance Monoid NameAnn where
mempty = NameAnnTrailing []
instance Semigroup AnnSortKey where
NoAnnSortKey <> x = x
x <> NoAnnSortKey = x
AnnSortKey ls1 <> AnnSortKey ls2 = AnnSortKey (ls1 <> ls2)
instance Monoid AnnSortKey where
mempty = NoAnnSortKey
instance (Outputable a) => Outputable (EpAnn a) where
ppr (EpAnn l a c) = text "EpAnn" <+> ppr l <+> ppr a <+> ppr c
ppr EpAnnNotUsed = text "EpAnnNotUsed"
instance Outputable Anchor where
ppr (Anchor a o) = text "Anchor" <+> ppr a <+> ppr o
instance Outputable AnchorOperation where
ppr UnchangedAnchor = text "UnchangedAnchor"
ppr (MovedAnchor d) = text "MovedAnchor" <+> ppr d
instance Outputable DeltaPos where
ppr (SameLine c) = text "SameLine" <+> ppr c
ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c
instance Outputable (GenLocated Anchor EpaComment) where
ppr (L l c) = text "L" <+> ppr l <+> ppr c
instance Outputable EpAnnComments where
ppr (EpaComments cs) = text "EpaComments" <+> ppr cs
ppr (EpaCommentsBalanced cs ts) = text "EpaCommentsBalanced" <+> ppr cs <+> ppr ts
instance (NamedThing (Located a)) => NamedThing (LocatedAn an a) where
getName (L l a) = getName (L (locA l) a)
instance Outputable AnnContext where
ppr (AnnContext a o c) = text "AnnContext" <+> ppr a <+> ppr o <+> ppr c
instance Outputable AnnSortKey where
ppr NoAnnSortKey = text "NoAnnSortKey"
ppr (AnnSortKey ls) = text "AnnSortKey" <+> ppr ls
instance Outputable IsUnicodeSyntax where
ppr = text . show
instance Binary a => Binary (LocatedL a) where
put_ bh (L l x) = do
put_ bh (locA l)
put_ bh x
get bh = do
l <- get bh
x <- get bh
return (L (noAnnSrcSpan l) x)
instance (Outputable a) => Outputable (SrcSpanAnn' a) where
ppr (SrcSpanAnn a l) = text "SrcSpanAnn" <+> ppr a <+> ppr l
instance (Outputable a, Outputable e)
=> Outputable (GenLocated (SrcSpanAnn' a) e) where
ppr = pprLocated
instance Outputable AnnListItem where
ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts
instance Outputable NameAdornment where
ppr NameParens = text "NameParens"
ppr NameParensHash = text "NameParensHash"
ppr NameBackquotes = text "NameBackquotes"
ppr NameSquare = text "NameSquare"
instance Outputable NameAnn where
ppr (NameAnn a o n c t)
= text "NameAnn" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t
ppr (NameAnnCommas a o n c t)
= text "NameAnnCommas" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t
ppr (NameAnnOnly a o c t)
= text "NameAnnOnly" <+> ppr a <+> ppr o <+> ppr c <+> ppr t
ppr (NameAnnRArrow n t)
= text "NameAnnRArrow" <+> ppr n <+> ppr t
ppr (NameAnnQuote q n t)
= text "NameAnnQuote" <+> ppr q <+> ppr n <+> ppr t
ppr (NameAnnTrailing t)
= text "NameAnnTrailing" <+> ppr t
instance Outputable AnnList where
ppr (AnnList a o c r t)
= text "AnnList" <+> ppr a <+> ppr o <+> ppr c <+> ppr r <+> ppr t
instance Outputable AnnPragma where
ppr (AnnPragma o c r) = text "AnnPragma" <+> ppr o <+> ppr c <+> ppr r