{-# LANGUAGE ScopedTypeVariables #-}
module StaticLS.HI.File (
readHiFile,
srcFilePathToHiFilePath,
getModIfaceFromTdi,
tdiToHiFilePath,
modToHiFile,
) where
import Control.Exception
import Control.Monad
import Control.Monad.IO.Unlift (MonadIO, liftIO)
import Control.Monad.Trans.Maybe (MaybeT (..))
import qualified Data.Set as Set
import qualified GHC
import qualified GHC.Iface.Binary as GHC
import qualified GHC.Platform as GHC
import qualified GHC.Platform.Profile as GHC
import qualified GHC.Types.Name.Cache as GHC
import qualified Language.LSP.Protocol.Types as LSP
import StaticLS.FilePath
import StaticLS.SrcFiles
import StaticLS.StaticEnv
import System.FilePath ((</>))
getModIfaceFromTdi :: (HasStaticEnv m, MonadIO m) => LSP.TextDocumentIdentifier -> MaybeT m GHC.ModIface
getModIfaceFromTdi :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> MaybeT m ModIface
getModIfaceFromTdi = m (Maybe ModIface) -> MaybeT m ModIface
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe ModIface) -> MaybeT m ModIface)
-> (FilePath -> m (Maybe ModIface))
-> FilePath
-> MaybeT m ModIface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m (Maybe ModIface)
forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe ModIface)
readHiFile (FilePath -> MaybeT m ModIface)
-> (TextDocumentIdentifier -> MaybeT m FilePath)
-> TextDocumentIdentifier
-> MaybeT m ModIface
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TextDocumentIdentifier -> MaybeT m FilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> MaybeT m FilePath
tdiToHiFilePath
tdiToHiFilePath :: (HasStaticEnv m, MonadIO m) => LSP.TextDocumentIdentifier -> MaybeT m HiFilePath
tdiToHiFilePath :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> MaybeT m FilePath
tdiToHiFilePath = FilePath -> MaybeT m FilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
FilePath -> MaybeT m FilePath
srcFilePathToHiFilePath (FilePath -> MaybeT m FilePath)
-> (TextDocumentIdentifier -> MaybeT m FilePath)
-> TextDocumentIdentifier
-> MaybeT m FilePath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (m (Maybe FilePath) -> MaybeT m FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe FilePath) -> MaybeT m FilePath)
-> (TextDocumentIdentifier -> m (Maybe FilePath))
-> TextDocumentIdentifier
-> MaybeT m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> m (Maybe FilePath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> m (Maybe FilePath))
-> (TextDocumentIdentifier -> Maybe FilePath)
-> TextDocumentIdentifier
-> m (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> Maybe FilePath
LSP.uriToFilePath (Uri -> Maybe FilePath)
-> (TextDocumentIdentifier -> Uri)
-> TextDocumentIdentifier
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (._uri))
modToHiFile :: (HasStaticEnv m, MonadIO m) => GHC.ModuleName -> MaybeT m HiFilePath
modToHiFile :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
ModuleName -> MaybeT m FilePath
modToHiFile ModuleName
modName = do
StaticEnv
staticEnv <- MaybeT m StaticEnv
forall (m :: * -> *). HasStaticEnv m => m StaticEnv
getStaticEnv
let hiFiles :: FilePath
hiFiles = StaticEnv
staticEnv.hiFilesPath
FilePath -> MaybeT m FilePath
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> MaybeT m FilePath) -> FilePath -> MaybeT m FilePath
forall a b. (a -> b) -> a -> b
$ StaticEnv
staticEnv.wsRoot FilePath -> FilePath -> FilePath
</> FilePath
hiFiles FilePath -> FilePath -> FilePath
</> ModuleName -> FilePath -> FilePath
modToFilePath ModuleName
modName FilePath
".hi"
readHiFile :: (MonadIO m) => FilePath -> m (Maybe GHC.ModIface)
readHiFile :: forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe ModIface)
readHiFile FilePath
filePath = do
NameCache
nameCache <- IO NameCache -> m NameCache
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NameCache -> m NameCache) -> IO NameCache -> m NameCache
forall a b. (a -> b) -> a -> b
$ Char -> [Name] -> IO NameCache
GHC.initNameCache Char
'a' []
IO (Maybe ModIface) -> m (Maybe ModIface)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ModIface) -> m (Maybe ModIface))
-> IO (Maybe ModIface) -> m (Maybe ModIface)
forall a b. (a -> b) -> a -> b
$
( ModIface -> Maybe ModIface
forall a. a -> Maybe a
Just
(ModIface -> Maybe ModIface) -> IO ModIface -> IO (Maybe ModIface)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Profile
-> NameCache
-> CheckHiWay
-> TraceBinIFace
-> FilePath
-> IO ModIface
GHC.readBinIface
GHC.Profile
{ profilePlatform :: Platform
GHC.profilePlatform = Platform
GHC.genericPlatform
, profileWays :: Ways
GHC.profileWays = Ways
forall a. Set a
Set.empty
}
NameCache
nameCache
CheckHiWay
GHC.IgnoreHiWay
TraceBinIFace
GHC.QuietBinIFace
FilePath
filePath
)
IO (Maybe ModIface)
-> (IOException -> IO (Maybe ModIface)) -> IO (Maybe ModIface)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_ :: IOException) -> Maybe ModIface -> IO (Maybe ModIface)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ModIface
forall a. Maybe a
Nothing)
IO (Maybe ModIface)
-> (GhcException -> IO (Maybe ModIface)) -> IO (Maybe ModIface)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(GhcException
_ :: GHC.GhcException) -> Maybe ModIface -> IO (Maybe ModIface)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ModIface
forall a. Maybe a
Nothing)
IO (Maybe ModIface)
-> (SomeException -> IO (Maybe ModIface)) -> IO (Maybe ModIface)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
_ :: SomeException) -> Maybe ModIface -> IO (Maybe ModIface)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ModIface
forall a. Maybe a
Nothing)
srcFilePathToHiFilePath :: (HasStaticEnv m, MonadIO m) => SrcFilePath -> MaybeT m HiFilePath
srcFilePathToHiFilePath :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
FilePath -> MaybeT m FilePath
srcFilePathToHiFilePath FilePath
srcPath = do
StaticEnv
staticEnv <- MaybeT m StaticEnv
forall (m :: * -> *). HasStaticEnv m => m StaticEnv
getStaticEnv
let hiFiles :: FilePath
hiFiles = StaticEnv
staticEnv.hiFilesPath
hiDir :: FilePath
hiDir = StaticEnv
staticEnv.wsRoot FilePath -> FilePath -> FilePath
</> FilePath
hiFiles
FilePath -> FilePath -> FilePath -> FilePath -> MaybeT m FilePath
forall (m :: * -> *).
MonadIO m =>
FilePath -> FilePath -> FilePath -> FilePath -> MaybeT m FilePath
subRootExtensionFilepath StaticEnv
staticEnv.wsRoot FilePath
hiDir FilePath
".hi" FilePath
srcPath