{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE StandaloneDeriving #-}
module Stan.Hie.Debug
( debugHieFile
) where
import Text.Pretty.Simple (pPrint)
import Stan.Core.ModuleName (fromGhcModule)
import Stan.Ghc.Compat (ArgFlag (..), AvailInfo (..), FieldLbl (..), IfaceTyCon (..),
IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module,
ModuleName, Name, PromotionFlag (..), TupleSort (..), isExternalName,
moduleNameString, moduleStableString, moduleUnitId, nameModule, nameOccName,
nameStableString, occNameString)
import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..),
IdentifierDetails (..), NodeInfo (..))
import Stan.NameMeta (NameMeta (..))
import qualified Text.Show
debugHieFile :: FilePath -> [HieFile] -> IO ()
debugHieFile :: FilePath -> [HieFile] -> IO ()
debugHieFile path :: FilePath
path hieFiles :: [HieFile]
hieFiles = do
let mHieFile :: Maybe HieFile
mHieFile = (HieFile -> Bool) -> [HieFile] -> Maybe HieFile
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\HieFile{..} -> FilePath
hie_hs_file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
path) [HieFile]
hieFiles
Maybe HieFile -> (HieFile -> IO ()) -> IO ()
forall (f :: * -> *) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe HieFile
mHieFile HieFile -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint
deriving stock instance Show HieFile
deriving stock instance Show a => Show (HieType a)
deriving stock instance Show a => Show (HieAST a)
deriving newtype instance Show a => Show (HieASTs a)
deriving newtype instance Show a => Show (HieArgs a)
deriving stock instance Show a => Show (NodeInfo a)
deriving stock instance Show a => Show (IdentifierDetails a)
deriving stock instance Show IfaceTyCon
deriving stock instance Show IfaceTyConInfo
deriving stock instance Show IfaceTyConSort
deriving stock instance Show IfaceTyLit
deriving stock instance Show PromotionFlag
deriving stock instance Show TupleSort
deriving stock instance Show ArgFlag
deriving stock instance Show AvailInfo
deriving stock instance Show a => Show (FieldLbl a)
instance Show Module where
show :: Module -> FilePath
show = Module -> FilePath
moduleStableString
instance Show ModuleName where
show :: ModuleName -> FilePath
show = ModuleName -> FilePath
moduleNameString
instance Show Name where
show :: Name -> FilePath
show nm :: Name
nm =
if Name -> Bool
isExternalName Name
nm
then NameMeta -> FilePath
forall b a. (Show a, IsString b) => a -> b
show (NameMeta -> FilePath) -> NameMeta -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> NameMeta
toNameMeta Name
nm
else Name -> FilePath
nameStableString Name
nm
where
toNameMeta :: Name -> NameMeta
toNameMeta :: Name -> NameMeta
toNameMeta name :: Name
name =
let nameMetaName :: Text
nameMetaName = FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ OccName -> FilePath
occNameString (OccName -> FilePath) -> OccName -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name
nameMetaModuleName :: ModuleName
nameMetaModuleName = Module -> ModuleName
fromGhcModule (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
nameMetaPackage :: Text
nameMetaPackage = forall a. (Show a, IsString Text) => a -> Text
forall b a. (Show a, IsString b) => a -> b
show @Text (UnitId -> Text) -> UnitId -> Text
forall a b. (a -> b) -> a -> b
$ Module -> UnitId
moduleUnitId (Module -> UnitId) -> Module -> UnitId
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
in $WNameMeta :: Text -> ModuleName -> Text -> NameMeta
NameMeta{..}