{-# LANGUAGE CPP, NamedFieldPuns, TupleSections, LambdaCase,
   DuplicateRecordFields, RecordWildCards, TupleSections, ViewPatterns,
   TypeApplications, ScopedTypeVariables, BangPatterns #-}
module GHC.Debugger.Utils where

import GHC
import GHC.Data.FastString
import GHC.Driver.DynFlags as GHC
import GHC.Driver.Ppr as GHC
import GHC.Utils.Outputable as GHC

import GHC.Debugger.Monad
import GHC.Debugger.Interface.Messages

--------------------------------------------------------------------------------
-- * GHC Utilities
--------------------------------------------------------------------------------

-- | Convert a GHC's src span into an interface one
realSrcSpanToSourceSpan :: RealSrcSpan -> SourceSpan
realSrcSpanToSourceSpan :: RealSrcSpan -> SourceSpan
realSrcSpanToSourceSpan RealSrcSpan
ss = SourceSpan
  { file :: FilePath
file = FastString -> FilePath
unpackFS (FastString -> FilePath) -> FastString -> FilePath
forall a b. (a -> b) -> a -> b
$ RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
ss
  , startLine :: Int
startLine = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
ss
  , startCol :: Int
startCol = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
ss
  , endLine :: Int
endLine = RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
ss
  , endCol :: Int
endCol = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
ss
  }

-- | Display an Outputable value as a String
display :: Outputable a => a -> Debugger String
display :: forall a. Outputable a => a -> Debugger FilePath
display a
x = do
  dflags <- Debugger DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  return $ showSDoc dflags (ppr x)
{-# INLINE display #-}