{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.GHC.ExactPrint.Utils
  (
   -- * Manipulating Positons
    ss2pos
  , ss2posEnd
  , undelta
  , isPointSrcSpan
  , pos2delta
  , ss2delta
  , addDP
  , spanLength
  , isGoodDelta

  -- * Manipulating Comments
  , mkComment
  , mkKWComment
  , dpFromString
  , comment2dp
  , extractComments

    -- * GHC Functions
  , srcSpanStartLine
  , srcSpanEndLine
  , srcSpanStartColumn
  , srcSpanEndColumn
  , rdrName2String
  , isSymbolRdrName
  , tokComment
  , isListComp
  , isGadt
  , isExactName


  -- * Manipulating Annotations
  , getAnnotationEP
  , annTrueEntryDelta
  , annCommentEntryDelta
  , annLeadingCommentEntryDelta

  -- * General Utility
  , orderByKey


  -- * AST Context management
  , setAcs, setAcsWithLevel
  , unsetAcs
  , inAcs
  , pushAcs
  , bumpAcs

#if __GLASGOW_HASKELL__ <= 710
  -- * for boolean formulas in GHC 7.10.3
  -- ,LBooleanFormula, BooleanFormula(..)
  , makeBooleanFormulaAnns
#endif

  -- * For tests
  , debug
  , debugP
  , debugM
  , warn
  , showGhc
  , showAnnData
  , occAttributes

  , showSDoc_,  showSDocDebug_
  -- AZ's baggage
  , 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

import qualified Bag            as GHC
#if __GLASGOW_HASKELL__ <= 710
import qualified BooleanFormula as GHC
#endif
import qualified DynFlags       as GHC
import qualified FastString     as GHC
import qualified 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)

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

-- |Global switch to enable debug tracing in ghc-exactprint Delta / Print
debugEnabledFlag :: Bool
-- debugEnabledFlag = True
debugEnabledFlag :: Bool
debugEnabledFlag = Bool
False

-- |Global switch to enable debug tracing in ghc-exactprint Pretty
debugPEnabledFlag :: Bool
-- debugPEnabledFlag = True
debugPEnabledFlag :: Bool
debugPEnabledFlag = Bool
False

-- |Provide a version of trace that comes at the end of the line, so it can
-- easily be commented out when debugging different things.
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

-- |Provide a version of trace for the Pretty module, which can be enabled
-- separately from 'debug' and 'debugM'
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

-- | Show a GHC.Outputable structure
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 = flip trace
warn :: c -> String -> c
warn c
c String
_ = c
c

-- | A good delta has no negative values.
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


-- | Create a delta from the current position to the start of the given
-- @SrcSpan@.
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)

-- | Convert the start of the second @Pos@ to be an offset from the
-- first. The assumption is the reference starts before the second @Pos@
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

-- | Apply the delta to the current position, taking into account the
-- current column offset if advancing to a new line
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

-- | Add together two @DeltaPos@ taking into account newlines
--
-- > DP (0, 1) `addDP` DP (0, 2) == DP (0, 3)
-- > DP (0, 9) `addDP` DP (1, 5) == DP (1, 5)
-- > DP (1, 4) `addDP` DP (1, 3) == DP (2, 3)
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)

-- | "Subtract" two @DeltaPos@ from each other, in the sense of calculating the
-- remaining delta for the second after the first has been applied.
-- invariant : if c = a `addDP` b
--             then a `stepDP` c == b
--
-- Cases where first DP is <= than second
-- > DP (0, 1) `addDP` DP (0, 2) == DP (0, 1)
-- > DP (1, 1) `addDP` DP (2, 0) == DP (1, 0)
-- > DP (1, 3) `addDP` DP (1, 4) == DP (0, 1)
-- > DP (1, 4) `addDP` DP (1, 4) == DP (1, 4)
--
-- Cases where first DP is > than second
-- > DP (0,  3) `addDP` DP (0, 2) == DP (0,1)  -- advance one at least
-- > DP (3,  3) `addDP` DP (2, 4) == DP (1, 4) -- go one line forward and to expected col
-- > DP (3,  3) `addDP` DP (0, 4) == DP (0, 1) -- maintain col delta at least
-- > DP (1, 21) `addDP` DP (1, 4) == DP (1, 4) -- go one line forward and to expected col
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 DP (0,1)
                             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)

srcSpanEndColumn :: GHC.SrcSpan -> Int
srcSpanEndColumn :: SrcSpan -> Int
srcSpanEndColumn (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanEndCol RealSrcSpan
s
srcSpanEndColumn SrcSpan
_ = Int
0

srcSpanStartColumn :: GHC.SrcSpan -> Int
srcSpanStartColumn :: SrcSpan -> Int
srcSpanStartColumn (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanStartCol RealSrcSpan
s
srcSpanStartColumn SrcSpan
_ = Int
0

srcSpanEndLine :: GHC.SrcSpan -> Int
srcSpanEndLine :: SrcSpan -> Int
srcSpanEndLine (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
s
srcSpanEndLine SrcSpan
_ = Int
0

srcSpanStartLine :: GHC.SrcSpan -> Int
srcSpanStartLine :: SrcSpan -> Int
srcSpanStartLine (GHC.RealSrcSpan RealSrcSpan
s) = RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
s
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

-- ---------------------------------------------------------------------
-- | Checks whether a SrcSpan has zero length.
isPointSrcSpan :: GHC.SrcSpan -> Bool
isPointSrcSpan :: SrcSpan -> Bool
isPointSrcSpan SrcSpan
ss = SrcSpan -> Int
spanLength SrcSpan
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                  Bool -> Bool -> Bool
&& SrcSpan -> Int
srcSpanStartLine SrcSpan
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan -> Int
srcSpanEndLine SrcSpan
ss

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

-- |Given a list of items and a list of keys, returns a list of items
-- ordered by their position in the list of keys.
orderByKey :: [(GHC.SrcSpan,a)] -> [GHC.SrcSpan] -> [(GHC.SrcSpan,a)]
orderByKey :: [(SrcSpan, a)] -> [SrcSpan] -> [(SrcSpan, a)]
orderByKey [(SrcSpan, a)]
keys [SrcSpan]
order
    -- AZ:TODO: if performance becomes a problem, consider a Map of the order
    -- SrcSpan to an index, and do a lookup instead of elemIndex.

    -- Items not in the ordering are placed to the start
 = ((SrcSpan, a) -> (SrcSpan, a) -> Ordering)
-> [(SrcSpan, a)] -> [(SrcSpan, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((SrcSpan, a) -> Maybe Int)
-> (SrcSpan, a) -> (SrcSpan, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((SrcSpan -> [SrcSpan] -> Maybe Int)
-> [SrcSpan] -> SrcSpan -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip SrcSpan -> [SrcSpan] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [SrcSpan]
order (SrcSpan -> Maybe Int)
-> ((SrcSpan, a) -> SrcSpan) -> (SrcSpan, a) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, a) -> SrcSpan
forall a b. (a, b) -> a
fst)) [(SrcSpan, 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

          HsStmtContext name
GHC.DoExpr       -> Bool
False
          HsStmtContext name
GHC.MDoExpr      -> Bool
False
          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
isGadt :: [LConDecl name] -> Bool
isGadt [] = Bool
False
#if __GLASGOW_HASKELL__ <= 710
isGadt (GHC.L _ GHC.ConDecl{GHC.con_res=GHC.ResTyGADT _ _}:_) = True
#else
isGadt ((GHC.L SrcSpan
_ (GHC.ConDeclGADT{})):[LConDecl name]
_) = Bool
True
#endif
isGadt [LConDecl name]
_ = Bool
False

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

-- Is a RdrName of type Exact? SYB query, so can be extended to other types too
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

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

ghcCommentText :: GHC.Located GHC.AnnotationComment -> String
ghcCommentText :: Located AnnotationComment -> String
ghcCommentText (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

tokComment :: GHC.Located GHC.AnnotationComment -> Comment
tokComment :: Located AnnotationComment -> Comment
tokComment t :: Located AnnotationComment
t@(GHC.L SrcSpan
lt AnnotationComment
_) = String -> SrcSpan -> Comment
mkComment (Located AnnotationComment -> String
ghcCommentText Located AnnotationComment
t) SrcSpan
lt

mkComment :: String -> GHC.SrcSpan -> Comment
mkComment :: String -> SrcSpan -> Comment
mkComment String
c SrcSpan
ss = String -> SrcSpan -> Maybe AnnKeywordId -> Comment
Comment String
c SrcSpan
ss Maybe AnnKeywordId
forall a. Maybe a
Nothing

-- | Makes a comment which originates from a specific keyword.
mkKWComment :: GHC.AnnKeywordId -> GHC.SrcSpan -> Comment
mkKWComment :: AnnKeywordId -> SrcSpan -> Comment
mkKWComment 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
ss (AnnKeywordId -> Maybe AnnKeywordId
forall a. a -> Maybe a
Just AnnKeywordId
kw)

comment2dp :: (Comment,  DeltaPos) -> (KeywordId, DeltaPos)
comment2dp :: (Comment, DeltaPos) -> (KeywordId, DeltaPos)
comment2dp = (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]
extractComments :: ApiAnns -> [Comment]
extractComments (Map ApiAnnKey [SrcSpan]
_,Map SrcSpan [Located AnnotationComment]
cm)
  -- cm has type :: Map SrcSpan [Located AnnotationComment]
  = (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

#if __GLASGOW_HASKELL__ > 806
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

-- | The "true entry" is the distance from the last concrete element to the
-- start of the current element.
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

-- | Take an annotation and a required "true entry" and calculate an equivalent
-- one relative to the last comment in the annPriorComments.
annCommentEntryDelta :: Annotation -> DeltaPos -> DeltaPos
annCommentEntryDelta :: Annotation -> DeltaPos -> DeltaPos
annCommentEntryDelta 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

-- | Return the DP of the first item that generates output, either a comment or the entry DP
annLeadingCommentEntryDelta :: Annotation -> DeltaPos
annLeadingCommentEntryDelta :: Annotation -> DeltaPos
annLeadingCommentEntryDelta 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

-- | Calculates the distance from the start of a string to the end of
-- a string.
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

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

-- | Put the provided context elements into the existing set with fresh level
-- counts
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

-- | Put the provided context elements into the existing set with given level
-- counts
-- setAcsWithLevel :: Set.Set AstContext -> Int -> AstContextSet -> AstContextSet
-- setAcsWithLevel ctxt level (ACS a) = ACS a'
--   where
--     upd s (k,v) = Map.insert k v s
--     a' = foldl' upd a $ zip (Set.toList ctxt) (repeat level)
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)

-- ---------------------------------------------------------------------
-- | Remove the provided context element from the existing set
-- unsetAcs :: AstContext -> AstContextSet -> AstContextSet
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

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

-- | Are any of the contexts currently active?
-- inAcs :: Set.Set AstContext -> AstContextSet -> Bool
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)

-- | propagate the ACS down a level, dropping all values which hit zero
-- pushAcs :: AstContextSet -> AstContextSet
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)

-- |Sometimes we have to pass the context down unchanged. Bump each count up by
-- one so that it is unchanged after a @pushAcs@ call.
-- bumpAcs :: AstContextSet -> AstContextSet
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

  -- to be called in annotationsToCommentsBF by the pretty printer
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


-- ssFor a b = GHC.combineSrcSpans (getBoolSrcSpan a) (getBoolSrcSpan b)

-- | Generate a SrcSpan of single char length before the given one
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)

-- | Generate a SrcSpan of single char length after the given one
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

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

-- | Show a GHC AST with interleaved Annotation information.
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 -- `ext1Q` located
          (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
          -- `extQ` overLit
          (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: "++) . (++"}") .  OccName.occNameString
        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    = ("{"++) . (++"}") . showSDoc_ . GHC.ppr :: GHC.SrcSpan -> 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)
                                                 -- (GHC.ppr (Map.lookup ss anns)
                                                 (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

        -- overLit :: GHC.HsOverLit GHC.RdrName -> String
        -- overLit    = ("{HsOverLit:"++) . (++"}") . showSDoc_ . GHC.ppr

        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 la = show (getAnnotationEP la anns)
        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)
                      -- ++ case showWrappedDeclAnns (GHC.L s a) of
                      --   Nothing -> ""
                      --   Just annStr  -> indent (n + 1) ++ annStr
                    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
""

{-
data NameSpace = VarName        -- Variables, including "real" data constructors
               | DataName       -- "Source" data constructors
               | TvName         -- Type variables
               | TcClsName      -- Type constructors and classes; Haskell has them
                                -- in the same name space for now.
-}

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

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

-- ---------------------------------------------------------------------
-- Putting these here for the time being, to avoid import loops

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"