{-# 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
import GHC.Exts.Heap.ClosureTypes
#if MIN_VERSION_base(4,18,0)
import qualified GHC.InfoProv as IP
#else
import qualified GHC.Stack.CCS as IP
#endif

data InfoProv = InfoProv 
  { InfoProv -> String
ipName :: String
  , InfoProv -> ClosureType
ipDesc :: ClosureType
  , InfoProv -> String
ipTyDesc :: String
  , InfoProv -> String
ipLabel :: String
  , InfoProv -> String
ipUnitId :: String
  , InfoProv -> String
ipMod :: String
  , InfoProv -> String
ipSrcFile :: String
  , InfoProv -> String
ipSrcSpan :: String
  } 
  deriving (InfoProv -> InfoProv -> Bool
(InfoProv -> InfoProv -> Bool)
-> (InfoProv -> InfoProv -> Bool) -> Eq InfoProv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InfoProv -> InfoProv -> Bool
== :: InfoProv -> InfoProv -> Bool
$c/= :: InfoProv -> InfoProv -> Bool
/= :: InfoProv -> InfoProv -> Bool
Eq, Int -> InfoProv -> ShowS
[InfoProv] -> ShowS
InfoProv -> String
(Int -> InfoProv -> ShowS)
-> (InfoProv -> String) -> ([InfoProv] -> ShowS) -> Show InfoProv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InfoProv -> ShowS
showsPrec :: Int -> InfoProv -> ShowS
$cshow :: InfoProv -> String
show :: InfoProv -> String
$cshowList :: [InfoProv] -> ShowS
showList :: [InfoProv] -> ShowS
Show)

#if MIN_VERSION_base(4,20,0)

-- | Get information about where a value originated from.
--
-- This information is stored statically in a binary when @super-duper@ 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 :: forall a. a -> IO (Maybe InfoProv)
whereFrom a
v = do
  xs <- a -> IO (Maybe InfoProv)
forall a. a -> IO (Maybe InfoProv)
IP.whereFrom a
v
  pure $ do
    ip <- xs
    Just $
      InfoProv
       { ipName = IP.ipName ip
       , ipDesc = IP.ipDesc ip
       , ipTyDesc = IP.ipTyDesc ip
       , ipLabel = IP.ipLabel ip
       , ipUnitId = IP.ipUnitId ip
       , ipMod = IP.ipMod ip
       , ipSrcFile = IP.ipSrcFile ip
       , ipSrcSpan = IP.ipSrcSpan ip
       }

#elif MIN_VERSION_base(4,18,0)

-- | Get information about where a value originated from.
--
-- This information is stored statically in a binary when @super-duper@ 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 <- IP.whereFrom v
  pure $ do
    ip <- xs
    Just $
      InfoProv
       { ipName = IP.ipName ip
       , ipDesc = toEnum . read $ IP.ipDesc ip
       , ipTyDesc = IP.ipTyDesc ip
       , ipLabel = IP.ipLabel ip
       , ipUnitId = "" -- not present before base-4.20
       , ipMod = IP.ipMod ip
       , ipSrcFile = IP.ipSrcFile ip
       , ipSrcSpan = IP.ipSrcSpan ip
       }
#elif MIN_VERSION_base(4,17,0)

-- | Get information about where a value originated from.
--
-- This information is stored statically in a binary when @super-duper@ 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 <- IP.whereFrom v
  pure $ do
    ip <- xs
    -- srcFileSpan has the format: `test/Spec.hs:12:1-11`
    (srcFile, _:srcSpan) <- Just . break (== ':') $ IP.ipLoc ip
    Just $
      InfoProv
       { ipName = IP.ipName ip
       , ipDesc = toEnum . read $ IP.ipDesc ip
       , ipTyDesc = IP.ipTyDesc ip
       , ipLabel = IP.ipLabel ip
       , ipUnitId = "" -- not present before base-4.20
       , ipMod = IP.ipMod ip
       , ipSrcFile = srcFile
       , ipSrcSpan = srcSpan
       }
#else

-- | Get information about where a value originated from.
--
-- This information is stored statically in a binary when @super-duper@ 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 <- IP.whereFrom v
  pure $ do
    [name, desc, tyDesc, label, modName, srcFileSpan] <- Just xs
    -- srcFileSpan has the format: `test/Spec.hs:12:1-11`
    (srcFile, _:srcSpan) <- Just . break (== ':') $ srcFileSpan
    Just $
      InfoProv
       { ipName = name
       , ipDesc = toEnum . read $ desc
       , ipTyDesc = tyDesc
       , ipLabel = label
       , ipUnitId = "" -- not present before base-4.20
       , ipMod = modName
       , ipSrcFile = srcFile
       , ipSrcSpan = srcSpan
       }
#endif