{-# LANGUAGE ScopedTypeVariables #-}

module StaticLS.HIE.File (
    getHieFileFromTdi,
    getHieFile,
    modToHieFile,
    modToSrcFile,
    srcFilePathToHieFilePath,
    hieFilePathToSrcFilePath,
    -- | An alternate way of getting file information by pre-indexing hie files -
    -- far slower on startup and currently unused
    getHieFileMap,
    hieFileMapToSrcMap,
)
where

import Control.Applicative ((<|>))
import Control.Exception (SomeException, catch)
import Control.Monad ((<=<))
import Control.Monad.IO.Unlift (MonadIO, liftIO)
import Control.Monad.Trans.Except (ExceptT (..))
import Control.Monad.Trans.Maybe (MaybeT (..), exceptToMaybeT, runMaybeT)
import Data.Bifunctor (first, second)
import qualified Data.Map as Map
import qualified GHC
import qualified GHC.Iface.Ext.Binary as GHC
import qualified GHC.Iface.Ext.Types as GHC
import GHC.Stack (HasCallStack)
import qualified GHC.Types.Name.Cache as GHC
import qualified HieDb
import qualified Language.LSP.Protocol.Types as LSP
import StaticLS.FilePath
import StaticLS.HIE.File.Except
import qualified StaticLS.HieDb as HieDb
import StaticLS.Maybe (flatMaybeT, toAlt)
import StaticLS.SrcFiles
import StaticLS.StaticEnv
import qualified System.Directory as Dir
import System.FilePath ((</>))

-- | Retrieve a hie info from a lsp text document identifier
getHieFileFromTdi :: (HasStaticEnv m, MonadIO m) => LSP.TextDocumentIdentifier -> MaybeT m GHC.HieFile
getHieFileFromTdi :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> MaybeT m HieFile
getHieFileFromTdi = ExceptT HieFileReadException m HieFile -> MaybeT m HieFile
forall (m :: * -> *) e a. Functor m => ExceptT e m a -> MaybeT m a
exceptToMaybeT (ExceptT HieFileReadException m HieFile -> MaybeT m HieFile)
-> (HieFilePath -> ExceptT HieFileReadException m HieFile)
-> HieFilePath
-> MaybeT m HieFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFilePath -> ExceptT HieFileReadException m HieFile
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
HieFilePath -> ExceptT HieFileReadException m HieFile
getHieFile (HieFilePath -> MaybeT m HieFile)
-> (TextDocumentIdentifier -> MaybeT m HieFilePath)
-> TextDocumentIdentifier
-> MaybeT m HieFile
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< TextDocumentIdentifier -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> MaybeT m HieFilePath
tdiToHieFilePath

tdiToHieFilePath :: (HasStaticEnv m, MonadIO m) => LSP.TextDocumentIdentifier -> MaybeT m HieFilePath
tdiToHieFilePath :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> MaybeT m HieFilePath
tdiToHieFilePath = HieFilePath -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePath (HieFilePath -> MaybeT m HieFilePath)
-> (TextDocumentIdentifier -> MaybeT m HieFilePath)
-> TextDocumentIdentifier
-> MaybeT m HieFilePath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (m (Maybe HieFilePath) -> MaybeT m HieFilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe HieFilePath) -> MaybeT m HieFilePath)
-> (TextDocumentIdentifier -> m (Maybe HieFilePath))
-> TextDocumentIdentifier
-> MaybeT m HieFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe HieFilePath -> m (Maybe HieFilePath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe HieFilePath -> m (Maybe HieFilePath))
-> (TextDocumentIdentifier -> Maybe HieFilePath)
-> TextDocumentIdentifier
-> m (Maybe HieFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Uri -> Maybe HieFilePath
LSP.uriToFilePath (Uri -> Maybe HieFilePath)
-> (TextDocumentIdentifier -> Uri)
-> TextDocumentIdentifier
-> Maybe HieFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (._uri))

-- | Retrieve an hie file from a module name
modToHieFile :: (HasStaticEnv m, MonadIO m) => GHC.ModuleName -> MaybeT m GHC.HieFile
modToHieFile :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
ModuleName -> MaybeT m HieFile
modToHieFile = ExceptT HieFileReadException m HieFile -> MaybeT m HieFile
forall (m :: * -> *) e a. Functor m => ExceptT e m a -> MaybeT m a
exceptToMaybeT (ExceptT HieFileReadException m HieFile -> MaybeT m HieFile)
-> (HieFilePath -> ExceptT HieFileReadException m HieFile)
-> HieFilePath
-> MaybeT m HieFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFilePath -> ExceptT HieFileReadException m HieFile
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
HieFilePath -> ExceptT HieFileReadException m HieFile
getHieFile (HieFilePath -> MaybeT m HieFile)
-> (ModuleName -> MaybeT m HieFilePath)
-> ModuleName
-> MaybeT m HieFile
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ModuleName -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
ModuleName -> MaybeT m HieFilePath
modToHieFilePath

-- | Retrieve a src file from a module name
modToSrcFile :: (HasStaticEnv m, MonadIO m) => GHC.ModuleName -> MaybeT m SrcFilePath
modToSrcFile :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
ModuleName -> MaybeT m HieFilePath
modToSrcFile = HieFilePath -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
hieFilePathToSrcFilePath (HieFilePath -> MaybeT m HieFilePath)
-> (ModuleName -> MaybeT m HieFilePath)
-> ModuleName
-> MaybeT m HieFilePath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ModuleName -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
ModuleName -> MaybeT m HieFilePath
modToHieFilePath

{- | Fetch a src file from an hie file, checking hiedb but falling back on a file manipulation method
if not indexed
-}
srcFilePathToHieFilePath :: (HasStaticEnv m, MonadIO m) => SrcFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePath :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePath HieFilePath
srcPath =
    HieFilePath -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePathFromFile HieFilePath
srcPath
        MaybeT m HieFilePath
-> MaybeT m HieFilePath -> MaybeT m HieFilePath
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HieFilePath -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePathHieDb HieFilePath
srcPath

-- | Fetch an hie file from a src file
hieFilePathToSrcFilePath :: (HasStaticEnv m, MonadIO m) => HieFilePath -> MaybeT m SrcFilePath
hieFilePathToSrcFilePath :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
hieFilePathToSrcFilePath HieFilePath
hiePath = do
    HieFilePath -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
hieFilePathToSrcFilePathHieDb HieFilePath
hiePath
        MaybeT m HieFilePath
-> MaybeT m HieFilePath -> MaybeT m HieFilePath
forall a. MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HieFilePath -> MaybeT m HieFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
hieFilePathToSrcFilePathFromFile HieFilePath
hiePath

-----------------------------------------------------------------------------------
-- Primitive functions for looking up hie information
-----------------------------------------------------------------------------------

-- | Retrieve an hie file from a hie filepath
getHieFile :: (HasCallStack, MonadIO m) => HieFilePath -> ExceptT HieFileReadException m GHC.HieFile
getHieFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
HieFilePath -> ExceptT HieFileReadException m HieFile
getHieFile HieFilePath
hieFilePath = do
    -- Attempt to read valid hie file version
    -- NOTE: attempting to override an incorrect header and read an hie file
    -- seems to cause infinite hangs. TODO: explore why?
    NameCache
nameCache <- IO NameCache -> ExceptT HieFileReadException m NameCache
forall a. IO a -> ExceptT HieFileReadException m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NameCache -> ExceptT HieFileReadException m NameCache)
-> IO NameCache -> ExceptT HieFileReadException m NameCache
forall a b. (a -> b) -> a -> b
$ Char -> [Name] -> IO NameCache
GHC.initNameCache Char
'a' []
    Either HieFileReadException HieFileResult
result <-
        IO (Either HieFileReadException HieFileResult)
-> ExceptT
     HieFileReadException m (Either HieFileReadException HieFileResult)
forall a. IO a -> ExceptT HieFileReadException m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            ( (Either HieHeader HieFileResult
 -> Either HieFileReadException HieFileResult)
-> IO (Either HieHeader HieFileResult)
-> IO (Either HieFileReadException HieFileResult)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                ((HieHeader -> HieFileReadException)
-> Either HieHeader HieFileResult
-> Either HieFileReadException HieFileResult
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HieHeader -> HieFileReadException
HieFileVersionException)
                ((HieHeader -> Bool)
-> NameCache -> HieFilePath -> IO (Either HieHeader HieFileResult)
GHC.readHieFileWithVersion ((Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
GHC.hieVersion) (Integer -> Bool) -> (HieHeader -> Integer) -> HieHeader -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieHeader -> Integer
forall a b. (a, b) -> a
fst) NameCache
nameCache HieFilePath
hieFilePath)
                IO (Either HieFileReadException HieFileResult)
-> (SomeException
    -> IO (Either HieFileReadException HieFileResult))
-> IO (Either HieFileReadException HieFileResult)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
_ :: SomeException) -> Either HieFileReadException HieFileResult
-> IO (Either HieFileReadException HieFileResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HieFileReadException HieFileResult
 -> IO (Either HieFileReadException HieFileResult))
-> (HieFileReadException
    -> Either HieFileReadException HieFileResult)
-> HieFileReadException
-> IO (Either HieFileReadException HieFileResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFileReadException -> Either HieFileReadException HieFileResult
forall a b. a -> Either a b
Left (HieFileReadException
 -> IO (Either HieFileReadException HieFileResult))
-> HieFileReadException
-> IO (Either HieFileReadException HieFileResult)
forall a b. (a -> b) -> a -> b
$ HieFileReadException
HieFileReadException)
            )
    m (Either HieFileReadException HieFile)
-> ExceptT HieFileReadException m HieFile
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either HieFileReadException HieFile)
 -> ExceptT HieFileReadException m HieFile)
-> m (Either HieFileReadException HieFile)
-> ExceptT HieFileReadException m HieFile
forall a b. (a -> b) -> a -> b
$ Either HieFileReadException HieFile
-> m (Either HieFileReadException HieFile)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((HieFileResult -> HieFile)
-> Either HieFileReadException HieFileResult
-> Either HieFileReadException HieFile
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second HieFileResult -> HieFile
GHC.hie_file_result Either HieFileReadException HieFileResult
result)

-----------------------------------------------------------------------------------
-- HieDb Method of file lookups - requires hiedb to be indexed using --src-base-dirs from 0.4.4.0
-----------------------------------------------------------------------------------

srcFilePathToHieFilePathHieDb :: (HasStaticEnv m, MonadIO m) => SrcFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePathHieDb :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePathHieDb HieFilePath
srcPath = do
    HieFilePath
absSrcPath <- IO HieFilePath -> MaybeT m HieFilePath
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HieFilePath -> MaybeT m HieFilePath)
-> IO HieFilePath -> MaybeT m HieFilePath
forall a b. (a -> b) -> a -> b
$ HieFilePath -> IO HieFilePath
Dir.makeAbsolute HieFilePath
srcPath
    Just HieModuleRow
hieModRow <- (HieDb -> IO (Maybe HieModuleRow)) -> MaybeT m (Maybe HieModuleRow)
forall (m :: * -> *) a.
(HasStaticEnv m, MonadIO m) =>
(HieDb -> IO a) -> MaybeT m a
runHieDbMaybeT ((HieDb -> IO (Maybe HieModuleRow))
 -> MaybeT m (Maybe HieModuleRow))
-> (HieDb -> IO (Maybe HieModuleRow))
-> MaybeT m (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ \HieDb
hieDb -> do
        HieDb -> HieFilePath -> IO (Maybe HieModuleRow)
HieDb.lookupHieFileFromSource HieDb
hieDb HieFilePath
absSrcPath
    HieFilePath -> MaybeT m HieFilePath
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HieFilePath -> MaybeT m HieFilePath)
-> HieFilePath -> MaybeT m HieFilePath
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> HieFilePath
HieDb.hieModuleHieFile HieModuleRow
hieModRow

hieFilePathToSrcFilePathHieDb :: (HasStaticEnv m, MonadIO m) => SrcFilePath -> MaybeT m HieFilePath
hieFilePathToSrcFilePathHieDb :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
hieFilePathToSrcFilePathHieDb HieFilePath
hiePath = do
    HieFilePath
absHiePath <- IO HieFilePath -> MaybeT m HieFilePath
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HieFilePath -> MaybeT m HieFilePath)
-> IO HieFilePath -> MaybeT m HieFilePath
forall a b. (a -> b) -> a -> b
$ HieFilePath -> IO HieFilePath
Dir.makeAbsolute HieFilePath
hiePath
    Just HieModuleRow
hieModRow <- (HieDb -> IO (Maybe HieModuleRow)) -> MaybeT m (Maybe HieModuleRow)
forall (m :: * -> *) a.
(HasStaticEnv m, MonadIO m) =>
(HieDb -> IO a) -> MaybeT m a
runHieDbMaybeT ((HieDb -> IO (Maybe HieModuleRow))
 -> MaybeT m (Maybe HieModuleRow))
-> (HieDb -> IO (Maybe HieModuleRow))
-> MaybeT m (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ \HieDb
hieDb -> do
        HieDb -> HieFilePath -> IO (Maybe HieModuleRow)
HieDb.lookupHieFileFromHie HieDb
hieDb HieFilePath
absHiePath
    Maybe HieFilePath -> MaybeT m HieFilePath
forall (f :: * -> *) (g :: * -> *) a.
(Functor f, Foldable f, Alternative g) =>
f a -> g a
toAlt (Maybe HieFilePath -> MaybeT m HieFilePath)
-> (ModuleInfo -> Maybe HieFilePath)
-> ModuleInfo
-> MaybeT m HieFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> Maybe HieFilePath
HieDb.modInfoSrcFile (ModuleInfo -> MaybeT m HieFilePath)
-> ModuleInfo -> MaybeT m HieFilePath
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
HieDb.hieModInfo HieModuleRow
hieModRow

modToHieFilePath :: (HasStaticEnv m, MonadIO m) => GHC.ModuleName -> MaybeT m HieFilePath
modToHieFilePath :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
ModuleName -> MaybeT m HieFilePath
modToHieFilePath ModuleName
modName =
    MaybeT m (Maybe HieFilePath) -> MaybeT m HieFilePath
forall (m :: * -> *) a. Monad m => MaybeT m (Maybe a) -> MaybeT m a
flatMaybeT (MaybeT m (Maybe HieFilePath) -> MaybeT m HieFilePath)
-> MaybeT m (Maybe HieFilePath) -> MaybeT m HieFilePath
forall a b. (a -> b) -> a -> b
$ (HieDb -> IO (Maybe HieFilePath)) -> MaybeT m (Maybe HieFilePath)
forall (m :: * -> *) a.
(HasStaticEnv m, MonadIO m) =>
(HieDb -> IO a) -> MaybeT m a
runHieDbMaybeT ((HieDb -> IO (Maybe HieFilePath)) -> MaybeT m (Maybe HieFilePath))
-> (HieDb -> IO (Maybe HieFilePath))
-> MaybeT m (Maybe HieFilePath)
forall a b. (a -> b) -> a -> b
$ \HieDb
hieDb ->
        MaybeT IO HieFilePath -> IO (Maybe HieFilePath)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO HieFilePath -> IO (Maybe HieFilePath))
-> MaybeT IO HieFilePath -> IO (Maybe HieFilePath)
forall a b. (a -> b) -> a -> b
$ do
            Right Unit
unitId <- IO (Either HieDbErr Unit) -> MaybeT IO (Either HieDbErr Unit)
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HieDb -> ModuleName -> IO (Either HieDbErr Unit)
HieDb.resolveUnitId HieDb
hieDb ModuleName
modName)
            Just HieModuleRow
hieModRow <- IO (Maybe HieModuleRow) -> MaybeT IO (Maybe HieModuleRow)
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe HieModuleRow) -> MaybeT IO (Maybe HieModuleRow))
-> IO (Maybe HieModuleRow) -> MaybeT IO (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ HieDb -> ModuleName -> Unit -> IO (Maybe HieModuleRow)
HieDb.lookupHieFile HieDb
hieDb ModuleName
modName Unit
unitId
            HieFilePath -> MaybeT IO HieFilePath
forall a. a -> MaybeT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HieModuleRow
hieModRow.hieModuleHieFile

-----------------------------------------------------------------------------------
-- File/Directory method for getting hie files - faster but somewhat "hacky"
-- Useful as a fallback
-----------------------------------------------------------------------------------

hieFilePathToSrcFilePathFromFile :: (HasStaticEnv m, MonadIO m) => HieFilePath -> MaybeT m SrcFilePath
hieFilePathToSrcFilePathFromFile :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
hieFilePathToSrcFilePathFromFile HieFilePath
hiePath = do
    HieFile
hieFile <- ExceptT HieFileReadException m HieFile -> MaybeT m HieFile
forall (m :: * -> *) e a. Functor m => ExceptT e m a -> MaybeT m a
exceptToMaybeT (ExceptT HieFileReadException m HieFile -> MaybeT m HieFile)
-> ExceptT HieFileReadException m HieFile -> MaybeT m HieFile
forall a b. (a -> b) -> a -> b
$ HieFilePath -> ExceptT HieFileReadException m HieFile
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
HieFilePath -> ExceptT HieFileReadException m HieFile
getHieFile HieFilePath
hiePath
    IO HieFilePath -> MaybeT m HieFilePath
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HieFilePath -> MaybeT m HieFilePath)
-> IO HieFilePath -> MaybeT m HieFilePath
forall a b. (a -> b) -> a -> b
$ HieFilePath -> IO HieFilePath
Dir.makeAbsolute HieFile
hieFile.hie_hs_file

{- | Retrieve a hie file path from a src path

Substitutes the src directory with the hie directory and the src file extension with
the hie file extension. Fragile, but works well in practice.

Presently necessary because hiedb does not currently index the hs_src file location
in the `mods` table
-}
srcFilePathToHieFilePathFromFile :: (HasStaticEnv m, MonadIO m) => SrcFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePathFromFile :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
HieFilePath -> MaybeT m HieFilePath
srcFilePathToHieFilePathFromFile HieFilePath
srcPath = do
    StaticEnv
staticEnv <- MaybeT m StaticEnv
forall (m :: * -> *). HasStaticEnv m => m StaticEnv
getStaticEnv
    let hieDir :: HieFilePath
hieDir = StaticEnv
staticEnv.wsRoot HieFilePath -> HieFilePath -> HieFilePath
</> StaticEnv
staticEnv.hieFilesPath
    HieFilePath
-> HieFilePath
-> HieFilePath
-> HieFilePath
-> MaybeT m HieFilePath
forall (m :: * -> *).
MonadIO m =>
HieFilePath
-> HieFilePath
-> HieFilePath
-> HieFilePath
-> MaybeT m HieFilePath
subRootExtensionFilepath StaticEnv
staticEnv.wsRoot HieFilePath
hieDir HieFilePath
".hie" HieFilePath
srcPath

-----------------------------------------------------------------------------------
-- Map index method for getting hie files - too slow in practice on startup but makes
-- finding references for functions that are used a lot much faster
-----------------------------------------------------------------------------------
data HieInfo = HieInfo
    { HieInfo -> HieFilePath
hieFilePath :: HieFilePath
    , HieInfo -> HieFile
hieFile :: GHC.HieFile
    }

getHieFileMap :: FilePath -> HieFilePath -> IO (Map.Map SrcFilePath HieInfo)
getHieFileMap :: HieFilePath -> HieFilePath -> IO (Map HieFilePath HieInfo)
getHieFileMap HieFilePath
wsroot HieFilePath
hieDir = do
    let hieFullPath :: HieFilePath
hieFullPath = HieFilePath
wsroot HieFilePath -> HieFilePath -> HieFilePath
</> HieFilePath
hieDir
    [HieFilePath]
hieFilePaths <- HieFilePath -> IO [HieFilePath]
HieDb.getHieFilesIn HieFilePath
hieFullPath
    NameCache
nameCache <- Char -> [Name] -> IO NameCache
GHC.initNameCache Char
'a' []
    [(HieFilePath, HieInfo)]
srcPathHieInfoPairs <- (HieFilePath -> IO (HieFilePath, HieInfo))
-> [HieFilePath] -> IO [(HieFilePath, HieInfo)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (NameCache -> HieFilePath -> IO (HieFilePath, HieInfo)
srcFileToHieFileInfo NameCache
nameCache) [HieFilePath]
hieFilePaths

    Map HieFilePath HieInfo -> IO (Map HieFilePath HieInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map HieFilePath HieInfo -> IO (Map HieFilePath HieInfo))
-> Map HieFilePath HieInfo -> IO (Map HieFilePath HieInfo)
forall a b. (a -> b) -> a -> b
$ [(HieFilePath, HieInfo)] -> Map HieFilePath HieInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(HieFilePath, HieInfo)]
srcPathHieInfoPairs
  where
    srcFileToHieFileInfo :: GHC.NameCache -> HieFilePath -> IO (SrcFilePath, HieInfo)
    srcFileToHieFileInfo :: NameCache -> HieFilePath -> IO (HieFilePath, HieInfo)
srcFileToHieFileInfo NameCache
nameCache HieFilePath
hieFilePath = do
        HieFileResult
hieFileResult <- NameCache -> HieFilePath -> IO HieFileResult
GHC.readHieFile NameCache
nameCache HieFilePath
hieFilePath
        HieFilePath
absSrcFilePath <- HieFilePath -> IO HieFilePath
Dir.makeAbsolute HieFileResult
hieFileResult.hie_file_result.hie_hs_file
        HieFilePath
absHieFilePath <- HieFilePath -> IO HieFilePath
Dir.makeAbsolute HieFilePath
hieFilePath
        let hieInfo :: HieInfo
hieInfo =
                HieInfo
                    { $sel:hieFilePath:HieInfo :: HieFilePath
hieFilePath = HieFilePath
absHieFilePath
                    , $sel:hieFile:HieInfo :: HieFile
hieFile = HieFileResult
hieFileResult.hie_file_result
                    }
        (HieFilePath, HieInfo) -> IO (HieFilePath, HieInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HieFilePath
absSrcFilePath, HieInfo
hieInfo)

hieFileMapToSrcMap :: Map.Map SrcFilePath HieInfo -> Map.Map HieFilePath SrcFilePath
hieFileMapToSrcMap :: Map HieFilePath HieInfo -> Map HieFilePath HieFilePath
hieFileMapToSrcMap =
    [(HieFilePath, HieFilePath)] -> Map HieFilePath HieFilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(HieFilePath, HieFilePath)] -> Map HieFilePath HieFilePath)
-> (Map HieFilePath HieInfo -> [(HieFilePath, HieFilePath)])
-> Map HieFilePath HieInfo
-> Map HieFilePath HieFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HieFilePath, HieInfo) -> (HieFilePath, HieFilePath))
-> [(HieFilePath, HieInfo)] -> [(HieFilePath, HieFilePath)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HieFilePath
srcPath, HieInfo
hieInfo) -> (HieInfo
hieInfo.hieFilePath, HieFilePath
srcPath)) ([(HieFilePath, HieInfo)] -> [(HieFilePath, HieFilePath)])
-> (Map HieFilePath HieInfo -> [(HieFilePath, HieInfo)])
-> Map HieFilePath HieInfo
-> [(HieFilePath, HieFilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map HieFilePath HieInfo -> [(HieFilePath, HieInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList