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

{-# LANGUAGE StandaloneDeriving #-}

{- |
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.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

-- 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 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{..}