{-# LANGUAGE CPP #-}
module Calligraphy.Compat.Debug
( ppHieFile,
ppIdentifier,
showGHCName,
)
where
import Calligraphy.Util.Printer
import Control.Monad
import qualified Data.Map as Map
#if MIN_VERSION_ghc(9,2,0)
import qualified GHC.Data.FastString as GHC
import qualified GHC.Iface.Ext.Types as GHC
import qualified GHC.Types.Name as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Types.Unique as GHC
import qualified GHC.Unit as GHC
import qualified GHC.Utils.Outputable as GHC
import GHC.Iface.Ext.Types
#elif MIN_VERSION_ghc(9,0,0)
import qualified GHC.Data.FastString as GHC
import qualified GHC.Iface.Ext.Types as GHC
import qualified GHC.Types.Name as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Types.Unique as GHC
import qualified GHC.Unit as GHC
import qualified GHC.Utils.Outputable as GHC
import qualified GHC.Driver.Session as GHC
#else
import qualified HieTypes as GHC
import qualified Module as GHC
import qualified FastString as GHC
import qualified GhcPlugins as GHC
import qualified Unique as GHC
#endif
ppHieFile :: Prints GHC.HieFile
ppHieFile :: Prints HieFile
ppHieFile (GHC.HieFile FilePath
path (GHC.Module UnitId
_ ModuleName
mdl) Array TypeIndex HieTypeFlat
_types (GHC.HieASTs Map FastString (HieAST TypeIndex)
asts) [AvailInfo]
_exps ByteString
_src) = do
FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn FilePath
"Hie File"
Printer () -> Printer ()
forall (m :: * -> *) a. MonadPrint m => m a -> m a
indent (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn FilePath
"path:"
Printer () -> Printer ()
forall (m :: * -> *) a. MonadPrint m => m a -> m a
indent (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn FilePath
path
FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn FilePath
"module: "
Printer () -> Printer ()
forall (m :: * -> *) a. MonadPrint m => m a -> m a
indent (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn (ModuleName -> FilePath
GHC.moduleNameString ModuleName
mdl)
FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn FilePath
"contents:"
Printer () -> Printer ()
forall (m :: * -> *) a. MonadPrint m => m a -> m a
indent (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_ghc(9,2,0)
forM_ (Map.toList asts) $ \(GHC.LexicalFastString hiePath, ast) -> do
#else
[(FastString, HieAST TypeIndex)]
-> ((FastString, HieAST TypeIndex) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map FastString (HieAST TypeIndex)
-> [(FastString, HieAST TypeIndex)]
forall k a. Map k a -> [(k, a)]
Map.toList Map FastString (HieAST TypeIndex)
asts) (((FastString, HieAST TypeIndex) -> Printer ()) -> Printer ())
-> ((FastString, HieAST TypeIndex) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(FastString
hiePath, HieAST TypeIndex
ast) -> do
#endif
FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn (FastString -> FilePath
GHC.unpackFS FastString
hiePath)
Printer () -> Printer ()
forall (m :: * -> *) a. MonadPrint m => m a -> m a
indent (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ HieAST TypeIndex -> Printer ()
forall a. HieAST a -> Printer ()
ppAst HieAST TypeIndex
ast
ppAst :: GHC.HieAST a -> Printer ()
#if MIN_VERSION_ghc(9,2,0)
ppAst (GHC.Node (GHC.SourcedNodeInfo nodeInfo) spn children) = do
strLn (showSpan spn)
forM_ (Map.toList nodeInfo) $ \(origin, GHC.NodeInfo anns _ ids) -> do
case origin of
GeneratedInfo -> strLn "GeneratedInfo"
SourceInfo -> strLn "SourceInfo"
indent $ do
forM_ (Map.toList ids) $ \(idn, GHC.IdentifierDetails _ idnDetails) -> do
ppIdentifier idn
indent $ forM_ idnDetails $ strLn . GHC.showSDocOneLine GHC.defaultSDocContext . GHC.ppr
forM_ anns $ \(GHC.NodeAnnotation constr typ) -> strLn (show (constr, typ))
indent $ mapM_ ppAst children
#elif MIN_VERSION_ghc(9,0,0)
ppAst (GHC.Node (GHC.SourcedNodeInfo nodeInfo) spn children) = do
strLn (showSpan spn)
forM_ nodeInfo $ \ (GHC.NodeInfo anns _ ids) -> do
forM_ (Map.toList ids) $ \(idn, GHC.IdentifierDetails _ idnDetails) -> do
ppIdentifier idn
indent $ forM_ idnDetails $ strLn . GHC.showSDocOneLine (GHC.initSDocContext GHC.unsafeGlobalDynFlags GHC.defaultUserStyle) . GHC.ppr
forM_ anns $ showLn
indent $ mapM_ ppAst children
#else
ppAst :: HieAST a -> Printer ()
ppAst (GHC.Node (GHC.NodeInfo Set (FastString, FastString)
anns [a]
_ NodeIdentifiers a
ids) Span
spn [HieAST a]
children) = do
FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn (Span -> FilePath
showSpan Span
spn)
[(Identifier, IdentifierDetails a)]
-> ((Identifier, IdentifierDetails a) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (NodeIdentifiers a -> [(Identifier, IdentifierDetails a)]
forall k a. Map k a -> [(k, a)]
Map.toList NodeIdentifiers a
ids) (((Identifier, IdentifierDetails a) -> Printer ()) -> Printer ())
-> ((Identifier, IdentifierDetails a) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Identifier
idn, GHC.IdentifierDetails Maybe a
_ Set ContextInfo
idnDetails) -> do
Prints Identifier
ppIdentifier Identifier
idn
Printer () -> Printer ()
forall (m :: * -> *) a. MonadPrint m => m a -> m a
indent (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Set ContextInfo -> (ContextInfo -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set ContextInfo
idnDetails ContextInfo -> Printer ()
forall (m :: * -> *) a. (MonadPrint m, Show a) => a -> m ()
showLn
((FastString, FastString) -> Printer ())
-> Set (FastString, FastString) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FastString, FastString) -> Printer ()
forall (m :: * -> *) a. (MonadPrint m, Show a) => a -> m ()
showLn Set (FastString, FastString)
anns
Printer () -> Printer ()
forall (m :: * -> *) a. MonadPrint m => m a -> m a
indent (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ (HieAST a -> Printer ()) -> [HieAST a] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ HieAST a -> Printer ()
forall a. HieAST a -> Printer ()
ppAst [HieAST a]
children
#endif
showSpan :: GHC.RealSrcSpan -> String
showSpan :: Span -> FilePath
showSpan Span
s =
[FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
[ TypeIndex -> FilePath
forall a. Show a => a -> FilePath
show (TypeIndex -> FilePath) -> TypeIndex -> FilePath
forall a b. (a -> b) -> a -> b
$ Span -> TypeIndex
GHC.srcSpanStartLine Span
s,
FilePath
":",
TypeIndex -> FilePath
forall a. Show a => a -> FilePath
show (TypeIndex -> FilePath) -> TypeIndex -> FilePath
forall a b. (a -> b) -> a -> b
$ Span -> TypeIndex
GHC.srcSpanStartCol Span
s,
FilePath
" - ",
TypeIndex -> FilePath
forall a. Show a => a -> FilePath
show (TypeIndex -> FilePath) -> TypeIndex -> FilePath
forall a b. (a -> b) -> a -> b
$ Span -> TypeIndex
GHC.srcSpanEndLine Span
s,
FilePath
":",
TypeIndex -> FilePath
forall a. Show a => a -> FilePath
show (TypeIndex -> FilePath) -> TypeIndex -> FilePath
forall a b. (a -> b) -> a -> b
$ Span -> TypeIndex
GHC.srcSpanEndCol Span
s
]
ppIdentifier :: Prints GHC.Identifier
ppIdentifier :: Prints Identifier
ppIdentifier = FilePath -> Printer ()
forall (m :: * -> *). MonadPrint m => FilePath -> m ()
strLn (FilePath -> Printer ())
-> (Identifier -> FilePath) -> Prints Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName -> FilePath)
-> (Name -> FilePath) -> Identifier -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ModuleName -> FilePath
showModuleName Name -> FilePath
showGHCName
showModuleName :: GHC.ModuleName -> String
showModuleName :: ModuleName -> FilePath
showModuleName = (FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
forall a. Monoid a => a -> a -> a
mappend FilePath
" (module)" (FilePath -> FilePath)
-> (ModuleName -> FilePath) -> ModuleName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show (FilePath -> FilePath)
-> (ModuleName -> FilePath) -> ModuleName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
GHC.moduleNameString
showGHCName :: GHC.Name -> String
showGHCName :: Name -> FilePath
showGHCName Name
name = Name -> FilePath
forall a. NamedThing a => a -> FilePath
GHC.getOccString Name
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> TypeIndex -> FilePath
forall a. Show a => a -> FilePath
show (Unique -> TypeIndex
GHC.getKey (Unique -> TypeIndex) -> Unique -> TypeIndex
forall a b. (a -> b) -> a -> b
$ Name -> Unique
GHC.nameUnique Name
name)