{-# LANGUAGE CPP #-}

-- | Debug tools for GHC-related data
module Calligraphy.Compat.Debug
  ( ppHieFile,
    ppIdentifier,
    showGHCName,
  )
where

import Calligraphy.Util.Printer
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
#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 String
path (GHC.Module Unit
_ ModuleName
mdl) Array Int HieTypeFlat
_types (GHC.HieASTs Map HiePath (HieAST Int)
asts) [AvailInfo]
_exps ByteString
_src) = do
  String -> Printer ()
strLn String
"Hie File"
  forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$ do
    String -> Printer ()
strLn String
"path:"
    forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$ String -> Printer ()
strLn String
path
    String -> Printer ()
strLn String
"module: "
    forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$ String -> Printer ()
strLn (ModuleName -> String
GHC.moduleNameString ModuleName
mdl)
    String -> Printer ()
strLn String
"contents:"
    forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_ghc(9,2,0)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map HiePath (HieAST Int)
asts) forall a b. (a -> b) -> a -> b
$ \(GHC.LexicalFastString FastString
hiePath, HieAST Int
ast) -> do
#else
      forM_ (Map.toList asts) $ \(hiePath, ast) -> do
#endif
        String -> Printer ()
strLn (FastString -> String
GHC.unpackFS FastString
hiePath)
        forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$ forall a. HieAST a -> Printer ()
ppAst HieAST Int
ast

ppAst :: GHC.HieAST a -> Printer ()
#if MIN_VERSION_ghc(9,2,0)
ppAst :: forall a. HieAST a -> Printer ()
ppAst (GHC.Node (GHC.SourcedNodeInfo Map NodeOrigin (NodeInfo a)
nodeInfo) Span
spn [HieAST a]
children) = do
  String -> Printer ()
strLn (Span -> String
showSpan Span
spn)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map NodeOrigin (NodeInfo a)
nodeInfo) forall a b. (a -> b) -> a -> b
$ \(NodeOrigin
origin, GHC.NodeInfo Set NodeAnnotation
anns [a]
_ NodeIdentifiers a
ids) -> do
    case NodeOrigin
origin of
      NodeOrigin
GeneratedInfo -> String -> Printer ()
strLn String
"GeneratedInfo"
      NodeOrigin
SourceInfo -> String -> Printer ()
strLn String
"SourceInfo"
    forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$  do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList NodeIdentifiers a
ids) forall a b. (a -> b) -> a -> b
$ \(Identifier
idn, GHC.IdentifierDetails Maybe a
_ Set ContextInfo
idnDetails) -> do
        Prints Identifier
ppIdentifier Identifier
idn
        forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set ContextInfo
idnDetails forall a b. (a -> b) -> a -> b
$ String -> Printer ()
strLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDocContext -> SDoc -> String
GHC.showSDocOneLine SDocContext
GHC.defaultSDocContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> SDoc
GHC.ppr
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set NodeAnnotation
anns forall a b. (a -> b) -> a -> b
$ \(GHC.NodeAnnotation FastString
constr FastString
typ) -> String -> Printer ()
strLn (forall a. Show a => a -> String
show (FastString
constr, FastString
typ))
  forall a. Printer a -> Printer a
indent forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. HieAST a -> Printer ()
ppAst [HieAST a]
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 (GHC.Node (GHC.NodeInfo anns _ ids) spn children) = do
  strLn (showSpan spn)
  forM_ (Map.toList ids) $ \(idn, GHC.IdentifierDetails _ idnDetails) -> do
    ppIdentifier idn
    indent $ forM_ idnDetails showLn
  mapM_ showLn anns
  indent $ mapM_ ppAst children
#endif

showSpan :: GHC.RealSrcSpan -> String
showSpan :: Span -> String
showSpan Span
s =
  forall a. Monoid a => [a] -> a
mconcat
    [ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Span -> Int
GHC.srcSpanStartLine Span
s,
      String
":",
      forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Span -> Int
GHC.srcSpanStartCol Span
s,
      String
" - ",
      forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Span -> Int
GHC.srcSpanEndLine Span
s,
      String
":",
      forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Span -> Int
GHC.srcSpanEndCol Span
s
    ]

ppIdentifier :: Prints GHC.Identifier
ppIdentifier :: Prints Identifier
ppIdentifier = String -> Printer ()
strLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ModuleName -> String
showModuleName Name -> String
showGHCName

showModuleName :: GHC.ModuleName -> String
showModuleName :: ModuleName -> String
showModuleName = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend String
" (module)" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString

showGHCName :: GHC.Name -> String
showGHCName :: Name -> String
showGHCName Name
name = forall a. NamedThing a => a -> String
GHC.getOccString Name
name forall a. Semigroup a => a -> a -> a
<> String
"    " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Unique -> Int
GHC.getKey forall a b. (a -> b) -> a -> b
$ Name -> Unique
GHC.nameUnique Name
name)