{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.GHC.ExactPrint.Utils
(
ss2pos
, ss2posEnd
, ss2range
, undelta
, isPointSrcSpan
, pos2delta
, ss2delta
, addDP
, spanLength
, isGoodDelta
, rs, sr
, mkComment
, mkKWComment
, dpFromString
, comment2dp
, extractComments
, srcSpanStartLine
, srcSpanEndLine
, srcSpanStartColumn
, srcSpanEndColumn
, rdrName2String
, isSymbolRdrName
, tokComment
, isListComp
, isGadt
, isExactName
, getAnnotationEP
, annTrueEntryDelta
, annCommentEntryDelta
, annLeadingCommentEntryDelta
, orderByKey
, setAcs, setAcsWithLevel
, unsetAcs
, inAcs
, pushAcs
, bumpAcs
#if __GLASGOW_HASKELL__ <= 710
, makeBooleanFormulaAnns
#endif
, debug
, debugP
, debugM
, warn
, showGhc
, showAnnData
, occAttributes
, showSDoc_, showSDocDebug_
, ghead,glast,gtail,gfromJust
) where
import Control.Monad.State
import qualified Data.ByteString as B
import Data.Generics
import Data.Ord (comparing)
import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Lookup
#if __GLASGOW_HASKELL__ <= 710
import qualified BooleanFormula as GHC
#endif
import qualified GHC
#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Data.Bag as GHC
import qualified GHC.Driver.Session as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC.Types.Name as GHC
import qualified GHC.Types.Name.Set as GHC
import qualified GHC.Utils.Outputable as GHC
import qualified GHC.Types.Name.Reader as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Types.Var as GHC
import qualified GHC.Types.Name.Occurrence as OccName (OccName(..),occNameString,pprNameSpaceBrief)
#else
import qualified Bag as GHC
import qualified DynFlags as GHC
import qualified FastString as GHC
import qualified Name as GHC
import qualified NameSet as GHC
import qualified Outputable as GHC
import qualified RdrName as GHC
import qualified SrcLoc as GHC
import qualified Var as GHC
import qualified OccName(OccName(..),occNameString,pprNameSpaceBrief)
#endif
import Control.Arrow
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List
import Debug.Trace
{-# ANN module "HLint: ignore Eta reduce" #-}
{-# ANN module "HLint: ignore Redundant do" #-}
{-# ANN module "HLint: ignore Reduce duplication" #-}
debugEnabledFlag :: Bool
debugEnabledFlag :: Bool
debugEnabledFlag = Bool
False
debugPEnabledFlag :: Bool
debugPEnabledFlag :: Bool
debugPEnabledFlag = Bool
False
debug :: c -> String -> c
debug :: c -> String -> c
debug c
c String
s = if Bool
debugEnabledFlag
then String -> c -> c
forall a. String -> a -> a
trace String
s c
c
else c
c
debugP :: String -> c -> c
debugP :: String -> c -> c
debugP String
s c
c = if Bool
debugPEnabledFlag
then String -> c -> c
forall a. String -> a -> a
trace String
s c
c
else c
c
debugM :: Monad m => String -> m ()
debugM :: String -> m ()
debugM String
s = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugEnabledFlag (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
s
showGhc :: (GHC.Outputable a) => a -> String
showGhc :: a -> String
showGhc = DynFlags -> a -> String
forall a. Outputable a => DynFlags -> a -> String
GHC.showPpr DynFlags
GHC.unsafeGlobalDynFlags
warn :: c -> String -> c
warn :: c -> String -> c
warn c
c String
_ = c
c
isGoodDelta :: DeltaPos -> Bool
isGoodDelta :: DeltaPos -> Bool
isGoodDelta (DP (Int
ro,Int
co)) = Int
ro Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
co Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
ss2delta :: Pos -> GHC.SrcSpan -> DeltaPos
ss2delta :: (Int, Int) -> SrcSpan -> DeltaPos
ss2delta (Int, Int)
ref SrcSpan
ss = (Int, Int) -> (Int, Int) -> DeltaPos
pos2delta (Int, Int)
ref (SrcSpan -> (Int, Int)
ss2pos SrcSpan
ss)
pos2delta :: Pos -> Pos -> DeltaPos
pos2delta :: (Int, Int) -> (Int, Int) -> DeltaPos
pos2delta (Int
refl,Int
refc) (Int
l,Int
c) = (Int, Int) -> DeltaPos
DP (Int
lo,Int
co)
where
lo :: Int
lo = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
refl
co :: Int
co = if Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
refc
else Int
c
undelta :: Pos -> DeltaPos -> LayoutStartCol -> Pos
undelta :: (Int, Int) -> DeltaPos -> LayoutStartCol -> (Int, Int)
undelta (Int
l,Int
c) (DP (Int
dl,Int
dc)) (LayoutStartCol Int
co) = (Int
fl,Int
fc)
where
fl :: Int
fl = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dl
fc :: Int
fc = if Int
dl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dc
else Int
co Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dc
addDP :: DeltaPos -> DeltaPos -> DeltaPos
addDP :: DeltaPos -> DeltaPos -> DeltaPos
addDP (DP (Int
a, Int
b)) (DP (Int
c, Int
d)) =
if Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 then (Int, Int) -> DeltaPos
DP (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c, Int
d)
else (Int, Int) -> DeltaPos
DP (Int
a, Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)
stepDP :: DeltaPos -> DeltaPos -> DeltaPos
stepDP :: DeltaPos -> DeltaPos -> DeltaPos
stepDP (DP (Int
a,Int
b)) (DP (Int
c,Int
d))
| (Int
a,Int
b) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
c,Int
d) = (Int, Int) -> DeltaPos
DP (Int
a,Int
b)
| Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c = if Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d then (Int, Int) -> DeltaPos
DP (Int
0,Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b)
else if Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then (Int, Int) -> DeltaPos
DP (Int
1,Int
0)
else (Int, Int) -> DeltaPos
DP (Int
c,Int
d)
| Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c = (Int, Int) -> DeltaPos
DP (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a,Int
d)
| Bool
otherwise = (Int, Int) -> DeltaPos
DP (Int
1,Int
d)
ss2pos :: GHC.SrcSpan -> Pos
ss2pos :: SrcSpan -> (Int, Int)
ss2pos SrcSpan
ss = (SrcSpan -> Int
srcSpanStartLine SrcSpan
ss,SrcSpan -> Int
srcSpanStartColumn SrcSpan
ss)
ss2posEnd :: GHC.SrcSpan -> Pos
ss2posEnd :: SrcSpan -> (Int, Int)
ss2posEnd SrcSpan
ss = (SrcSpan -> Int
srcSpanEndLine SrcSpan
ss,SrcSpan -> Int
srcSpanEndColumn SrcSpan
ss)
ss2range :: GHC.SrcSpan -> (Pos,Pos)
ss2range :: SrcSpan -> ((Int, Int), (Int, Int))
ss2range SrcSpan
ss = (SrcSpan -> (Int, Int)
ss2pos SrcSpan
ss, SrcSpan -> (Int, Int)
ss2posEnd SrcSpan
ss)
srcSpanEndColumn :: GHC.SrcSpan -> Int
#if __GLASGOW_HASKELL__ >= 900
srcSpanEndColumn (GHC.RealSrcSpan s _) = GHC.srcSpanEndCol s
#else
srcSpanEndColumn :: SrcSpan -> Int
srcSpanEndColumn (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanEndCol RealSrcSpan
s
#endif
srcSpanEndColumn SrcSpan
_ = Int
0
srcSpanStartColumn :: GHC.SrcSpan -> Int
#if __GLASGOW_HASKELL__ >= 900
srcSpanStartColumn (GHC.RealSrcSpan s _) = GHC.srcSpanStartCol s
#else
srcSpanStartColumn :: SrcSpan -> Int
srcSpanStartColumn (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
s
#endif
srcSpanStartColumn SrcSpan
_ = Int
0
srcSpanEndLine :: GHC.SrcSpan -> Int
#if __GLASGOW_HASKELL__ >= 900
srcSpanEndLine (GHC.RealSrcSpan s _) = GHC.srcSpanEndLine s
#else
srcSpanEndLine :: SrcSpan -> Int
srcSpanEndLine (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
s
#endif
srcSpanEndLine SrcSpan
_ = Int
0
srcSpanStartLine :: GHC.SrcSpan -> Int
#if __GLASGOW_HASKELL__ >= 900
srcSpanStartLine (GHC.RealSrcSpan s _) = GHC.srcSpanStartLine s
#else
srcSpanStartLine :: SrcSpan -> Int
srcSpanStartLine (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
s
#endif
srcSpanStartLine SrcSpan
_ = Int
0
spanLength :: GHC.SrcSpan -> Int
spanLength :: SrcSpan -> Int
spanLength = (-) (Int -> Int -> Int) -> (SrcSpan -> Int) -> SrcSpan -> Int -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Int
srcSpanEndColumn (SrcSpan -> Int -> Int) -> (SrcSpan -> Int) -> SrcSpan -> Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SrcSpan -> Int
srcSpanStartColumn
isPointSrcSpan :: AnnSpan -> Bool
isPointSrcSpan :: SrcSpan -> Bool
isPointSrcSpan SrcSpan
ss = SrcSpan -> Int
spanLength (SrcSpan -> SrcSpan
sr SrcSpan
ss) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
Bool -> Bool -> Bool
&& SrcSpan -> Int
srcSpanStartLine (SrcSpan -> SrcSpan
sr SrcSpan
ss) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan -> Int
srcSpanEndLine (SrcSpan -> SrcSpan
sr SrcSpan
ss)
orderByKey :: (Eq o) => [(o,a)] -> [o] -> [(o,a)]
orderByKey :: [(o, a)] -> [o] -> [(o, a)]
orderByKey [(o, a)]
keys [o]
order
= ((o, a) -> (o, a) -> Ordering) -> [(o, a)] -> [(o, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((o, a) -> Maybe Int) -> (o, a) -> (o, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((o -> [o] -> Maybe Int) -> [o] -> o -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip o -> [o] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [o]
order (o -> Maybe Int) -> ((o, a) -> o) -> (o, a) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o, a) -> o
forall a b. (a, b) -> a
fst)) [(o, a)]
keys
isListComp :: GHC.HsStmtContext name -> Bool
isListComp :: HsStmtContext name -> Bool
isListComp HsStmtContext name
cts = case HsStmtContext name
cts of
HsStmtContext name
GHC.ListComp -> Bool
True
HsStmtContext name
GHC.MonadComp -> Bool
True
#if __GLASGOW_HASKELL__ <= 804
GHC.PArrComp -> True
#endif
#if __GLASGOW_HASKELL__ >= 900
GHC.DoExpr {} -> False
GHC.MDoExpr {} -> False
#else
HsStmtContext name
GHC.DoExpr -> Bool
False
HsStmtContext name
GHC.MDoExpr -> Bool
False
#endif
HsStmtContext name
GHC.ArrowExpr -> Bool
False
HsStmtContext name
GHC.GhciStmtCtxt -> Bool
False
GHC.PatGuard {} -> Bool
False
GHC.ParStmtCtxt {} -> Bool
False
GHC.TransStmtCtxt {} -> Bool
False
isGadt :: [GHC.LConDecl name] -> Bool
#if __GLASGOW_HASKELL__ >= 880
isGadt [] = True
#else
isGadt :: [LConDecl name] -> Bool
isGadt [] = Bool
False
#endif
#if __GLASGOW_HASKELL__ >= 900
isGadt ((GHC.L _ (GHC.ConDeclGADT{})):_) = True
isGadt ((GHC.L _ (GHC.XConDecl{})):_) = True
#elif __GLASGOW_HASKELL__ > 710
isGadt ((GHC.L SrcSpan
_ (GHC.ConDeclGADT{})):[LConDecl name]
_) = Bool
True
#else
isGadt (GHC.L _ GHC.ConDecl{GHC.con_res=GHC.ResTyGADT _ _}:_) = True
#endif
isGadt [LConDecl name]
_ = Bool
False
isExactName :: (Data name) => name -> Bool
isExactName :: name -> Bool
isExactName = Bool
False Bool -> (RdrName -> Bool) -> name -> Bool
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
`mkQ` RdrName -> Bool
GHC.isExact
rs :: GHC.SrcSpan -> AnnSpan
#if __GLASGOW_HASKELL__ >= 900
rs (GHC.RealSrcSpan s _) = s
rs _ = badRealSrcSpan
#else
rs :: SrcSpan -> SrcSpan
rs = SrcSpan -> SrcSpan
forall a. a -> a
id
#endif
#if __GLASGOW_HASKELL__ >= 900
sr :: GHC.RealSrcSpan -> GHC.SrcSpan
sr s = GHC.RealSrcSpan s Nothing
#else
sr :: GHC.SrcSpan -> GHC.SrcSpan
sr :: SrcSpan -> SrcSpan
sr = SrcSpan -> SrcSpan
forall a. a -> a
id
#endif
#if __GLASGOW_HASKELL__ >= 900
ghcCommentText :: GHC.RealLocated GHC.AnnotationComment -> String
#else
ghcCommentText :: GHC.Located GHC.AnnotationComment -> String
#endif
(GHC.L SrcSpan
_ (GHC.AnnDocCommentNext String
s)) = String
s
ghcCommentText (GHC.L SrcSpan
_ (GHC.AnnDocCommentPrev String
s)) = String
s
ghcCommentText (GHC.L SrcSpan
_ (GHC.AnnDocCommentNamed String
s)) = String
s
ghcCommentText (GHC.L SrcSpan
_ (GHC.AnnDocSection Int
_ String
s)) = String
s
ghcCommentText (GHC.L SrcSpan
_ (GHC.AnnDocOptions String
s)) = String
s
#if __GLASGOW_HASKELL__ < 801
ghcCommentText (GHC.L _ (GHC.AnnDocOptionsOld s)) = s
#endif
ghcCommentText (GHC.L SrcSpan
_ (GHC.AnnLineComment String
s)) = String
s
ghcCommentText (GHC.L SrcSpan
_ (GHC.AnnBlockComment String
s)) = String
s
#if __GLASGOW_HASKELL__ >= 900
tokComment :: GHC.RealLocated GHC.AnnotationComment -> Comment
tokComment t@(GHC.L lt _) = mkComment (ghcCommentText t) lt
#else
tokComment :: GHC.Located GHC.AnnotationComment -> Comment
t :: Located AnnotationComment
t@(GHC.L SrcSpan
lt AnnotationComment
_) = String -> SrcSpan -> Comment
mkComment (Located AnnotationComment -> String
ghcCommentText Located AnnotationComment
t) SrcSpan
lt
#endif
#if __GLASGOW_HASKELL__ >= 900
mkComment :: String -> GHC.RealSrcSpan -> Comment
mkComment c ss = Comment c ss Nothing
#else
mkComment :: String -> GHC.SrcSpan -> Comment
String
c SrcSpan
ss = String -> SrcSpan -> Maybe AnnKeywordId -> Comment
Comment String
c (SrcSpan -> SrcSpan
rs SrcSpan
ss) Maybe AnnKeywordId
forall a. Maybe a
Nothing
#endif
mkKWComment :: GHC.AnnKeywordId -> GHC.SrcSpan -> Comment
AnnKeywordId
kw SrcSpan
ss = String -> SrcSpan -> Maybe AnnKeywordId -> Comment
Comment (KeywordId -> String
keywordToString (KeywordId -> String) -> KeywordId -> String
forall a b. (a -> b) -> a -> b
$ AnnKeywordId -> KeywordId
G AnnKeywordId
kw) (SrcSpan -> SrcSpan
rs SrcSpan
ss) (AnnKeywordId -> Maybe AnnKeywordId
forall a. a -> Maybe a
Just AnnKeywordId
kw)
comment2dp :: (Comment, DeltaPos) -> (KeywordId, DeltaPos)
= (Comment -> KeywordId)
-> (Comment, DeltaPos) -> (KeywordId, DeltaPos)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Comment -> KeywordId
AnnComment
extractComments :: GHC.ApiAnns -> [Comment]
#if __GLASGOW_HASKELL__ >= 900
extractComments anns
= map tokComment $ GHC.sortRealLocated $ ((concat
$ Map.elems (GHC.apiAnnComments anns)) ++ GHC.apiAnnRogueComments anns)
#else
(Map ApiAnnKey [SrcSpan]
_,Map SrcSpan [Located AnnotationComment]
cm)
= (Located AnnotationComment -> Comment)
-> [Located AnnotationComment] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map Located AnnotationComment -> Comment
tokComment ([Located AnnotationComment] -> [Comment])
-> ([[Located AnnotationComment]] -> [Located AnnotationComment])
-> [[Located AnnotationComment]]
-> [Comment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located AnnotationComment] -> [Located AnnotationComment]
forall a. HasSrcSpan a => [a] -> [a]
GHC.sortLocated ([Located AnnotationComment] -> [Located AnnotationComment])
-> ([[Located AnnotationComment]] -> [Located AnnotationComment])
-> [[Located AnnotationComment]]
-> [Located AnnotationComment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Located AnnotationComment]] -> [Located AnnotationComment]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Located AnnotationComment]] -> [Comment])
-> [[Located AnnotationComment]] -> [Comment]
forall a b. (a -> b) -> a -> b
$ Map SrcSpan [Located AnnotationComment]
-> [[Located AnnotationComment]]
forall k a. Map k a -> [a]
Map.elems Map SrcSpan [Located AnnotationComment]
cm
#endif
#if (__GLASGOW_HASKELL__ > 806) && (__GLASGOW_HASKELL__ < 900)
getAnnotationEP :: (Data a,Data (GHC.SrcSpanLess a),GHC.HasSrcSpan a)
=> a -> Anns -> Maybe Annotation
#else
getAnnotationEP :: (Data a) => GHC.Located a -> Anns -> Maybe Annotation
#endif
getAnnotationEP :: a -> Anns -> Maybe Annotation
getAnnotationEP a
la Anns
as =
AnnKey -> Anns -> Maybe Annotation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey a
la) Anns
as
annTrueEntryDelta :: Annotation -> DeltaPos
annTrueEntryDelta :: Annotation -> DeltaPos
annTrueEntryDelta Ann{DeltaPos
annEntryDelta :: Annotation -> DeltaPos
annEntryDelta :: DeltaPos
annEntryDelta, [(Comment, DeltaPos)]
annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments :: [(Comment, DeltaPos)]
annPriorComments} =
(DeltaPos -> DeltaPos -> DeltaPos)
-> DeltaPos -> [DeltaPos] -> DeltaPos
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DeltaPos -> DeltaPos -> DeltaPos
addDP ((Int, Int) -> DeltaPos
DP (Int
0,Int
0)) (((Comment, DeltaPos) -> DeltaPos)
-> [(Comment, DeltaPos)] -> [DeltaPos]
forall a b. (a -> b) -> [a] -> [b]
map (\(Comment
a, DeltaPos
b) -> DeltaPos -> DeltaPos -> DeltaPos
addDP DeltaPos
b (String -> DeltaPos
dpFromString (String -> DeltaPos) -> String -> DeltaPos
forall a b. (a -> b) -> a -> b
$ Comment -> String
commentContents Comment
a)) [(Comment, DeltaPos)]
annPriorComments )
DeltaPos -> DeltaPos -> DeltaPos
`addDP` DeltaPos
annEntryDelta
annCommentEntryDelta :: Annotation -> DeltaPos -> DeltaPos
Ann{[(Comment, DeltaPos)]
annPriorComments :: [(Comment, DeltaPos)]
annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments} DeltaPos
trueDP = DeltaPos
dp
where
commentDP :: DeltaPos
commentDP =
(DeltaPos -> DeltaPos -> DeltaPos)
-> DeltaPos -> [DeltaPos] -> DeltaPos
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DeltaPos -> DeltaPos -> DeltaPos
addDP ((Int, Int) -> DeltaPos
DP (Int
0,Int
0)) (((Comment, DeltaPos) -> DeltaPos)
-> [(Comment, DeltaPos)] -> [DeltaPos]
forall a b. (a -> b) -> [a] -> [b]
map (\(Comment
a, DeltaPos
b) -> DeltaPos -> DeltaPos -> DeltaPos
addDP DeltaPos
b (String -> DeltaPos
dpFromString (String -> DeltaPos) -> String -> DeltaPos
forall a b. (a -> b) -> a -> b
$ Comment -> String
commentContents Comment
a)) [(Comment, DeltaPos)]
annPriorComments )
dp :: DeltaPos
dp = DeltaPos -> DeltaPos -> DeltaPos
stepDP DeltaPos
commentDP DeltaPos
trueDP
annLeadingCommentEntryDelta :: Annotation -> DeltaPos
Ann{[(Comment, DeltaPos)]
annPriorComments :: [(Comment, DeltaPos)]
annPriorComments :: Annotation -> [(Comment, DeltaPos)]
annPriorComments,DeltaPos
annEntryDelta :: DeltaPos
annEntryDelta :: Annotation -> DeltaPos
annEntryDelta} = DeltaPos
dp
where
dp :: DeltaPos
dp = case [(Comment, DeltaPos)]
annPriorComments of
[] -> DeltaPos
annEntryDelta
((Comment
_,DeltaPos
ed):[(Comment, DeltaPos)]
_) -> DeltaPos
ed
dpFromString :: String -> DeltaPos
dpFromString :: String -> DeltaPos
dpFromString String
xs = String -> Int -> Int -> DeltaPos
dpFromString' String
xs Int
0 Int
0
where
dpFromString' :: String -> Int -> Int -> DeltaPos
dpFromString' String
"" Int
line Int
col = (Int, Int) -> DeltaPos
DP (Int
line, Int
col)
dpFromString' (Char
'\n': String
cs) Int
line Int
_ = String -> Int -> Int -> DeltaPos
dpFromString' String
cs (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0
dpFromString' (Char
_:String
cs) Int
line Int
col = String -> Int -> Int -> DeltaPos
dpFromString' String
cs Int
line (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
isSymbolRdrName :: GHC.RdrName -> Bool
isSymbolRdrName :: RdrName -> Bool
isSymbolRdrName RdrName
n = OccName -> Bool
GHC.isSymOcc (OccName -> Bool) -> OccName -> Bool
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
GHC.rdrNameOcc RdrName
n
rdrName2String :: GHC.RdrName -> String
rdrName2String :: RdrName -> String
rdrName2String RdrName
r =
case RdrName -> Maybe Name
GHC.isExact_maybe RdrName
r of
Just Name
n -> Name -> String
name2String Name
n
Maybe Name
Nothing ->
case RdrName
r of
GHC.Unqual OccName
occ -> OccName -> String
GHC.occNameString OccName
occ
GHC.Qual ModuleName
modname OccName
occ -> ModuleName -> String
GHC.moduleNameString ModuleName
modname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
GHC.occNameString OccName
occ
GHC.Orig Module
_ OccName
occ -> OccName -> String
GHC.occNameString OccName
occ
GHC.Exact Name
n -> Name -> String
forall a. NamedThing a => a -> String
GHC.getOccString Name
n
name2String :: GHC.Name -> String
name2String :: Name -> String
name2String = Name -> String
forall a. Outputable a => a -> String
showGhc
setAcs :: Set.Set AstContext -> AstContextSet -> AstContextSet
setAcs :: Set AstContext -> AstContextSet -> AstContextSet
setAcs Set AstContext
ctxt AstContextSet
acs = Set AstContext -> Int -> AstContextSet -> AstContextSet
forall a. Ord a => Set a -> Int -> ACS' a -> ACS' a
setAcsWithLevel Set AstContext
ctxt Int
3 AstContextSet
acs
setAcsWithLevel :: (Ord a) => Set.Set a -> Int -> ACS' a -> ACS' a
setAcsWithLevel :: Set a -> Int -> ACS' a -> ACS' a
setAcsWithLevel Set a
ctxt Int
level (ACS Map a Int
a) = Map a Int -> ACS' a
forall a. Map a Int -> ACS' a
ACS Map a Int
a'
where
upd :: Map k a -> (k, a) -> Map k a
upd Map k a
s (k
k,a
v) = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k a
v Map k a
s
a' :: Map a Int
a' = (Map a Int -> (a, Int) -> Map a Int)
-> Map a Int -> [(a, Int)] -> Map a Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map a Int -> (a, Int) -> Map a Int
forall k a. Ord k => Map k a -> (k, a) -> Map k a
upd Map a Int
a ([(a, Int)] -> Map a Int) -> [(a, Int)] -> Map a Int
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
ctxt) (Int -> [Int]
forall a. a -> [a]
repeat Int
level)
unsetAcs :: (Ord a) => a -> ACS' a -> ACS' a
unsetAcs :: a -> ACS' a -> ACS' a
unsetAcs a
ctxt (ACS Map a Int
a) = Map a Int -> ACS' a
forall a. Map a Int -> ACS' a
ACS (Map a Int -> ACS' a) -> Map a Int -> ACS' a
forall a b. (a -> b) -> a -> b
$ a -> Map a Int -> Map a Int
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
ctxt Map a Int
a
inAcs :: (Ord a) => Set.Set a -> ACS' a -> Bool
inAcs :: Set a -> ACS' a -> Bool
inAcs Set a
ctxt (ACS Map a Int
a) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> Bool
forall a. Set a -> Bool
Set.null (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set a
ctxt ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ Map a Int -> [a]
forall k a. Map k a -> [k]
Map.keys Map a Int
a)
pushAcs :: ACS' a -> ACS' a
pushAcs :: ACS' a -> ACS' a
pushAcs (ACS Map a Int
a) = Map a Int -> ACS' a
forall a. Map a Int -> ACS' a
ACS (Map a Int -> ACS' a) -> Map a Int -> ACS' a
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe Int) -> Map a Int -> Map a Int
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Int -> Maybe Int
forall a. (Ord a, Num a) => a -> Maybe a
f Map a Int
a
where
f :: a -> Maybe a
f a
n
| a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1 = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
bumpAcs :: ACS' a -> ACS' a
bumpAcs :: ACS' a -> ACS' a
bumpAcs (ACS Map a Int
a) = Map a Int -> ACS' a
forall a. Map a Int -> ACS' a
ACS (Map a Int -> ACS' a) -> Map a Int -> ACS' a
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe Int) -> Map a Int -> Map a Int
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Int -> Maybe Int
forall a. Num a => a -> Maybe a
f Map a Int
a
where
f :: a -> Maybe a
f a
n = a -> Maybe a
forall a. a -> Maybe a
Just (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
#if __GLASGOW_HASKELL__ <= 710
makeBooleanFormulaAnns :: (GHC.Outputable a)
=> GHC.BooleanFormula (GHC.Located a) -> [(GHC.AnnKeywordId,GHC.SrcSpan)]
makeBooleanFormulaAnns bf = go 1 bf
where
go :: (GHC.Outputable a)
=> Int -> GHC.BooleanFormula (GHC.Located a) -> [(GHC.AnnKeywordId,GHC.SrcSpan)]
go _ (GHC.Var _) = []
go l v@(GHC.And [a,b]) =
go 3 a ++
go 3 b ++
(if l > 3 then addParensIfNeeded v else []) ++
[(GHC.AnnComma, ssAfter (getBoolSrcSpan a))]
go l v@(GHC.Or [a,b]) =
go 2 a ++
go 2 b ++
(if l > 2 then addParensIfNeeded v else []) ++
[(GHC.AnnVbar, ssAfter (getBoolSrcSpan a) )]
go _ x = error $ "makeBooleanFormulaAnns: unexpected case:" ++ showGhc x
addParensIfNeeded :: GHC.Outputable a
=> GHC.BooleanFormula (GHC.Located a)
-> [(GHC.AnnKeywordId, GHC.SrcSpan)]
addParensIfNeeded (GHC.Var _) = []
addParensIfNeeded a = [(GHC.AnnOpenP,opp),(GHC.AnnCloseP,cpp)]
where
ss = getBoolSrcSpan a
opp = ssBefore ss
cpp = ssAfter ss
ssBefore :: GHC.SrcSpan -> GHC.SrcSpan
ssBefore a = GHC.mkSrcSpan (GHC.RealSrcLoc s) (GHC.RealSrcLoc e)
where
GHC.RealSrcLoc as = GHC.srcSpanStart a
s = GHC.mkRealSrcLoc (GHC.srcLocFile as) (GHC.srcLocLine as) (GHC.srcLocCol as - 2)
e = GHC.mkRealSrcLoc (GHC.srcLocFile as) (GHC.srcLocLine as) (GHC.srcLocCol as - 1)
ssAfter :: GHC.SrcSpan -> GHC.SrcSpan
ssAfter a = GHC.mkSrcSpan (GHC.RealSrcLoc s) (GHC.RealSrcLoc e)
where
GHC.RealSrcLoc ae = GHC.srcSpanEnd a
s = ae
e = GHC.advanceSrcLoc s ' '
getBoolSrcSpan :: (GHC.Outputable a) => GHC.BooleanFormula (GHC.Located a) -> GHC.SrcSpan
getBoolSrcSpan (GHC.Var (GHC.L ss _)) = ss
getBoolSrcSpan (GHC.And [a,b]) = GHC.combineSrcSpans (getBoolSrcSpan a) (getBoolSrcSpan b)
getBoolSrcSpan (GHC.Or [a,b]) = GHC.combineSrcSpans (getBoolSrcSpan a) (getBoolSrcSpan b)
getBoolSrcSpan x = error $ "getBoolSrcSpan: unexpected case:" ++ showGhc x
#endif
showAnnData :: Data a => Anns -> Int -> a -> String
showAnnData :: Anns -> Int -> a -> String
showAnnData Anns
anns Int
n =
a -> String
forall a. Data a => a -> String
generic
(a -> String) -> (forall e. Data e => [e] -> String) -> a -> String
forall d (t :: * -> *) q.
(Data d, Typeable t) =>
(d -> q) -> (forall e. Data e => t e -> q) -> d -> q
`ext1Q` forall e. Data e => [e] -> String
list
(a -> String) -> (String -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` String -> String
string (a -> String) -> (FastString -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` FastString -> String
fastString (a -> String) -> (SrcSpan -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` SrcSpan -> String
srcSpan
(a -> String) -> (ByteString -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ByteString -> String
bytestring
(a -> String) -> (Name -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Name -> String
name (a -> String) -> (OccName -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` OccName -> String
occName (a -> String) -> (ModuleName -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ModuleName -> String
moduleName (a -> String) -> (Var -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Var -> String
var (a -> String) -> (DataCon -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` DataCon -> String
dataCon
(a -> String)
-> (Bag (Located (HsBind GhcRn)) -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (Located (HsBind GhcRn)) -> String
bagName (a -> String)
-> (Bag (Located (HsBind GhcPs)) -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (Located (HsBind GhcPs)) -> String
bagRdrName (a -> String)
-> (Bag (Located (HsBind GhcTc)) -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Bag (Located (HsBind GhcTc)) -> String
bagVar (a -> String) -> (NameSet -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` NameSet -> String
nameSet
(a -> String) -> (Fixity -> String) -> a -> String
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Fixity -> String
fixity
(a -> String)
-> (forall d1 d2. (Data d1, Data d2) => GenLocated d1 d2 -> String)
-> a
-> String
forall d (t :: * -> * -> *) q.
(Data d, Typeable t) =>
(d -> q)
-> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q
`ext2Q` forall d1 d2. (Data d1, Data d2) => GenLocated d1 d2 -> String
forall b loc. (Data b, Data loc) => GenLocated loc b -> String
located
where generic :: Data a => a -> String
generic :: a -> String
generic a
t = Int -> String
indent Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Constr -> String
showConstr (a -> Constr
forall a. Data a => a -> Constr
toConstr a
t)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
space ([String] -> String
unwords ((forall a. Data a => a -> String) -> a -> [String]
forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
gmapQ (Anns -> Int -> d -> String
forall a. Data a => Anns -> Int -> a -> String
showAnnData Anns
anns (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) a
t)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
space :: String -> String
space String
"" = String
""
space String
s = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s
indent :: Int -> String
indent Int
i = String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' '
string :: String -> String
string = String -> String
forall a. Show a => a -> String
show :: String -> String
fastString :: FastString -> String
fastString = (String
"{FastString: "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String)
-> (FastString -> String) -> FastString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> String
forall a. Show a => a -> String
show :: GHC.FastString -> String
bytestring :: ByteString -> String
bytestring = ByteString -> String
forall a. Show a => a -> String
show :: B.ByteString -> String
list :: [a] -> String
list [a]
l = Int -> String
indent Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"["
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Anns -> Int -> a -> String
forall a. Data a => Anns -> Int -> a -> String
showAnnData Anns
anns (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) [a]
l) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
name :: Name -> String
name = (String
"{Name: "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
showSDocDebug_ (SDoc -> String) -> (Name -> SDoc) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr :: GHC.Name -> String
occName :: OccName -> String
occName OccName
o = String
"{OccName: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
OccName.occNameString OccName
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occAttributes OccName
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
moduleName :: ModuleName -> String
moduleName = (String
"{ModuleName: "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ModuleName -> String) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String)
-> (ModuleName -> String) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
showSDoc_ (SDoc -> String) -> (ModuleName -> SDoc) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr :: GHC.ModuleName -> String
srcSpan :: GHC.SrcSpan -> String
srcSpan :: SrcSpan -> String
srcSpan SrcSpan
ss = String
"{ "String -> String -> String
forall a. [a] -> [a] -> [a]
++ SDoc -> String
showSDoc_ (SDoc -> Int -> SDoc -> SDoc
GHC.hang (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr SrcSpan
ss) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
(String -> SDoc
GHC.text String
"")
)
String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}"
var :: Var -> String
var = (String
"{Var: "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Var -> String) -> Var -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String) -> (Var -> String) -> Var -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
showSDocDebug_ (SDoc -> String) -> (Var -> SDoc) -> Var -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr :: GHC.Var -> String
dataCon :: DataCon -> String
dataCon = (String
"{DataCon: "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (DataCon -> String) -> DataCon -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String) -> (DataCon -> String) -> DataCon -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
showSDoc_ (SDoc -> String) -> (DataCon -> SDoc) -> DataCon -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr :: GHC.DataCon -> String
bagRdrName:: GHC.Bag (GHC.Located (GHC.HsBind GhcPs)) -> String
bagRdrName :: Bag (Located (HsBind GhcPs)) -> String
bagRdrName = (String
"{Bag(Located (HsBind RdrName)): "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (Bag (Located (HsBind GhcPs)) -> String)
-> Bag (Located (HsBind GhcPs))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String)
-> (Bag (Located (HsBind GhcPs)) -> String)
-> Bag (Located (HsBind GhcPs))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (HsBind GhcPs)] -> String
forall e. Data e => [e] -> String
list ([Located (HsBind GhcPs)] -> String)
-> (Bag (Located (HsBind GhcPs)) -> [Located (HsBind GhcPs)])
-> Bag (Located (HsBind GhcPs))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (Located (HsBind GhcPs)) -> [Located (HsBind GhcPs)]
forall a. Bag a -> [a]
GHC.bagToList
bagName :: GHC.Bag (GHC.Located (GHC.HsBind GhcRn)) -> String
bagName :: Bag (Located (HsBind GhcRn)) -> String
bagName = (String
"{Bag(Located (HsBind Name)): "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (Bag (Located (HsBind GhcRn)) -> String)
-> Bag (Located (HsBind GhcRn))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String)
-> (Bag (Located (HsBind GhcRn)) -> String)
-> Bag (Located (HsBind GhcRn))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (HsBind GhcRn)] -> String
forall e. Data e => [e] -> String
list ([Located (HsBind GhcRn)] -> String)
-> (Bag (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)])
-> Bag (Located (HsBind GhcRn))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (Located (HsBind GhcRn)) -> [Located (HsBind GhcRn)]
forall a. Bag a -> [a]
GHC.bagToList
bagVar :: GHC.Bag (GHC.Located (GHC.HsBind GhcTc)) -> String
bagVar :: Bag (Located (HsBind GhcTc)) -> String
bagVar = (String
"{Bag(Located (HsBind Var)): "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (Bag (Located (HsBind GhcTc)) -> String)
-> Bag (Located (HsBind GhcTc))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String)
-> (Bag (Located (HsBind GhcTc)) -> String)
-> Bag (Located (HsBind GhcTc))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (HsBind GhcTc)] -> String
forall e. Data e => [e] -> String
list ([Located (HsBind GhcTc)] -> String)
-> (Bag (Located (HsBind GhcTc)) -> [Located (HsBind GhcTc)])
-> Bag (Located (HsBind GhcTc))
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bag (Located (HsBind GhcTc)) -> [Located (HsBind GhcTc)]
forall a. Bag a -> [a]
GHC.bagToList
#if __GLASGOW_HASKELL__ > 800
nameSet :: NameSet -> String
nameSet = (String
"{NameSet: "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (NameSet -> String) -> NameSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String) -> (NameSet -> String) -> NameSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> String
forall e. Data e => [e] -> String
list ([Name] -> String) -> (NameSet -> [Name]) -> NameSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSet -> [Name]
GHC.nameSetElemsStable
#else
nameSet = ("{NameSet: "++) . (++"}") . list . GHC.nameSetElems
#endif
fixity :: Fixity -> String
fixity = (String
"{Fixity: "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Fixity -> String) -> Fixity -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}") (String -> String) -> (Fixity -> String) -> Fixity -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
showSDoc_ (SDoc -> String) -> (Fixity -> SDoc) -> Fixity -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixity -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr :: GHC.Fixity -> String
located :: (Data b,Data loc) => GHC.GenLocated loc b -> String
located :: GenLocated loc b -> String
located (GHC.L loc
ss b
a) =
Int -> String
indent Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ case loc -> Maybe SrcSpan
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast loc
ss of
Just (SrcSpan
s :: GHC.SrcSpan) ->
SrcSpan -> String
srcSpan SrcSpan
s
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++
Maybe Annotation -> String
forall a. Show a => a -> String
show (GenLocated SrcSpan b -> Anns -> Maybe Annotation
forall a.
(Data a, Data (SrcSpanLess a), HasSrcSpan a) =>
a -> Anns -> Maybe Annotation
getAnnotationEP (SrcSpan -> b -> GenLocated SrcSpan b
forall l e. l -> e -> GenLocated l e
GHC.L SrcSpan
s b
a) Anns
anns)
Maybe SrcSpan
Nothing -> String
"nnnnnnnn"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Anns -> Int -> b -> String
forall a. Data a => Anns -> Int -> a -> String
showAnnData Anns
anns (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) b
a
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
occAttributes :: OccName.OccName -> String
occAttributes :: OccName -> String
occAttributes OccName
o = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ns String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ds String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
where
ns :: String
ns = (SDoc -> String
GHC.showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ NameSpace -> SDoc
OccName.pprNameSpaceBrief (NameSpace -> SDoc) -> NameSpace -> SDoc
forall a b. (a -> b) -> a -> b
$ OccName -> NameSpace
GHC.occNameSpace OccName
o) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", "
vo :: String
vo = if OccName -> Bool
GHC.isVarOcc OccName
o then String
"Var " else String
""
tv :: String
tv = if OccName -> Bool
GHC.isTvOcc OccName
o then String
"Tv " else String
""
tc :: String
tc = if OccName -> Bool
GHC.isTcOcc OccName
o then String
"Tc " else String
""
d :: String
d = if OccName -> Bool
GHC.isDataOcc OccName
o then String
"Data " else String
""
ds :: String
ds = if OccName -> Bool
GHC.isDataSymOcc OccName
o then String
"DataSym " else String
""
s :: String
s = if OccName -> Bool
GHC.isSymOcc OccName
o then String
"Sym " else String
""
v :: String
v = if OccName -> Bool
GHC.isValOcc OccName
o then String
"Val " else String
""
showSDoc_ :: GHC.SDoc -> String
showSDoc_ :: SDoc -> String
showSDoc_ = DynFlags -> SDoc -> String
GHC.showSDoc DynFlags
GHC.unsafeGlobalDynFlags
showSDocDebug_ :: GHC.SDoc -> String
#if __GLASGOW_HASKELL__ <= 710
showSDocDebug_ = GHC.showSDoc GHC.unsafeGlobalDynFlags
#else
showSDocDebug_ :: SDoc -> String
showSDocDebug_ = DynFlags -> SDoc -> String
GHC.showSDocDebug DynFlags
GHC.unsafeGlobalDynFlags
#endif
ghead :: String -> [a] -> a
ghead :: String -> [a] -> a
ghead String
info [] = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"ghead "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
infoString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" []"
ghead String
_info (a
h:[a]
_) = a
h
glast :: String -> [a] -> a
glast :: String -> [a] -> a
glast String
info [] = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"glast " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
info String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" []"
glast String
_info [a]
h = [a] -> a
forall a. [a] -> a
last [a]
h
gtail :: String -> [a] -> [a]
gtail :: String -> [a] -> [a]
gtail String
info [] = String -> [a]
forall a. HasCallStack => String -> a
error (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$ String
"gtail " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
info String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" []"
gtail String
_info [a]
h = [a] -> [a]
forall a. [a] -> [a]
tail [a]
h
gfromJust :: String -> Maybe a -> a
gfromJust :: String -> Maybe a -> a
gfromJust String
_info (Just a
h) = a
h
gfromJust String
info Maybe a
Nothing = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"gfromJust " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
info String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Nothing"