{-# LANGUAGE CPP #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE FlexibleInstances #-}

{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Useful debugging and printing utilities for HIE types. They are
implemented in two ways:

1. Using derived 'Show' instances.
2. Using @ghc@ pretty-printing.

To make full use of derived 'Show' instances, add the @pretty-simple@
package to dependencies and use the @pPrint@ function from the
@Text.Pretty.Simple@ module.
-}

module Stan.Hie.Debug902
#if __GLASGOW_HASKELL__ == 902 || __GLASGOW_HASKELL__ == 904 || __GLASGOW_HASKELL__ == 906
    ( debugHieFile
    ) where

import Text.Pretty.Simple (pPrint)

import Stan.Core.ModuleName (fromGhcModule)
import Stan.Ghc.Compat (AvailInfo (..), FieldLabel (..), IfaceTyCon (..),
                        IfaceTyConInfo (..), IfaceTyConSort (..), IfaceTyLit (..), Module,
                        Name, PromotionFlag (..), TupleSort (..), isExternalName,
                        moduleStableString, moduleUnitId, nameModule, nameOccName,
                        nameStableString, occNameString, showTUnitId)
import Stan.Hie.Compat (HieAST (..), HieASTs (..), HieArgs (..), HieFile (..), HieType (..),
                        IdentifierDetails (..), NodeInfo (..))
import Stan.NameMeta (NameMeta (..))

import qualified Text.Show

import GHC.Iface.Ext.Types (SourcedNodeInfo(..), NodeOrigin(..), ContextInfo(..), IEType(..), BindType(..), Scope(..), DeclType(..), TyVarScope(..), RecFieldContext(..), EvVarSource(..), EvBindDeps(..), DeclType(..), NodeAnnotation (..))
import GHC.Types.Avail (GreName (..))
import GHC.Types.Var (Specificity(..))

debugHieFile :: FilePath -> [HieFile] -> IO ()
debugHieFile :: FilePath -> [HieFile] -> IO ()
debugHieFile FilePath
path [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
[AvailInfo]
ByteString
Array TypeIndex HieTypeFlat
Module
HieASTs TypeIndex
hie_hs_file :: FilePath
hie_module :: Module
hie_types :: Array TypeIndex HieTypeFlat
hie_asts :: HieASTs TypeIndex
hie_exports :: [AvailInfo]
hie_hs_src :: ByteString
hie_hs_file :: HieFile -> FilePath
hie_module :: HieFile -> Module
hie_types :: HieFile -> Array TypeIndex HieTypeFlat
hie_asts :: HieFile -> HieASTs TypeIndex
hie_exports :: HieFile -> [AvailInfo]
hie_hs_src :: HieFile -> ByteString
..} -> 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 a => Show (SourcedNodeInfo a)
deriving stock instance Show NodeOrigin
deriving stock instance Show ContextInfo
deriving stock instance Show IEType
deriving stock instance Show BindType
deriving stock instance Show Scope
deriving stock instance Show DeclType
deriving stock instance Show TyVarScope
deriving stock instance Show EvBindDeps
deriving stock instance Show EvVarSource
deriving stock instance Show RecFieldContext

deriving stock instance Show Specificity

-- orphan intances
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 AvailInfo
deriving stock instance Show FieldLabel
deriving stock instance Show NodeAnnotation
deriving stock instance Show GreName

instance Show Module where
    show :: Module -> FilePath
show = Module -> FilePath
moduleStableString

instance Show Name where
    show :: Name -> FilePath
show 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 =
            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
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
                nameMetaPackage :: Text
nameMetaPackage = UnitId -> Text
showTUnitId (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
$ (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name
            in NameMeta{Text
ModuleName
nameMetaName :: Text
nameMetaModuleName :: ModuleName
nameMetaPackage :: Text
nameMetaPackage :: Text
nameMetaModuleName :: ModuleName
nameMetaName :: Text
..}
#else
  () where
#endif