{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
module Debug.RecoverRTTI.Modules (
KnownPkg(..)
, KnownModule(..)
, Sing(..)
, inKnownModule
, inKnownModuleNested
) where
import Control.Monad
import Data.List (isPrefixOf)
import Debug.RecoverRTTI.FlatClosure
import Debug.RecoverRTTI.Util.TypeLevel
data KnownPkg =
PkgGhcPrim
| PkgBase
| PkgByteString
| PkgText
| PkgIntegerWiredIn
| PkgGhcBignum
| PkgContainers
| PkgAeson
data family KnownModule (pkg :: KnownPkg)
data instance Sing (pkg :: KnownPkg) where
SGhcPrim :: Sing 'PkgGhcPrim
SBase :: Sing 'PkgBase
SByteString :: Sing 'PkgByteString
SText :: Sing 'PkgText
SIntegerWiredIn :: Sing 'PkgIntegerWiredIn
SGhcBignum :: Sing 'PkgGhcBignum
SContainers :: Sing 'PkgContainers
SAeson :: Sing 'PkgAeson
instance SingI 'PkgGhcPrim where sing :: Sing 'PkgGhcPrim
sing = Sing 'PkgGhcPrim
SGhcPrim
instance SingI 'PkgBase where sing :: Sing 'PkgBase
sing = Sing 'PkgBase
SBase
instance SingI 'PkgByteString where sing :: Sing 'PkgByteString
sing = Sing 'PkgByteString
SByteString
instance SingI 'PkgText where sing :: Sing 'PkgText
sing = Sing 'PkgText
SText
instance SingI 'PkgIntegerWiredIn where sing :: Sing 'PkgIntegerWiredIn
sing = Sing 'PkgIntegerWiredIn
SIntegerWiredIn
instance SingI 'PkgGhcBignum where sing :: Sing 'PkgGhcBignum
sing = Sing 'PkgGhcBignum
SGhcBignum
instance SingI 'PkgContainers where sing :: Sing 'PkgContainers
sing = Sing 'PkgContainers
SContainers
instance SingI 'PkgAeson where sing :: Sing 'PkgAeson
sing = Sing 'PkgAeson
SAeson
data instance KnownModule 'PkgGhcPrim =
GhcTypes
| GhcTuple
data instance KnownModule 'PkgBase =
GhcInt
| GhcWord
| GhcSTRef
| GhcMVar
| GhcConcSync
| GhcMaybe
| GhcReal
| DataEither
data instance KnownModule 'PkgByteString =
DataByteStringInternal
| DataByteStringLazyInternal
| DataByteStringShortInternal
data instance KnownModule 'PkgText =
DataTextInternal
| DataTextInternalLazy
data instance KnownModule 'PkgIntegerWiredIn =
GhcIntegerType
data instance KnownModule 'PkgGhcBignum =
GhcNumInteger
data instance KnownModule 'PkgContainers =
DataSetInternal
| DataMapInternal
| DataIntSetInternal
| DataIntMapInternal
| DataSequenceInternal
| DataTree
data instance KnownModule 'PkgAeson =
DataAesonTypesInternal
inKnownModule :: SingI pkg
=> KnownModule pkg
-> FlatClosure -> Maybe String
inKnownModule :: KnownModule pkg -> FlatClosure -> Maybe String
inKnownModule KnownModule pkg
modl = ((String, [Box]) -> String)
-> Maybe (String, [Box]) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, [Box]) -> String
forall a b. (a, b) -> a
fst (Maybe (String, [Box]) -> Maybe String)
-> (FlatClosure -> Maybe (String, [Box]))
-> FlatClosure
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
forall (pkg :: KnownPkg).
SingI pkg =>
KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
inKnownModuleNested KnownModule pkg
modl
inKnownModuleNested :: SingI pkg
=> KnownModule pkg
-> FlatClosure -> Maybe (String, [Box])
inKnownModuleNested :: KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
inKnownModuleNested = Sing pkg -> KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
forall (pkg :: KnownPkg).
Sing pkg -> KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
go Sing pkg
forall k (a :: k). SingI a => Sing a
sing
where
go :: Sing pkg -> KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
go :: Sing pkg -> KnownModule pkg -> FlatClosure -> Maybe (String, [Box])
go Sing pkg
knownPkg KnownModule pkg
knownModl ConstrClosure{String
pkg :: FlatClosure -> String
pkg :: String
pkg, String
modl :: FlatClosure -> String
modl :: String
modl, String
name :: FlatClosure -> String
name :: String
name, [Box]
ptrArgs :: FlatClosure -> [Box]
ptrArgs :: [Box]
ptrArgs} = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Sing pkg -> String
forall (pkg :: KnownPkg). Sing pkg -> String
namePkg Sing pkg
knownPkg String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
pkg)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
modl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Sing pkg -> KnownModule pkg -> String
forall (pkg :: KnownPkg). Sing pkg -> KnownModule pkg -> String
nameModl Sing pkg
knownPkg KnownModule pkg
knownModl)
(String, [Box]) -> Maybe (String, [Box])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [Box]
ptrArgs)
go Sing pkg
_ KnownModule pkg
_ FlatClosure
_otherClosure = Maybe (String, [Box])
forall a. Maybe a
Nothing
namePkg :: Sing (pkg :: KnownPkg) -> String
namePkg :: Sing pkg -> String
namePkg Sing pkg
SGhcPrim = String
"ghc-prim"
namePkg Sing pkg
SBase = String
"base"
namePkg Sing pkg
SByteString = String
"bytestring"
namePkg Sing pkg
SText = String
"text"
namePkg Sing pkg
SIntegerWiredIn = String
"integer-wired-in"
namePkg Sing pkg
SGhcBignum = String
"ghc-bignum"
namePkg Sing pkg
SContainers = String
"containers"
namePkg Sing pkg
SAeson = String
"aeson"
nameModl :: Sing (pkg :: KnownPkg) -> KnownModule pkg -> String
nameModl :: Sing pkg -> KnownModule pkg -> String
nameModl Sing pkg
SGhcPrim KnownModule pkg
GhcTypes = String
"GHC.Types"
nameModl Sing pkg
SGhcPrim KnownModule pkg
GhcTuple = String
"GHC.Tuple"
nameModl Sing pkg
SBase KnownModule pkg
GhcInt = String
"GHC.Int"
nameModl Sing pkg
SBase KnownModule pkg
GhcWord = String
"GHC.Word"
nameModl Sing pkg
SBase KnownModule pkg
GhcSTRef = String
"GHC.STRef"
nameModl Sing pkg
SBase KnownModule pkg
GhcMVar = String
"GHC.MVar"
nameModl Sing pkg
SBase KnownModule pkg
GhcConcSync = String
"GHC.Conc.Sync"
nameModl Sing pkg
SBase KnownModule pkg
GhcMaybe = String
"GHC.Maybe"
nameModl Sing pkg
SBase KnownModule pkg
GhcReal = String
"GHC.Real"
nameModl Sing pkg
SBase KnownModule pkg
DataEither = String
"Data.Either"
nameModl Sing pkg
SByteString KnownModule pkg
DataByteStringInternal = String
"Data.ByteString.Internal"
nameModl Sing pkg
SByteString KnownModule pkg
DataByteStringLazyInternal = String
"Data.ByteString.Lazy.Internal"
nameModl Sing pkg
SByteString KnownModule pkg
DataByteStringShortInternal = String
"Data.ByteString.Short.Internal"
nameModl Sing pkg
SText KnownModule pkg
DataTextInternal = String
"Data.Text.Internal"
nameModl Sing pkg
SText KnownModule pkg
DataTextInternalLazy = String
"Data.Text.Internal.Lazy"
nameModl Sing pkg
SIntegerWiredIn KnownModule pkg
GhcIntegerType = String
"GHC.Integer.Type"
nameModl Sing pkg
SGhcBignum KnownModule pkg
GhcNumInteger = String
"GHC.Num.Integer"
nameModl Sing pkg
SContainers KnownModule pkg
DataSetInternal = String
"Data.Set.Internal"
nameModl Sing pkg
SContainers KnownModule pkg
DataMapInternal = String
"Data.Map.Internal"
nameModl Sing pkg
SContainers KnownModule pkg
DataIntSetInternal = String
"Data.IntSet.Internal"
nameModl Sing pkg
SContainers KnownModule pkg
DataIntMapInternal = String
"Data.IntMap.Internal"
nameModl Sing pkg
SContainers KnownModule pkg
DataSequenceInternal = String
"Data.Sequence.Internal"
nameModl Sing pkg
SContainers KnownModule pkg
DataTree = String
"Data.Tree"
nameModl Sing pkg
SAeson KnownModule pkg
DataAesonTypesInternal = String
"Data.Aeson.Types.Internal"