{-# LANGUAGE CPP #-}

-- | Debug tools for GHC-related data
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)