{-# LANGUAGE CPP #-}
-- | This module provides a stable interface to access GHC's info provenance information.
-- This is helpful for seeing metadata about heap objects.
module GHC.InfoProv.Compat
  ( InfoProv(..)
  , whereFrom
  ) where

#if MIN_VERSION_base(4,18,0)
import GHC.InfoProv (InfoProv(..), whereFrom)
#elif MIN_VERSION_base(4,17,0)
import GHC.Stack.CCS (InfoProv(..), whereFrom)
#else
import qualified GHC.Stack.CCS as CCS

data InfoProv = InfoProv {
  ipName :: String,
  ipDesc :: String,
  ipTyDesc :: String,
  ipLabel :: String,
  ipMod :: String,
  ipSrcFile :: String,
  ipSrcSpan :: String
} deriving (Eq, Show)


-- | Get information about where a value originated from.
--
-- This information is stored statically in a binary when @-finfo-table-map@ is enabled.
-- The source positions will be greatly improved by also enabled debug information with @-g3@.
-- Finally you can enable @-fdistinct-constructor-tables@ to get more precise information about data constructor allocations.
--
-- The information is collect by looking at the info table address of a specific closure and then consulting a specially generated map (by @-finfo-table-map@)
-- to find out where we think the best source position to describe that info table arose from.
whereFrom :: a -> IO (Maybe InfoProv)
whereFrom v = do
  xs <- CCS.whereFrom v
  pure $ do
    [name, desc, tyDesc, label, modName, srcFile, srcSpan] <- Just xs
    Just $
      InfoProv
       { ipName = name
       , ipDesc = desc
       , ipTyDesc = tyDesc
       , ipLabel = label
       , ipMod = modName
       , ipSrcFile = srcFile
       , ipSrcSpan = srcSpan
       }
#endif