{-# LANGUAGE CPP #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Core.Rules(
IdeState, GetParsedModule(..), TransitiveDependencies(..),
GhcSessionIO(..), GetClientSettings(..),
runAction,
toIdeResult,
defineNoFile,
defineEarlyCutOffNoFile,
mainRule,
RulesConfig(..),
getParsedModule,
getParsedModuleWithComments,
getClientConfigAction,
usePropertyAction,
usePropertyByPathAction,
getHieFile,
CompiledLinkables(..),
getParsedModuleRule,
getParsedModuleWithCommentsRule,
getLocatedImportsRule,
reportImportCyclesRule,
typeCheckRule,
getDocMapRule,
loadGhcSession,
getModIfaceFromDiskRule,
getModIfaceRule,
getModSummaryRule,
getModuleGraphRule,
knownFilesRule,
getClientSettingsRule,
getHieAstsRule,
getBindingsRule,
needsCompilationRule,
generateCoreRule,
getImportMapRule,
regenerateHiFile,
ghcSessionDepsDefinition,
getParsedModuleDefinition,
typeCheckRuleDefinition,
getRebuildCount,
getSourceFileSource,
currentLinkables,
GhcSessionDepsConfig(..),
Log(..),
DisplayTHWarning(..),
) where
import Control.Applicative
import Control.Concurrent.STM.Stats (atomically)
import Control.Concurrent.STM.TVar
import Control.Concurrent.Strict
import Control.DeepSeq
import Control.Exception (evaluate)
import Control.Exception.Safe
import Control.Monad.Extra
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Except (ExceptT, except,
runExceptT)
import Control.Monad.Trans.Maybe
import Data.Aeson (toJSON)
import qualified Data.Binary as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Coerce
import Data.Default (Default, def)
import Data.Foldable
import Data.Hashable
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HashSet
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IORef
import Data.List
import Data.List.Extra (nubOrdOn)
import qualified Data.Map as M
import Data.Maybe
import Data.Proxy
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (UTCTime (..))
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Tuple.Extra
import Data.Typeable (cast)
import Development.IDE.Core.Compile
import Development.IDE.Core.FileExists hiding (Log,
LogShake)
import Development.IDE.Core.FileStore (getFileContents,
getModTime)
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.OfInterest hiding (Log,
LogShake)
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Service hiding (Log,
LogShake)
import Development.IDE.Core.Shake hiding (Log)
import qualified Development.IDE.Core.Shake as Shake
import Development.IDE.GHC.Compat hiding
(TargetId (..),
Var,
loadInterface,
nest,
parseModule,
settings, vcat,
(<+>))
import qualified Development.IDE.GHC.Compat as Compat hiding
(nest,
vcat)
import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.Error
import Development.IDE.GHC.Util hiding
(modifyDynFlags)
import Development.IDE.Graph
import Development.IDE.Import.DependencyInformation
import Development.IDE.Import.FindImports
import qualified Development.IDE.Spans.AtPoint as AtPoint
import Development.IDE.Spans.Documentation
import Development.IDE.Spans.LocalBindings
import Development.IDE.Types.Diagnostics as Diag
import Development.IDE.Types.HscEnvEq
import Development.IDE.Types.Location
import Development.IDE.Types.Options
import qualified Development.IDE.Types.Shake as Shake
import qualified GHC.LanguageExtensions as LangExt
import HIE.Bios.Ghc.Gap (hostIsDynamic)
import qualified HieDb
import Ide.Logger (Pretty (pretty),
Recorder,
WithPriority,
cmapWithPrio,
logWith, nest,
vcat, (<+>))
import qualified Ide.Logger as Logger
import Ide.Plugin.Config
import Ide.Plugin.Properties (HasProperty,
HasPropertyByPath,
KeyNamePath,
KeyNameProxy,
Properties,
ToHsType,
useProperty,
usePropertyByPath)
import Ide.Types (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser),
PluginId)
import Language.LSP.Protocol.Message (SMethod (SMethod_CustomMethod, SMethod_WindowShowMessage))
import Language.LSP.Protocol.Types (MessageType (MessageType_Info),
ShowMessageParams (ShowMessageParams))
import Language.LSP.Server (LspT)
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
import Prelude hiding (mod)
import System.Directory (doesFileExist)
import System.Info.Extra (isWindows)
import GHC.Fingerprint
#if !MIN_VERSION_ghc(9,3,0)
import GHC (mgModSummaries)
#endif
#if MIN_VERSION_ghc(9,3,0)
import qualified Data.IntMap as IM
#endif
data Log
= LogShake Shake.Log
| LogReindexingHieFile !NormalizedFilePath
| LogLoadingHieFile !NormalizedFilePath
| LogLoadingHieFileFail !FilePath !SomeException
| LogLoadingHieFileSuccess !FilePath
| LogTypecheckedFOI !NormalizedFilePath
deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> [Char]
(Int -> Log -> ShowS)
-> (Log -> [Char]) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> [Char]
show :: Log -> [Char]
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show
instance Pretty Log where
pretty :: forall ann. Log -> Doc ann
pretty = \case
LogShake Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
LogReindexingHieFile NormalizedFilePath
path ->
Doc ann
"Re-indexing hie file for" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
path)
LogLoadingHieFile NormalizedFilePath
path ->
Doc ann
"LOADING HIE FILE FOR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
path)
LogLoadingHieFileFail [Char]
path SomeException
e ->
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
[Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
[ Doc ann
"FAILED LOADING HIE FILE FOR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
path
, [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
e) ]
LogLoadingHieFileSuccess [Char]
path ->
Doc ann
"SUCCEEDED LOADING HIE FILE FOR" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [Char]
path
LogTypecheckedFOI NormalizedFilePath
path -> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
[ Doc ann
"Typechecked a file which is not currently open in the editor:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall ann. [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
path)
, Doc ann
"This can indicate a bug which results in excessive memory usage."
, Doc ann
"This may be a spurious warning if you have recently closed the file."
, Doc ann
"If you haven't opened this file recently, please file a report on the issue tracker mentioning"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"the HLS version being used, the plugins enabled, and if possible the codebase and file which"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"triggered this warning."
]
templateHaskellInstructions :: T.Text
templateHaskellInstructions :: Text
templateHaskellInstructions = Text
"https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"
toIdeResult :: Either [FileDiagnostic] v -> IdeResult v
toIdeResult :: forall v. Either [FileDiagnostic] v -> IdeResult v
toIdeResult = ([FileDiagnostic] -> IdeResult v)
-> (v -> IdeResult v) -> Either [FileDiagnostic] v -> IdeResult v
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (, Maybe v
forall a. Maybe a
Nothing) (([],) (Maybe v -> IdeResult v) -> (v -> Maybe v) -> v -> IdeResult v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v
forall a. a -> Maybe a
Just)
getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString
getSourceFileSource :: NormalizedFilePath -> Action ByteString
getSourceFileSource NormalizedFilePath
nfp = do
(UTCTime
_, Maybe Text
msource) <- NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
nfp
case Maybe Text
msource of
Maybe Text
Nothing -> IO ByteString -> Action ByteString
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Action ByteString)
-> IO ByteString -> Action ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
BS.readFile (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
nfp)
Just Text
source -> ByteString -> Action ByteString
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Action ByteString)
-> ByteString -> Action ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
source
getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule = GetParsedModule
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule
getParsedModuleWithComments :: NormalizedFilePath -> Action (Maybe ParsedModule)
= GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments
getParsedModuleRule :: Recorder (WithPriority Log) -> Rules ()
getParsedModuleRule :: Recorder (WithPriority Log) -> Rules ()
getParsedModuleRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GetParsedModule
-> NormalizedFilePath -> Action (IdeResult ParsedModule))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetParsedModule
-> NormalizedFilePath -> Action (IdeResult ParsedModule))
-> Rules ())
-> (GetParsedModule
-> NormalizedFilePath -> Action (IdeResult ParsedModule))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetParsedModule
GetParsedModule NormalizedFilePath
file -> do
ModSummaryResult{msrModSummary :: ModSummaryResult -> ModSummary
msrModSummary = ModSummary
ms', msrHscEnv :: ModSummaryResult -> HscEnv
msrHscEnv = HscEnv
hsc} <- GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
file
IdeOptions
opt <- Action IdeOptions
getIdeOptions
DynFlags -> DynFlags
modify_dflags <- (DynFlagsModifications -> DynFlags -> DynFlags)
-> Action (DynFlags -> DynFlags)
forall a. (DynFlagsModifications -> a) -> Action a
getModifyDynFlags DynFlagsModifications -> DynFlags -> DynFlags
dynFlagsModifyParser
let ms :: ModSummary
ms = ModSummary
ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' }
reset_ms :: ParsedModule -> ParsedModule
reset_ms ParsedModule
pm = ParsedModule
pm { pm_mod_summary = ms' }
IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule))
-> IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
forall a b. (a -> b) -> a -> b
$ ((IdeResult ParsedModule -> IdeResult ParsedModule)
-> IO (IdeResult ParsedModule) -> IO (IdeResult ParsedModule)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((IdeResult ParsedModule -> IdeResult ParsedModule)
-> IO (IdeResult ParsedModule) -> IO (IdeResult ParsedModule))
-> ((ParsedModule -> ParsedModule)
-> IdeResult ParsedModule -> IdeResult ParsedModule)
-> (ParsedModule -> ParsedModule)
-> IO (IdeResult ParsedModule)
-> IO (IdeResult ParsedModule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ParsedModule -> Maybe ParsedModule)
-> IdeResult ParsedModule -> IdeResult ParsedModule
forall a b.
(a -> b) -> ([FileDiagnostic], a) -> ([FileDiagnostic], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe ParsedModule -> Maybe ParsedModule)
-> IdeResult ParsedModule -> IdeResult ParsedModule)
-> ((ParsedModule -> ParsedModule)
-> Maybe ParsedModule -> Maybe ParsedModule)
-> (ParsedModule -> ParsedModule)
-> IdeResult ParsedModule
-> IdeResult ParsedModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ParsedModule -> ParsedModule)
-> Maybe ParsedModule -> Maybe ParsedModule
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ParsedModule -> ParsedModule
reset_ms (IO (IdeResult ParsedModule) -> IO (IdeResult ParsedModule))
-> IO (IdeResult ParsedModule) -> IO (IdeResult ParsedModule)
forall a b. (a -> b) -> a -> b
$ HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
hsc IdeOptions
opt NormalizedFilePath
file (ModSummary -> ModSummary
withOptHaddock ModSummary
ms)
withOptHaddock :: ModSummary -> ModSummary
withOptHaddock :: ModSummary -> ModSummary
withOptHaddock = GeneralFlag -> ModSummary -> ModSummary
withOption GeneralFlag
Opt_Haddock
withOption :: GeneralFlag -> ModSummary -> ModSummary
withOption :: GeneralFlag -> ModSummary -> ModSummary
withOption GeneralFlag
opt ModSummary
ms = ModSummary
ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) opt}
withoutOption :: GeneralFlag -> ModSummary -> ModSummary
withoutOption :: GeneralFlag -> ModSummary -> ModSummary
withoutOption GeneralFlag
opt ModSummary
ms = ModSummary
ms{ms_hspp_opts= gopt_unset (ms_hspp_opts ms) opt}
getParsedModuleWithCommentsRule :: Recorder (WithPriority Log) -> Rules ()
Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule))
-> Rules ())
-> (GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetParsedModuleWithComments
GetParsedModuleWithComments NormalizedFilePath
file -> do
ModSummaryResult{msrModSummary :: ModSummaryResult -> ModSummary
msrModSummary = ModSummary
ms, msrHscEnv :: ModSummaryResult -> HscEnv
msrHscEnv = HscEnv
hsc} <- GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
file
IdeOptions
opt <- Action IdeOptions
getIdeOptions
let ms' :: ModSummary
ms' = GeneralFlag -> ModSummary -> ModSummary
withoutOption GeneralFlag
Opt_Haddock (ModSummary -> ModSummary) -> ModSummary -> ModSummary
forall a b. (a -> b) -> a -> b
$ GeneralFlag -> ModSummary -> ModSummary
withOption GeneralFlag
Opt_KeepRawTokenStream ModSummary
ms
DynFlags -> DynFlags
modify_dflags <- (DynFlagsModifications -> DynFlags -> DynFlags)
-> Action (DynFlags -> DynFlags)
forall a. (DynFlagsModifications -> a) -> Action a
getModifyDynFlags DynFlagsModifications -> DynFlags -> DynFlags
dynFlagsModifyParser
let ms'' :: ModSummary
ms'' = ModSummary
ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' }
reset_ms :: ParsedModule -> ParsedModule
reset_ms ParsedModule
pm = ParsedModule
pm { pm_mod_summary = ms' }
IO (Maybe ParsedModule) -> Action (Maybe ParsedModule)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ParsedModule) -> Action (Maybe ParsedModule))
-> IO (Maybe ParsedModule) -> Action (Maybe ParsedModule)
forall a b. (a -> b) -> a -> b
$ (Maybe ParsedModule -> Maybe ParsedModule)
-> IO (Maybe ParsedModule) -> IO (Maybe ParsedModule)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParsedModule -> ParsedModule)
-> Maybe ParsedModule -> Maybe ParsedModule
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedModule -> ParsedModule
reset_ms) (IO (Maybe ParsedModule) -> IO (Maybe ParsedModule))
-> IO (Maybe ParsedModule) -> IO (Maybe ParsedModule)
forall a b. (a -> b) -> a -> b
$ IdeResult ParsedModule -> Maybe ParsedModule
forall a b. (a, b) -> b
snd (IdeResult ParsedModule -> Maybe ParsedModule)
-> IO (IdeResult ParsedModule) -> IO (Maybe ParsedModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
hsc IdeOptions
opt NormalizedFilePath
file ModSummary
ms''
getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a
getModifyDynFlags :: forall a. (DynFlagsModifications -> a) -> Action a
getModifyDynFlags DynFlagsModifications -> a
f = do
IdeOptions
opts <- Action IdeOptions
getIdeOptions
Config
cfg <- Action Config
getClientConfigAction
a -> Action a
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Action a) -> a -> Action a
forall a b. (a -> b) -> a -> b
$ DynFlagsModifications -> a
f (DynFlagsModifications -> a) -> DynFlagsModifications -> a
forall a b. (a -> b) -> a -> b
$ IdeOptions -> Config -> DynFlagsModifications
optModifyDynFlags IdeOptions
opts Config
cfg
getParsedModuleDefinition
:: HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary -> IO ([FileDiagnostic], Maybe ParsedModule)
getParsedModuleDefinition :: HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
packageState IdeOptions
opt NormalizedFilePath
file ModSummary
ms = do
let fp :: [Char]
fp = NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file
([FileDiagnostic]
diag, Maybe ParsedModule
res) <- IdeOptions
-> HscEnv -> [Char] -> ModSummary -> IO (IdeResult ParsedModule)
parseModule IdeOptions
opt HscEnv
packageState [Char]
fp ModSummary
ms
case Maybe ParsedModule
res of
Maybe ParsedModule
Nothing -> IdeResult ParsedModule -> IO (IdeResult ParsedModule)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diag, Maybe ParsedModule
forall a. Maybe a
Nothing)
Just ParsedModule
modu -> IdeResult ParsedModule -> IO (IdeResult ParsedModule)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diag, ParsedModule -> Maybe ParsedModule
forall a. a -> Maybe a
Just ParsedModule
modu)
getLocatedImportsRule :: Recorder (WithPriority Log) -> Rules ()
getLocatedImportsRule :: Recorder (WithPriority Log) -> Rules ()
getLocatedImportsRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GetLocatedImports
-> NormalizedFilePath
-> Action
(IdeResult [(Located ModuleName, Maybe ArtifactsLocation)]))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetLocatedImports
-> NormalizedFilePath
-> Action
(IdeResult [(Located ModuleName, Maybe ArtifactsLocation)]))
-> Rules ())
-> (GetLocatedImports
-> NormalizedFilePath
-> Action
(IdeResult [(Located ModuleName, Maybe ArtifactsLocation)]))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetLocatedImports
GetLocatedImports NormalizedFilePath
file -> do
ModSummaryResult{msrModSummary :: ModSummaryResult -> ModSummary
msrModSummary = ModSummary
ms} <- GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
(KnownTargets HashMap Target (HashSet NormalizedFilePath)
targets HashMap Target Target
targetsMap) <- GetKnownTargets -> Action KnownTargets
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetKnownTargets
GetKnownTargets
let imports :: [(Bool, (PkgQual, Located ModuleName))]
imports = [(Bool
False, (PkgQual, Located ModuleName)
imp) | (PkgQual, Located ModuleName)
imp <- ModSummary -> [(PkgQual, Located ModuleName)]
ms_textual_imps ModSummary
ms] [(Bool, (PkgQual, Located ModuleName))]
-> [(Bool, (PkgQual, Located ModuleName))]
-> [(Bool, (PkgQual, Located ModuleName))]
forall a. [a] -> [a] -> [a]
++ [(Bool
True, (PkgQual, Located ModuleName)
imp) | (PkgQual, Located ModuleName)
imp <- ModSummary -> [(PkgQual, Located ModuleName)]
ms_srcimps ModSummary
ms]
HscEnvEq
env_eq <- GhcSession -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSession
GhcSession NormalizedFilePath
file
let env :: HscEnv
env = HscEnvEq -> HscEnv
hscEnvWithImportPaths HscEnvEq
env_eq
let import_dirs :: [(UnitId, DynFlags)]
import_dirs = HscEnvEq -> [(UnitId, DynFlags)]
deps HscEnvEq
env_eq
let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
env
isImplicitCradle :: Bool
isImplicitCradle = Maybe (Set [Char]) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Set [Char]) -> Bool) -> Maybe (Set [Char]) -> Bool
forall a b. (a -> b) -> a -> b
$ HscEnvEq -> Maybe (Set [Char])
envImportPaths HscEnvEq
env_eq
let dflags' :: DynFlags
dflags' = if Bool
isImplicitCradle
then NormalizedFilePath -> ModuleName -> DynFlags -> DynFlags
addRelativeImport NormalizedFilePath
file (GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModSummary -> GenModule Unit
ms_mod ModSummary
ms) DynFlags
dflags
else DynFlags
dflags
IdeOptions
opt <- Action IdeOptions
getIdeOptions
let getTargetFor :: ModuleName
-> NormalizedFilePath -> Action (Maybe NormalizedFilePath)
getTargetFor ModuleName
modName NormalizedFilePath
nfp
| Bool
isImplicitCradle = do
Bool
itExists <- NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp
Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath))
-> Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
itExists then NormalizedFilePath -> Maybe NormalizedFilePath
forall a. a -> Maybe a
Just NormalizedFilePath
nfp else Maybe NormalizedFilePath
forall a. Maybe a
Nothing
| Just (TargetFile NormalizedFilePath
nfp') <- Target -> HashMap Target Target -> Maybe Target
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (NormalizedFilePath -> Target
TargetFile NormalizedFilePath
nfp) HashMap Target Target
targetsMap = do
Bool
itExists <- NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp'
Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath))
-> Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
itExists then NormalizedFilePath -> Maybe NormalizedFilePath
forall a. a -> Maybe a
Just NormalizedFilePath
nfp' else Maybe NormalizedFilePath
forall a. Maybe a
Nothing
| Just HashSet NormalizedFilePath
tt <- Target
-> HashMap Target (HashSet NormalizedFilePath)
-> Maybe (HashSet NormalizedFilePath)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (ModuleName -> Target
TargetModule ModuleName
modName) HashMap Target (HashSet NormalizedFilePath)
targets = do
let ttmap :: HashMap NormalizedFilePath NormalizedFilePath
ttmap = (NormalizedFilePath -> () -> NormalizedFilePath)
-> HashMap NormalizedFilePath ()
-> HashMap NormalizedFilePath NormalizedFilePath
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey NormalizedFilePath -> () -> NormalizedFilePath
forall a b. a -> b -> a
const (HashSet NormalizedFilePath -> HashMap NormalizedFilePath ()
forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet NormalizedFilePath
tt)
nfp' :: NormalizedFilePath
nfp' = NormalizedFilePath
-> NormalizedFilePath
-> HashMap NormalizedFilePath NormalizedFilePath
-> NormalizedFilePath
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HM.lookupDefault NormalizedFilePath
nfp NormalizedFilePath
nfp HashMap NormalizedFilePath NormalizedFilePath
ttmap
Bool
itExists <- NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp'
Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath))
-> Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
itExists then NormalizedFilePath -> Maybe NormalizedFilePath
forall a. a -> Maybe a
Just NormalizedFilePath
nfp' else Maybe NormalizedFilePath
forall a. Maybe a
Nothing
| Bool
otherwise
= Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NormalizedFilePath
forall a. Maybe a
Nothing
([[FileDiagnostic]]
diags, [Maybe (Located ModuleName, Maybe ArtifactsLocation)]
imports') <- ([([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))]
-> ([[FileDiagnostic]],
[Maybe (Located ModuleName, Maybe ArtifactsLocation)]))
-> Action
[([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))]
-> Action
([[FileDiagnostic]],
[Maybe (Located ModuleName, Maybe ArtifactsLocation)])
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))]
-> ([[FileDiagnostic]],
[Maybe (Located ModuleName, Maybe ArtifactsLocation)])
forall a b. [(a, b)] -> ([a], [b])
unzip (Action
[([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))]
-> Action
([[FileDiagnostic]],
[Maybe (Located ModuleName, Maybe ArtifactsLocation)]))
-> Action
[([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))]
-> Action
([[FileDiagnostic]],
[Maybe (Located ModuleName, Maybe ArtifactsLocation)])
forall a b. (a -> b) -> a -> b
$ [(Bool, (PkgQual, Located ModuleName))]
-> ((Bool, (PkgQual, Located ModuleName))
-> Action
([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation)))
-> Action
[([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Bool, (PkgQual, Located ModuleName))]
imports (((Bool, (PkgQual, Located ModuleName))
-> Action
([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation)))
-> Action
[([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))])
-> ((Bool, (PkgQual, Located ModuleName))
-> Action
([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation)))
-> Action
[([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))]
forall a b. (a -> b) -> a -> b
$ \(Bool
isSource, (PkgQual
mbPkgName, Located ModuleName
modName)) -> do
Either [FileDiagnostic] Import
diagOrImp <- HscEnv
-> [(UnitId, DynFlags)]
-> [[Char]]
-> (ModuleName
-> NormalizedFilePath -> Action (Maybe NormalizedFilePath))
-> Located ModuleName
-> PkgQual
-> Bool
-> Action (Either [FileDiagnostic] Import)
forall (m :: * -> *).
MonadIO m =>
HscEnv
-> [(UnitId, DynFlags)]
-> [[Char]]
-> (ModuleName
-> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> PkgQual
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule (DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags' HscEnv
env) [(UnitId, DynFlags)]
import_dirs (IdeOptions -> [[Char]]
optExtensions IdeOptions
opt) ModuleName
-> NormalizedFilePath -> Action (Maybe NormalizedFilePath)
getTargetFor Located ModuleName
modName PkgQual
mbPkgName Bool
isSource
case Either [FileDiagnostic] Import
diagOrImp of
Left [FileDiagnostic]
diags -> ([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))
-> Action
([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags, (Located ModuleName, Maybe ArtifactsLocation)
-> Maybe (Located ModuleName, Maybe ArtifactsLocation)
forall a. a -> Maybe a
Just (Located ModuleName
modName, Maybe ArtifactsLocation
forall a. Maybe a
Nothing))
Right (FileImport ArtifactsLocation
path) -> ([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))
-> Action
([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], (Located ModuleName, Maybe ArtifactsLocation)
-> Maybe (Located ModuleName, Maybe ArtifactsLocation)
forall a. a -> Maybe a
Just (Located ModuleName
modName, ArtifactsLocation -> Maybe ArtifactsLocation
forall a. a -> Maybe a
Just ArtifactsLocation
path))
Right Import
PackageImport -> ([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))
-> Action
([FileDiagnostic],
Maybe (Located ModuleName, Maybe ArtifactsLocation))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Maybe (Located ModuleName, Maybe ArtifactsLocation)
forall a. Maybe a
Nothing)
let bootArtifact :: Maybe a
bootArtifact = Maybe a
forall a. Maybe a
Nothing
let moduleImports :: [(Located ModuleName, Maybe ArtifactsLocation)]
moduleImports = [Maybe (Located ModuleName, Maybe ArtifactsLocation)]
-> [(Located ModuleName, Maybe ArtifactsLocation)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Located ModuleName, Maybe ArtifactsLocation)]
-> [(Located ModuleName, Maybe ArtifactsLocation)])
-> [Maybe (Located ModuleName, Maybe ArtifactsLocation)]
-> [(Located ModuleName, Maybe ArtifactsLocation)]
forall a b. (a -> b) -> a -> b
$ Maybe (Located ModuleName, Maybe ArtifactsLocation)
forall a. Maybe a
bootArtifact Maybe (Located ModuleName, Maybe ArtifactsLocation)
-> [Maybe (Located ModuleName, Maybe ArtifactsLocation)]
-> [Maybe (Located ModuleName, Maybe ArtifactsLocation)]
forall a. a -> [a] -> [a]
: [Maybe (Located ModuleName, Maybe ArtifactsLocation)]
imports'
IdeResult [(Located ModuleName, Maybe ArtifactsLocation)]
-> Action
(IdeResult [(Located ModuleName, Maybe ArtifactsLocation)])
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[FileDiagnostic]] -> [FileDiagnostic]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FileDiagnostic]]
diags, [(Located ModuleName, Maybe ArtifactsLocation)]
-> Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
forall a. a -> Maybe a
Just [(Located ModuleName, Maybe ArtifactsLocation)]
moduleImports)
type RawDepM a = StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action a
execRawDepM :: Monad m => StateT (RawDependencyInformation, IntMap a1) m a2 -> m (RawDependencyInformation, IntMap a1)
execRawDepM :: forall (m :: * -> *) a1 a2.
Monad m =>
StateT (RawDependencyInformation, IntMap a1) m a2
-> m (RawDependencyInformation, IntMap a1)
execRawDepM StateT (RawDependencyInformation, IntMap a1) m a2
act =
StateT (RawDependencyInformation, IntMap a1) m a2
-> (RawDependencyInformation, IntMap a1)
-> m (RawDependencyInformation, IntMap a1)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT (RawDependencyInformation, IntMap a1) m a2
act
( FilePathIdMap (Either ModuleParseError ModuleImports)
-> PathIdMap
-> FilePathIdMap ShowableModule
-> RawDependencyInformation
RawDependencyInformation FilePathIdMap (Either ModuleParseError ModuleImports)
forall a. IntMap a
IntMap.empty PathIdMap
emptyPathIdMap FilePathIdMap ShowableModule
forall a. IntMap a
IntMap.empty
, IntMap a1
forall a. IntMap a
IntMap.empty
)
rawDependencyInformation :: [NormalizedFilePath] -> Action (RawDependencyInformation, BootIdMap)
rawDependencyInformation :: [NormalizedFilePath]
-> Action (RawDependencyInformation, BootIdMap)
rawDependencyInformation [NormalizedFilePath]
fs = do
(RawDependencyInformation
rdi, IntMap ArtifactsLocation
ss) <- StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[FilePathId]
-> Action (RawDependencyInformation, IntMap ArtifactsLocation)
forall (m :: * -> *) a1 a2.
Monad m =>
StateT (RawDependencyInformation, IntMap a1) m a2
-> m (RawDependencyInformation, IntMap a1)
execRawDepM ([NormalizedFilePath]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[FilePathId]
goPlural [NormalizedFilePath]
fs)
let bm :: BootIdMap
bm = (Int -> ArtifactsLocation -> BootIdMap -> BootIdMap)
-> BootIdMap -> IntMap ArtifactsLocation -> BootIdMap
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey (RawDependencyInformation
-> Int -> ArtifactsLocation -> BootIdMap -> BootIdMap
updateBootMap RawDependencyInformation
rdi) BootIdMap
forall a. IntMap a
IntMap.empty IntMap ArtifactsLocation
ss
(RawDependencyInformation, BootIdMap)
-> Action (RawDependencyInformation, BootIdMap)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawDependencyInformation
rdi, BootIdMap
bm)
where
goPlural :: [NormalizedFilePath]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[FilePathId]
goPlural [NormalizedFilePath]
ff = do
[Maybe ModSummary]
mss <- Action [Maybe ModSummary]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[Maybe ModSummary]
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (RawDependencyInformation, IntMap ArtifactsLocation) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Action [Maybe ModSummary]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[Maybe ModSummary])
-> Action [Maybe ModSummary]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[Maybe ModSummary]
forall a b. (a -> b) -> a -> b
$ ((Maybe ModSummaryResult -> Maybe ModSummary)
-> [Maybe ModSummaryResult] -> [Maybe ModSummary]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe ModSummaryResult -> Maybe ModSummary)
-> [Maybe ModSummaryResult] -> [Maybe ModSummary])
-> ((ModSummaryResult -> ModSummary)
-> Maybe ModSummaryResult -> Maybe ModSummary)
-> (ModSummaryResult -> ModSummary)
-> [Maybe ModSummaryResult]
-> [Maybe ModSummary]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ModSummaryResult -> ModSummary)
-> Maybe ModSummaryResult -> Maybe ModSummary
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ModSummaryResult -> ModSummary
msrModSummary ([Maybe ModSummaryResult] -> [Maybe ModSummary])
-> Action [Maybe ModSummaryResult] -> Action [Maybe ModSummary]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> [NormalizedFilePath] -> Action [Maybe ModSummaryResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps [NormalizedFilePath]
ff
(NormalizedFilePath
-> Maybe ModSummary
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId)
-> [NormalizedFilePath]
-> [Maybe ModSummary]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[FilePathId]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM NormalizedFilePath
-> Maybe ModSummary
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
go [NormalizedFilePath]
ff [Maybe ModSummary]
mss
go :: NormalizedFilePath
-> Maybe ModSummary
-> RawDepM FilePathId
go :: NormalizedFilePath
-> Maybe ModSummary
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
go NormalizedFilePath
f Maybe ModSummary
mbModSum = do
NormalizedFilePath
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
checkAlreadyProcessed NormalizedFilePath
f (StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
forall a b. (a -> b) -> a -> b
$ do
let al :: ArtifactsLocation
al = NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation
modSummaryToArtifactsLocation NormalizedFilePath
f Maybe ModSummary
mbModSum
FilePathId
fId <- ArtifactsLocation
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
getFreshFid ArtifactsLocation
al
Maybe ModSummary
-> (ModSummary
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ())
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ModSummary
mbModSum ((ModSummary
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ())
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ())
-> (ModSummary
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ())
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall a b. (a -> b) -> a -> b
$ \ModSummary
ms ->
(RawDependencyInformation -> RawDependencyInformation)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
modifyRawDepInfo (\RawDependencyInformation
rd -> RawDependencyInformation
rd { rawModuleMap = IntMap.insert (getFilePathId fId)
(ShowableModule $ ms_mod ms)
(rawModuleMap rd)})
ArtifactsLocation
-> FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
addBootMap ArtifactsLocation
al FilePathId
fId
Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
importsOrErr <- Action (Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
(Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT (RawDependencyInformation, IntMap ArtifactsLocation) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Action (Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
(Maybe [(Located ModuleName, Maybe ArtifactsLocation)]))
-> Action (Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
(Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
forall a b. (a -> b) -> a -> b
$ GetLocatedImports
-> NormalizedFilePath
-> Action (Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetLocatedImports
GetLocatedImports NormalizedFilePath
f
case Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
importsOrErr of
Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
Nothing -> do
(RawDependencyInformation -> RawDependencyInformation)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
modifyRawDepInfo (FilePathId
-> Either ModuleParseError ModuleImports
-> RawDependencyInformation
-> RawDependencyInformation
insertImport FilePathId
fId (ModuleParseError -> Either ModuleParseError ModuleImports
forall a b. a -> Either a b
Left ModuleParseError
ModuleParseError))
FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
forall a.
a
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePathId
fId
Just [(Located ModuleName, Maybe ArtifactsLocation)]
modImports -> do
let ([Located ModuleName]
no_file, [(Located ModuleName, ArtifactsLocation)]
with_file) = [(Located ModuleName, Maybe ArtifactsLocation)]
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)])
splitImports [(Located ModuleName, Maybe ArtifactsLocation)]
modImports
([Located ModuleName]
mns, [ArtifactsLocation]
ls) = [(Located ModuleName, ArtifactsLocation)]
-> ([Located ModuleName], [ArtifactsLocation])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Located ModuleName, ArtifactsLocation)]
with_file
[FilePathId]
fids <- [NormalizedFilePath]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[FilePathId]
goPlural ([NormalizedFilePath]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[FilePathId])
-> [NormalizedFilePath]
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
[FilePathId]
forall a b. (a -> b) -> a -> b
$ (ArtifactsLocation -> NormalizedFilePath)
-> [ArtifactsLocation] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map ArtifactsLocation -> NormalizedFilePath
artifactFilePath [ArtifactsLocation]
ls
let moduleImports' :: [(Located ModuleName, Maybe FilePathId)]
moduleImports' = (Located ModuleName -> (Located ModuleName, Maybe FilePathId))
-> [Located ModuleName] -> [(Located ModuleName, Maybe FilePathId)]
forall a b. (a -> b) -> [a] -> [b]
map (,Maybe FilePathId
forall a. Maybe a
Nothing) [Located ModuleName]
no_file [(Located ModuleName, Maybe FilePathId)]
-> [(Located ModuleName, Maybe FilePathId)]
-> [(Located ModuleName, Maybe FilePathId)]
forall a. [a] -> [a] -> [a]
++ [Located ModuleName]
-> [Maybe FilePathId] -> [(Located ModuleName, Maybe FilePathId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Located ModuleName]
mns ((FilePathId -> Maybe FilePathId)
-> [FilePathId] -> [Maybe FilePathId]
forall a b. (a -> b) -> [a] -> [b]
map FilePathId -> Maybe FilePathId
forall a. a -> Maybe a
Just [FilePathId]
fids)
(RawDependencyInformation -> RawDependencyInformation)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
modifyRawDepInfo ((RawDependencyInformation -> RawDependencyInformation)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ())
-> (RawDependencyInformation -> RawDependencyInformation)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall a b. (a -> b) -> a -> b
$ FilePathId
-> Either ModuleParseError ModuleImports
-> RawDependencyInformation
-> RawDependencyInformation
insertImport FilePathId
fId (ModuleImports -> Either ModuleParseError ModuleImports
forall a b. b -> Either a b
Right (ModuleImports -> Either ModuleParseError ModuleImports)
-> ModuleImports -> Either ModuleParseError ModuleImports
forall a b. (a -> b) -> a -> b
$ [(Located ModuleName, Maybe FilePathId)] -> ModuleImports
ModuleImports [(Located ModuleName, Maybe FilePathId)]
moduleImports')
FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
forall a.
a
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePathId
fId
checkAlreadyProcessed :: NormalizedFilePath -> RawDepM FilePathId -> RawDepM FilePathId
checkAlreadyProcessed :: NormalizedFilePath
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
checkAlreadyProcessed NormalizedFilePath
nfp StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
k = do
(RawDependencyInformation
rawDepInfo, IntMap ArtifactsLocation
_) <- StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
(RawDependencyInformation, IntMap ArtifactsLocation)
forall s (m :: * -> *). MonadState s m => m s
get
StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
-> (FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId)
-> Maybe FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
k FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
forall a.
a
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId (RawDependencyInformation -> PathIdMap
rawPathIdMap RawDependencyInformation
rawDepInfo) NormalizedFilePath
nfp)
modifyRawDepInfo :: (RawDependencyInformation -> RawDependencyInformation) -> RawDepM ()
modifyRawDepInfo :: (RawDependencyInformation -> RawDependencyInformation)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
modifyRawDepInfo RawDependencyInformation -> RawDependencyInformation
f = ((RawDependencyInformation, IntMap ArtifactsLocation)
-> (RawDependencyInformation, IntMap ArtifactsLocation))
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RawDependencyInformation -> RawDependencyInformation)
-> (RawDependencyInformation, IntMap ArtifactsLocation)
-> (RawDependencyInformation, IntMap ArtifactsLocation)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first RawDependencyInformation -> RawDependencyInformation
f)
addBootMap :: ArtifactsLocation -> FilePathId -> RawDepM ()
addBootMap :: ArtifactsLocation
-> FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
addBootMap ArtifactsLocation
al FilePathId
fId =
((RawDependencyInformation, IntMap ArtifactsLocation)
-> (RawDependencyInformation, IntMap ArtifactsLocation))
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(RawDependencyInformation
rd, IntMap ArtifactsLocation
ss) -> (RawDependencyInformation
rd, if ArtifactsLocation -> Bool
isBootLocation ArtifactsLocation
al
then Int
-> ArtifactsLocation
-> IntMap ArtifactsLocation
-> IntMap ArtifactsLocation
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (FilePathId -> Int
getFilePathId FilePathId
fId) ArtifactsLocation
al IntMap ArtifactsLocation
ss
else IntMap ArtifactsLocation
ss))
getFreshFid :: ArtifactsLocation -> RawDepM FilePathId
getFreshFid :: ArtifactsLocation
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
getFreshFid ArtifactsLocation
al = do
(RawDependencyInformation
rawDepInfo, IntMap ArtifactsLocation
ss) <- StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
(RawDependencyInformation, IntMap ArtifactsLocation)
forall s (m :: * -> *). MonadState s m => m s
get
let (FilePathId
fId, PathIdMap
path_map) = ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId ArtifactsLocation
al (RawDependencyInformation -> PathIdMap
rawPathIdMap RawDependencyInformation
rawDepInfo)
let rawDepInfo' :: RawDependencyInformation
rawDepInfo' = RawDependencyInformation
rawDepInfo { rawPathIdMap = path_map }
(RawDependencyInformation, IntMap ArtifactsLocation)
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RawDependencyInformation
rawDepInfo', IntMap ArtifactsLocation
ss)
FilePathId
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation)
Action
FilePathId
forall a.
a
-> StateT
(RawDependencyInformation, IntMap ArtifactsLocation) Action a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePathId
fId
splitImports :: [(Located ModuleName, Maybe ArtifactsLocation)]
-> ([Located ModuleName], [(Located ModuleName, ArtifactsLocation)])
splitImports :: [(Located ModuleName, Maybe ArtifactsLocation)]
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)])
splitImports = ((Located ModuleName, Maybe ArtifactsLocation)
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)])
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)]))
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)])
-> [(Located ModuleName, Maybe ArtifactsLocation)]
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Located ModuleName, Maybe ArtifactsLocation)
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)])
-> ([Located ModuleName],
[(Located ModuleName, ArtifactsLocation)])
forall {a} {b}. (a, Maybe b) -> ([a], [(a, b)]) -> ([a], [(a, b)])
splitImportsLoop ([],[])
splitImportsLoop :: (a, Maybe b) -> ([a], [(a, b)]) -> ([a], [(a, b)])
splitImportsLoop (a
imp, Maybe b
Nothing) ([a]
ns, [(a, b)]
ls) = (a
impa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ns, [(a, b)]
ls)
splitImportsLoop (a
imp, Just b
artifact) ([a]
ns, [(a, b)]
ls) = ([a]
ns, (a
imp,b
artifact) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
ls)
updateBootMap :: RawDependencyInformation
-> Int -> ArtifactsLocation -> BootIdMap -> BootIdMap
updateBootMap RawDependencyInformation
pm Int
boot_mod_id ArtifactsLocation{Bool
Maybe (GenModule Unit)
Maybe ModLocation
NormalizedFilePath
artifactFilePath :: ArtifactsLocation -> NormalizedFilePath
artifactFilePath :: NormalizedFilePath
artifactModLocation :: Maybe ModLocation
artifactIsSource :: Bool
artifactModule :: Maybe (GenModule Unit)
artifactModLocation :: ArtifactsLocation -> Maybe ModLocation
artifactIsSource :: ArtifactsLocation -> Bool
artifactModule :: ArtifactsLocation -> Maybe (GenModule Unit)
..} BootIdMap
bm =
if Bool -> Bool
not Bool
artifactIsSource
then
let msource_mod_id :: Maybe FilePathId
msource_mod_id = PathIdMap -> NormalizedFilePath -> Maybe FilePathId
lookupPathToId (RawDependencyInformation -> PathIdMap
rawPathIdMap RawDependencyInformation
pm) ([Char] -> NormalizedFilePath
toNormalizedFilePath' ([Char] -> NormalizedFilePath) -> [Char] -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ ShowS
dropBootSuffix ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
artifactFilePath)
in case Maybe FilePathId
msource_mod_id of
Just FilePathId
source_mod_id -> FilePathId -> FilePathId -> BootIdMap -> BootIdMap
insertBootId FilePathId
source_mod_id (Int -> FilePathId
FilePathId Int
boot_mod_id) BootIdMap
bm
Maybe FilePathId
Nothing -> BootIdMap
bm
else BootIdMap
bm
dropBootSuffix :: FilePath -> FilePath
dropBootSuffix :: ShowS
dropBootSuffix [Char]
hs_src = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length @[] [Char]
"-boot") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [Char]
hs_src
reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules ()
reportImportCyclesRule :: Recorder (WithPriority Log) -> Rules ()
reportImportCyclesRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> RuleBody ReportImportCycles () -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody ReportImportCycles () -> Rules ())
-> RuleBody ReportImportCycles () -> Rules ()
forall a b. (a -> b) -> a -> b
$ (ReportImportCycles
-> NormalizedFilePath -> Action (Maybe ByteString, IdeResult ()))
-> RuleBody ReportImportCycles ()
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
Rule ((ReportImportCycles
-> NormalizedFilePath -> Action (Maybe ByteString, IdeResult ()))
-> RuleBody ReportImportCycles ())
-> (ReportImportCycles
-> NormalizedFilePath -> Action (Maybe ByteString, IdeResult ()))
-> RuleBody ReportImportCycles ()
forall a b. (a -> b) -> a -> b
$ \ReportImportCycles
ReportImportCycles NormalizedFilePath
file -> ([FileDiagnostic] -> (Maybe ByteString, IdeResult ()))
-> Action [FileDiagnostic]
-> Action (Maybe ByteString, IdeResult ())
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[FileDiagnostic]
errs -> if [FileDiagnostic] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileDiagnostic]
errs then (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1",([], () -> Maybe ()
forall a. a -> Maybe a
Just ())) else (Maybe ByteString
forall a. Maybe a
Nothing, ([FileDiagnostic]
errs, Maybe ()
forall a. Maybe a
Nothing))) (Action [FileDiagnostic]
-> Action (Maybe ByteString, IdeResult ()))
-> Action [FileDiagnostic]
-> Action (Maybe ByteString, IdeResult ())
forall a b. (a -> b) -> a -> b
$ do
DependencyInformation{FilePathIdMap (NonEmpty NodeError)
IntMap IntSet
FilePathIdMap ShowableModule
BootIdMap
ModuleGraph
ShowableModuleEnv FilePathId
PathIdMap
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
depModules :: FilePathIdMap ShowableModule
depModuleDeps :: IntMap IntSet
depReverseModuleDeps :: IntMap IntSet
depPathIdMap :: PathIdMap
depBootMap :: BootIdMap
depModuleFiles :: ShowableModuleEnv FilePathId
depModuleGraph :: ModuleGraph
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depModules :: DependencyInformation -> FilePathIdMap ShowableModule
depModuleDeps :: DependencyInformation -> IntMap IntSet
depReverseModuleDeps :: DependencyInformation -> IntMap IntSet
depPathIdMap :: DependencyInformation -> PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depModuleFiles :: DependencyInformation -> ShowableModuleEnv FilePathId
depModuleGraph :: DependencyInformation -> ModuleGraph
..} <- GetModuleGraph -> Action DependencyInformation
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetModuleGraph
GetModuleGraph
case PathIdMap -> NormalizedFilePath -> Maybe FilePathId
pathToId PathIdMap
depPathIdMap NormalizedFilePath
file of
Maybe FilePathId
Nothing -> [FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just FilePathId
fileId ->
case Int
-> FilePathIdMap (NonEmpty NodeError) -> Maybe (NonEmpty NodeError)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (FilePathId -> Int
getFilePathId FilePathId
fileId) FilePathIdMap (NonEmpty NodeError)
depErrorNodes of
Maybe (NonEmpty NodeError)
Nothing -> [FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just NonEmpty NodeError
errs -> do
let cycles :: [(Located ModuleName, [FilePathId])]
cycles = (NodeError -> Maybe (Located ModuleName, [FilePathId]))
-> [NodeError] -> [(Located ModuleName, [FilePathId])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FilePathId -> NodeError -> Maybe (Located ModuleName, [FilePathId])
cycleErrorInFile FilePathId
fileId) (NonEmpty NodeError -> [NodeError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty NodeError
errs)
[(Located ModuleName, [FilePathId])]
-> ((Located ModuleName, [FilePathId]) -> Action FileDiagnostic)
-> Action [FileDiagnostic]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Located ModuleName, [FilePathId])]
cycles (((Located ModuleName, [FilePathId]) -> Action FileDiagnostic)
-> Action [FileDiagnostic])
-> ((Located ModuleName, [FilePathId]) -> Action FileDiagnostic)
-> Action [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ \(Located ModuleName
imp, [FilePathId]
files) -> do
[[Char]]
modNames <- [FilePathId] -> (FilePathId -> Action [Char]) -> Action [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePathId]
files ((FilePathId -> Action [Char]) -> Action [[Char]])
-> (FilePathId -> Action [Char]) -> Action [[Char]]
forall a b. (a -> b) -> a -> b
$
NormalizedFilePath -> Action [Char]
getModuleName (NormalizedFilePath -> Action [Char])
-> (FilePathId -> NormalizedFilePath)
-> FilePathId
-> Action [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap
FileDiagnostic -> Action FileDiagnostic
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileDiagnostic -> Action FileDiagnostic)
-> FileDiagnostic -> Action FileDiagnostic
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> [[Char]] -> FileDiagnostic
forall {a}. HasSrcSpan a => a -> [[Char]] -> FileDiagnostic
toDiag Located ModuleName
imp ([[Char]] -> FileDiagnostic) -> [[Char]] -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort [[Char]]
modNames
where cycleErrorInFile :: FilePathId -> NodeError -> Maybe (Located ModuleName, [FilePathId])
cycleErrorInFile FilePathId
f (PartOfCycle Located ModuleName
imp [FilePathId]
fs)
| FilePathId
f FilePathId -> [FilePathId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePathId]
fs = (Located ModuleName, [FilePathId])
-> Maybe (Located ModuleName, [FilePathId])
forall a. a -> Maybe a
Just (Located ModuleName
imp, [FilePathId]
fs)
cycleErrorInFile FilePathId
_ NodeError
_ = Maybe (Located ModuleName, [FilePathId])
forall a. Maybe a
Nothing
toDiag :: a -> [[Char]] -> FileDiagnostic
toDiag a
imp [[Char]]
mods = (NormalizedFilePath
fp , ShowDiagnostic
ShowDiag , ) (Diagnostic -> FileDiagnostic) -> Diagnostic -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ Diagnostic
{ $sel:_range:Diagnostic :: Range
_range = Range
rng
, $sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DiagnosticSeverity_Error
, $sel:_source:Diagnostic :: Maybe Text
_source = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Import cycle detection"
, $sel:_message:Diagnostic :: Text
_message = Text
"Cyclic module dependency between " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> Text
showCycle [[Char]]
mods
, $sel:_code:Diagnostic :: Maybe (Int32 |? Text)
_code = Maybe (Int32 |? Text)
forall a. Maybe a
Nothing
, $sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
_relatedInformation = Maybe [DiagnosticRelatedInformation]
forall a. Maybe a
Nothing
, $sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
_tags = Maybe [DiagnosticTag]
forall a. Maybe a
Nothing
, $sel:_codeDescription:Diagnostic :: Maybe CodeDescription
_codeDescription = Maybe CodeDescription
forall a. Maybe a
Nothing
, $sel:_data_:Diagnostic :: Maybe Value
_data_ = Maybe Value
forall a. Maybe a
Nothing
}
where rng :: Range
rng = Range -> Maybe Range -> Range
forall a. a -> Maybe a -> a
fromMaybe Range
noRange (Maybe Range -> Range) -> Maybe Range -> Range
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Range
srcSpanToRange (a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
imp)
fp :: NormalizedFilePath
fp = [Char] -> NormalizedFilePath
toNormalizedFilePath' ([Char] -> NormalizedFilePath) -> [Char] -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
noFilePath (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe [Char]
srcSpanToFilename (a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
imp)
getModuleName :: NormalizedFilePath -> Action [Char]
getModuleName NormalizedFilePath
file = do
ModSummary
ms <- ModSummaryResult -> ModSummary
msrModSummary (ModSummaryResult -> ModSummary)
-> Action ModSummaryResult -> Action ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
[Char] -> Action [Char]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName -> [Char]
moduleNameString (ModuleName -> [Char])
-> (ModSummary -> ModuleName) -> ModSummary -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (GenModule Unit -> ModuleName)
-> (ModSummary -> GenModule Unit) -> ModSummary -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> GenModule Unit
ms_mod (ModSummary -> [Char]) -> ModSummary -> [Char]
forall a b. (a -> b) -> a -> b
$ ModSummary
ms)
showCycle :: [[Char]] -> Text
showCycle [[Char]]
mods = Text -> [Text] -> Text
T.intercalate Text
", " (([Char] -> Text) -> [[Char]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Text
T.pack [[Char]]
mods)
getHieAstsRule :: Recorder (WithPriority Log) -> Rules ()
getHieAstsRule :: Recorder (WithPriority Log) -> Rules ()
getHieAstsRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GetHieAst
-> NormalizedFilePath -> Action (IdeResult HieAstResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetHieAst
-> NormalizedFilePath -> Action (IdeResult HieAstResult))
-> Rules ())
-> (GetHieAst
-> NormalizedFilePath -> Action (IdeResult HieAstResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetHieAst
GetHieAst NormalizedFilePath
f -> do
TcModuleResult
tmr <- TypeCheck -> NormalizedFilePath -> Action TcModuleResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ TypeCheck
TypeCheck NormalizedFilePath
f
HscEnv
hsc <- HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> HscEnv) -> Action HscEnvEq -> Action HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
f
NormalizedFilePath
-> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
getHieAstRuleDefinition NormalizedFilePath
f HscEnv
hsc TcModuleResult
tmr
persistentHieFileRule :: Recorder (WithPriority Log) -> Rules ()
persistentHieFileRule :: Recorder (WithPriority Log) -> Rules ()
persistentHieFileRule Recorder (WithPriority Log)
recorder = GetHieAst
-> (NormalizedFilePath
-> IdeAction (Maybe (HieAstResult, PositionDelta, Maybe Int32)))
-> Rules ()
forall k v.
IdeRule k v =>
k
-> (NormalizedFilePath
-> IdeAction (Maybe (v, PositionDelta, Maybe Int32)))
-> Rules ()
addPersistentRule GetHieAst
GetHieAst ((NormalizedFilePath
-> IdeAction (Maybe (HieAstResult, PositionDelta, Maybe Int32)))
-> Rules ())
-> (NormalizedFilePath
-> IdeAction (Maybe (HieAstResult, PositionDelta, Maybe Int32)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> MaybeT IdeAction (HieAstResult, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (HieAstResult, PositionDelta, Maybe Int32))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IdeAction (HieAstResult, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (HieAstResult, PositionDelta, Maybe Int32)))
-> MaybeT IdeAction (HieAstResult, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (HieAstResult, PositionDelta, Maybe Int32))
forall a b. (a -> b) -> a -> b
$ do
HieFile
res <- Recorder (WithPriority Log)
-> NormalizedFilePath -> MaybeT IdeAction HieFile
readHieFileForSrcFromDisk Recorder (WithPriority Log)
recorder NormalizedFilePath
file
TVar VFS
vfsRef <- (ShakeExtras -> TVar VFS) -> MaybeT IdeAction (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ShakeExtras -> TVar VFS
vfsVar
Map NormalizedUri VirtualFile
vfsData <- IO (Map NormalizedUri VirtualFile)
-> MaybeT IdeAction (Map NormalizedUri VirtualFile)
forall a. IO a -> MaybeT IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map NormalizedUri VirtualFile)
-> MaybeT IdeAction (Map NormalizedUri VirtualFile))
-> IO (Map NormalizedUri VirtualFile)
-> MaybeT IdeAction (Map NormalizedUri VirtualFile)
forall a b. (a -> b) -> a -> b
$ VFS -> Map NormalizedUri VirtualFile
_vfsMap (VFS -> Map NormalizedUri VirtualFile)
-> IO VFS -> IO (Map NormalizedUri VirtualFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar VFS -> IO VFS
forall a. TVar a -> IO a
readTVarIO TVar VFS
vfsRef
(Text
currentSource, Maybe Int32
ver) <- IO (Text, Maybe Int32) -> MaybeT IdeAction (Text, Maybe Int32)
forall a. IO a -> MaybeT IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, Maybe Int32) -> MaybeT IdeAction (Text, Maybe Int32))
-> IO (Text, Maybe Int32) -> MaybeT IdeAction (Text, Maybe Int32)
forall a b. (a -> b) -> a -> b
$ case NormalizedUri -> Map NormalizedUri VirtualFile -> Maybe VirtualFile
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (NormalizedFilePath -> NormalizedUri
filePathToUri' NormalizedFilePath
file) Map NormalizedUri VirtualFile
vfsData of
Maybe VirtualFile
Nothing -> (,Maybe Int32
forall a. Maybe a
Nothing) (Text -> (Text, Maybe Int32))
-> (ByteString -> Text) -> ByteString -> (Text, Maybe Int32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> (Text, Maybe Int32))
-> IO ByteString -> IO (Text, Maybe Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
BS.readFile (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file)
Just VirtualFile
vf -> (Text, Maybe Int32) -> IO (Text, Maybe Int32)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VirtualFile -> Text
virtualFileText VirtualFile
vf, Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Int32 -> Maybe Int32) -> Int32 -> Maybe Int32
forall a b. (a -> b) -> a -> b
$ VirtualFile -> Int32
virtualFileVersion VirtualFile
vf)
let refmap :: RefMap Int
refmap = Map HiePath (HieAST Int) -> RefMap Int
forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
Compat.generateReferencesMap (Map HiePath (HieAST Int) -> RefMap Int)
-> (HieFile -> Map HiePath (HieAST Int)) -> HieFile -> RefMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieASTs Int -> Map HiePath (HieAST Int)
forall a. HieASTs a -> Map HiePath (HieAST a)
Compat.getAsts (HieASTs Int -> Map HiePath (HieAST Int))
-> (HieFile -> HieASTs Int) -> HieFile -> Map HiePath (HieAST Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> HieASTs Int
Compat.hie_asts (HieFile -> RefMap Int) -> HieFile -> RefMap Int
forall a b. (a -> b) -> a -> b
$ HieFile
res
del :: PositionDelta
del = Text -> Text -> PositionDelta
deltaFromDiff (ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
Compat.hie_hs_src HieFile
res) Text
currentSource
(HieAstResult, PositionDelta, Maybe Int32)
-> MaybeT IdeAction (HieAstResult, PositionDelta, Maybe Int32)
forall a. a -> MaybeT IdeAction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenModule Unit
-> HieASTs Int
-> RefMap Int
-> Map Name [RealSrcSpan]
-> HieKind Int
-> HieAstResult
forall a.
Typeable a =>
GenModule Unit
-> HieASTs a
-> RefMap a
-> Map Name [RealSrcSpan]
-> HieKind a
-> HieAstResult
HAR (HieFile -> GenModule Unit
Compat.hie_module HieFile
res) (HieFile -> HieASTs Int
Compat.hie_asts HieFile
res) RefMap Int
refmap Map Name [RealSrcSpan]
forall a. Monoid a => a
mempty (HieFile -> HieKind Int
HieFromDisk HieFile
res),PositionDelta
del,Maybe Int32
ver)
getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
getHieAstRuleDefinition :: NormalizedFilePath
-> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
getHieAstRuleDefinition NormalizedFilePath
f HscEnv
hsc TcModuleResult
tmr = do
([FileDiagnostic]
diags, Maybe (HieASTs Type)
masts) <- IO ([FileDiagnostic], Maybe (HieASTs Type))
-> Action ([FileDiagnostic], Maybe (HieASTs Type))
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([FileDiagnostic], Maybe (HieASTs Type))
-> Action ([FileDiagnostic], Maybe (HieASTs Type)))
-> IO ([FileDiagnostic], Maybe (HieASTs Type))
-> Action ([FileDiagnostic], Maybe (HieASTs Type))
forall a b. (a -> b) -> a -> b
$ HscEnv
-> TcModuleResult -> IO ([FileDiagnostic], Maybe (HieASTs Type))
generateHieAsts HscEnv
hsc TcModuleResult
tmr
ShakeExtras
se <- Action ShakeExtras
getShakeExtras
IsFileOfInterestResult
isFoi <- IsFileOfInterest
-> NormalizedFilePath -> Action IsFileOfInterestResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ IsFileOfInterest
IsFileOfInterest NormalizedFilePath
f
[FileDiagnostic]
diagsWrite <- case IsFileOfInterestResult
isFoi of
IsFOI Modified{firstOpen :: FileOfInterestStatus -> Bool
firstOpen = Bool
False} -> do
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IdeTesting -> Bool
forall a b. Coercible a b => a -> b
coerce (IdeTesting -> Bool) -> IdeTesting -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IdeTesting
ideTesting ShakeExtras
se) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Maybe (LanguageContextEnv Config) -> LspT Config IO () -> IO ()
forall (m :: * -> *) c.
Applicative m =>
Maybe (LanguageContextEnv c) -> LspT c m () -> m ()
mRunLspT (ShakeExtras -> Maybe (LanguageContextEnv Config)
lspEnv ShakeExtras
se) (LspT Config IO () -> IO ()) -> LspT Config IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
SServerMethod ('Method_CustomMethod "ghcide/reference/ready")
-> MessageParams ('Method_CustomMethod "ghcide/reference/ready")
-> LspT Config IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification (Proxy "ghcide/reference/ready"
-> SServerMethod ('Method_CustomMethod "ghcide/reference/ready")
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"ghcide/reference/ready")) (MessageParams ('Method_CustomMethod "ghcide/reference/ready")
-> LspT Config IO ())
-> MessageParams ('Method_CustomMethod "ghcide/reference/ready")
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
f
[FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
IsFileOfInterestResult
_ | Just HieASTs Type
asts <- Maybe (HieASTs Type)
masts -> do
ByteString
source <- NormalizedFilePath -> Action ByteString
getSourceFileSource NormalizedFilePath
f
let exports :: [AvailInfo]
exports = TcGblEnv -> [AvailInfo]
tcg_exports (TcGblEnv -> [AvailInfo]) -> TcGblEnv -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
tmr
modSummary :: ModSummary
modSummary = TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr
IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FileDiagnostic] -> Action [FileDiagnostic])
-> IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ HscEnv
-> ShakeExtras
-> ModSummary
-> NormalizedFilePath
-> [AvailInfo]
-> HieASTs Type
-> ByteString
-> IO [FileDiagnostic]
writeAndIndexHieFile HscEnv
hsc ShakeExtras
se ModSummary
modSummary NormalizedFilePath
f [AvailInfo]
exports HieASTs Type
asts ByteString
source
IsFileOfInterestResult
_ -> [FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
let refmap :: Maybe (RefMap Type)
refmap = Map HiePath (HieAST Type) -> RefMap Type
forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
Compat.generateReferencesMap (Map HiePath (HieAST Type) -> RefMap Type)
-> (HieASTs Type -> Map HiePath (HieAST Type))
-> HieASTs Type
-> RefMap Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieASTs Type -> Map HiePath (HieAST Type)
forall a. HieASTs a -> Map HiePath (HieAST a)
Compat.getAsts (HieASTs Type -> RefMap Type)
-> Maybe (HieASTs Type) -> Maybe (RefMap Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HieASTs Type)
masts
typemap :: Maybe (Map Name [RealSrcSpan])
typemap = Map HiePath (HieAST Type) -> Map Name [RealSrcSpan]
forall (f :: * -> *).
Foldable f =>
f (HieAST Type) -> Map Name [RealSrcSpan]
AtPoint.computeTypeReferences (Map HiePath (HieAST Type) -> Map Name [RealSrcSpan])
-> (HieASTs Type -> Map HiePath (HieAST Type))
-> HieASTs Type
-> Map Name [RealSrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieASTs Type -> Map HiePath (HieAST Type)
forall a. HieASTs a -> Map HiePath (HieAST a)
Compat.getAsts (HieASTs Type -> Map Name [RealSrcSpan])
-> Maybe (HieASTs Type) -> Maybe (Map Name [RealSrcSpan])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HieASTs Type)
masts
IdeResult HieAstResult -> Action (IdeResult HieAstResult)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
diagsWrite, GenModule Unit
-> HieASTs Type
-> RefMap Type
-> Map Name [RealSrcSpan]
-> HieKind Type
-> HieAstResult
forall a.
Typeable a =>
GenModule Unit
-> HieASTs a
-> RefMap a
-> Map Name [RealSrcSpan]
-> HieKind a
-> HieAstResult
HAR (ModSummary -> GenModule Unit
ms_mod (ModSummary -> GenModule Unit) -> ModSummary -> GenModule Unit
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr) (HieASTs Type
-> RefMap Type
-> Map Name [RealSrcSpan]
-> HieKind Type
-> HieAstResult)
-> Maybe (HieASTs Type)
-> Maybe
(RefMap Type
-> Map Name [RealSrcSpan] -> HieKind Type -> HieAstResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HieASTs Type)
masts Maybe
(RefMap Type
-> Map Name [RealSrcSpan] -> HieKind Type -> HieAstResult)
-> Maybe (RefMap Type)
-> Maybe (Map Name [RealSrcSpan] -> HieKind Type -> HieAstResult)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (RefMap Type)
refmap Maybe (Map Name [RealSrcSpan] -> HieKind Type -> HieAstResult)
-> Maybe (Map Name [RealSrcSpan])
-> Maybe (HieKind Type -> HieAstResult)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Map Name [RealSrcSpan])
typemap Maybe (HieKind Type -> HieAstResult)
-> Maybe (HieKind Type) -> Maybe HieAstResult
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HieKind Type -> Maybe (HieKind Type)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HieKind Type
HieFresh)
getImportMapRule :: Recorder (WithPriority Log) -> Rules ()
getImportMapRule :: Recorder (WithPriority Log) -> Rules ()
getImportMapRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (GetImportMap
-> NormalizedFilePath -> Action (IdeResult ImportMap))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetImportMap
-> NormalizedFilePath -> Action (IdeResult ImportMap))
-> Rules ())
-> (GetImportMap
-> NormalizedFilePath -> Action (IdeResult ImportMap))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetImportMap
GetImportMap NormalizedFilePath
f -> do
Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
im <- GetLocatedImports
-> NormalizedFilePath
-> Action (Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetLocatedImports
GetLocatedImports NormalizedFilePath
f
let mkImports :: [(GenLocated l k, Maybe ArtifactsLocation)]
-> Map k NormalizedFilePath
mkImports [(GenLocated l k, Maybe ArtifactsLocation)]
fileImports = [(k, NormalizedFilePath)] -> Map k NormalizedFilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, NormalizedFilePath)] -> Map k NormalizedFilePath)
-> [(k, NormalizedFilePath)] -> Map k NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ ((GenLocated l k, Maybe ArtifactsLocation)
-> Maybe (k, NormalizedFilePath))
-> [(GenLocated l k, Maybe ArtifactsLocation)]
-> [(k, NormalizedFilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(GenLocated l k
m, Maybe ArtifactsLocation
mfp) -> (GenLocated l k -> k
forall l e. GenLocated l e -> e
unLoc GenLocated l k
m,) (NormalizedFilePath -> (k, NormalizedFilePath))
-> (ArtifactsLocation -> NormalizedFilePath)
-> ArtifactsLocation
-> (k, NormalizedFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtifactsLocation -> NormalizedFilePath
artifactFilePath (ArtifactsLocation -> (k, NormalizedFilePath))
-> Maybe ArtifactsLocation -> Maybe (k, NormalizedFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ArtifactsLocation
mfp) [(GenLocated l k, Maybe ArtifactsLocation)]
fileImports
IdeResult ImportMap -> Action (IdeResult ImportMap)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Map ModuleName NormalizedFilePath -> ImportMap
ImportMap (Map ModuleName NormalizedFilePath -> ImportMap)
-> ([(Located ModuleName, Maybe ArtifactsLocation)]
-> Map ModuleName NormalizedFilePath)
-> [(Located ModuleName, Maybe ArtifactsLocation)]
-> ImportMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Located ModuleName, Maybe ArtifactsLocation)]
-> Map ModuleName NormalizedFilePath
forall {k} {l}.
Ord k =>
[(GenLocated l k, Maybe ArtifactsLocation)]
-> Map k NormalizedFilePath
mkImports ([(Located ModuleName, Maybe ArtifactsLocation)] -> ImportMap)
-> Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
-> Maybe ImportMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
im)
persistentImportMapRule :: Rules ()
persistentImportMapRule :: Rules ()
persistentImportMapRule = GetImportMap
-> (NormalizedFilePath
-> IdeAction (Maybe (ImportMap, PositionDelta, Maybe Int32)))
-> Rules ()
forall k v.
IdeRule k v =>
k
-> (NormalizedFilePath
-> IdeAction (Maybe (v, PositionDelta, Maybe Int32)))
-> Rules ()
addPersistentRule GetImportMap
GetImportMap ((NormalizedFilePath
-> IdeAction (Maybe (ImportMap, PositionDelta, Maybe Int32)))
-> Rules ())
-> (NormalizedFilePath
-> IdeAction (Maybe (ImportMap, PositionDelta, Maybe Int32)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
_ -> Maybe (ImportMap, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (ImportMap, PositionDelta, Maybe Int32))
forall a. a -> IdeAction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ImportMap, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (ImportMap, PositionDelta, Maybe Int32)))
-> Maybe (ImportMap, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (ImportMap, PositionDelta, Maybe Int32))
forall a b. (a -> b) -> a -> b
$ (ImportMap, PositionDelta, Maybe Int32)
-> Maybe (ImportMap, PositionDelta, Maybe Int32)
forall a. a -> Maybe a
Just (Map ModuleName NormalizedFilePath -> ImportMap
ImportMap Map ModuleName NormalizedFilePath
forall a. Monoid a => a
mempty, PositionDelta
idDelta, Maybe Int32
forall a. Maybe a
Nothing)
getBindingsRule :: Recorder (WithPriority Log) -> Rules ()
getBindingsRule :: Recorder (WithPriority Log) -> Rules ()
getBindingsRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GetBindings
-> NormalizedFilePath -> Action (IdeResult Bindings))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetBindings -> NormalizedFilePath -> Action (IdeResult Bindings))
-> Rules ())
-> (GetBindings
-> NormalizedFilePath -> Action (IdeResult Bindings))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetBindings
GetBindings NormalizedFilePath
f -> do
HAR{hieKind :: ()
hieKind=HieKind a
kind, refMap :: ()
refMap=RefMap a
rm} <- GetHieAst -> NormalizedFilePath -> Action HieAstResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetHieAst
GetHieAst NormalizedFilePath
f
case HieKind a
kind of
HieKind a
HieFresh -> IdeResult Bindings -> Action (IdeResult Bindings)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Bindings -> Maybe Bindings
forall a. a -> Maybe a
Just (Bindings -> Maybe Bindings) -> Bindings -> Maybe Bindings
forall a b. (a -> b) -> a -> b
$ RefMap Type -> Bindings
bindings RefMap a
RefMap Type
rm)
HieFromDisk HieFile
_ -> IdeResult Bindings -> Action (IdeResult Bindings)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Maybe Bindings
forall a. Maybe a
Nothing)
getDocMapRule :: Recorder (WithPriority Log) -> Rules ()
getDocMapRule :: Recorder (WithPriority Log) -> Rules ()
getDocMapRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GetDocMap
-> NormalizedFilePath -> Action (IdeResult DocAndTyThingMap))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetDocMap
-> NormalizedFilePath -> Action (IdeResult DocAndTyThingMap))
-> Rules ())
-> (GetDocMap
-> NormalizedFilePath -> Action (IdeResult DocAndTyThingMap))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetDocMap
GetDocMap NormalizedFilePath
file -> do
(TcModuleResult -> TcGblEnv
tmrTypechecked -> TcGblEnv
tc, PositionMapping
_) <- TypeCheck
-> NormalizedFilePath -> Action (TcModuleResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ TypeCheck
TypeCheck NormalizedFilePath
file
(HscEnvEq -> HscEnv
hscEnv -> HscEnv
hsc, PositionMapping
_) <- GhcSessionDeps
-> NormalizedFilePath -> Action (HscEnvEq, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file
(HAR{refMap :: ()
refMap=RefMap a
rf}, PositionMapping
_) <- GetHieAst
-> NormalizedFilePath -> Action (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GetHieAst
GetHieAst NormalizedFilePath
file
DocAndTyThingMap
dkMap <- IO DocAndTyThingMap -> Action DocAndTyThingMap
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DocAndTyThingMap -> Action DocAndTyThingMap)
-> IO DocAndTyThingMap -> Action DocAndTyThingMap
forall a b. (a -> b) -> a -> b
$ HscEnv -> RefMap a -> TcGblEnv -> IO DocAndTyThingMap
forall a. HscEnv -> RefMap a -> TcGblEnv -> IO DocAndTyThingMap
mkDocMap HscEnv
hsc RefMap a
rf TcGblEnv
tc
IdeResult DocAndTyThingMap -> Action (IdeResult DocAndTyThingMap)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],DocAndTyThingMap -> Maybe DocAndTyThingMap
forall a. a -> Maybe a
Just DocAndTyThingMap
dkMap)
persistentDocMapRule :: Rules ()
persistentDocMapRule :: Rules ()
persistentDocMapRule = GetDocMap
-> (NormalizedFilePath
-> IdeAction
(Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)))
-> Rules ()
forall k v.
IdeRule k v =>
k
-> (NormalizedFilePath
-> IdeAction (Maybe (v, PositionDelta, Maybe Int32)))
-> Rules ()
addPersistentRule GetDocMap
GetDocMap ((NormalizedFilePath
-> IdeAction
(Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)))
-> Rules ())
-> (NormalizedFilePath
-> IdeAction
(Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
_ -> Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32))
forall a. a -> IdeAction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)
-> IdeAction
(Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)))
-> Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)
-> IdeAction (Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32))
forall a b. (a -> b) -> a -> b
$ (DocAndTyThingMap, PositionDelta, Maybe Int32)
-> Maybe (DocAndTyThingMap, PositionDelta, Maybe Int32)
forall a. a -> Maybe a
Just (DocMap -> TyThingMap -> DocAndTyThingMap
DKMap DocMap
forall a. Monoid a => a
mempty TyThingMap
forall a. Monoid a => a
mempty, PositionDelta
idDelta, Maybe Int32
forall a. Maybe a
Nothing)
readHieFileForSrcFromDisk :: Recorder (WithPriority Log) -> NormalizedFilePath -> MaybeT IdeAction Compat.HieFile
readHieFileForSrcFromDisk :: Recorder (WithPriority Log)
-> NormalizedFilePath -> MaybeT IdeAction HieFile
readHieFileForSrcFromDisk Recorder (WithPriority Log)
recorder NormalizedFilePath
file = do
ShakeExtras{WithHieDb
withHieDb :: WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb} <- MaybeT IdeAction ShakeExtras
forall r (m :: * -> *). MonadReader r m => m r
ask
HieModuleRow
row <- IdeAction (Maybe HieModuleRow) -> MaybeT IdeAction HieModuleRow
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe HieModuleRow) -> MaybeT IdeAction HieModuleRow)
-> IdeAction (Maybe HieModuleRow) -> MaybeT IdeAction HieModuleRow
forall a b. (a -> b) -> a -> b
$ IO (Maybe HieModuleRow) -> IdeAction (Maybe HieModuleRow)
forall a. IO a -> IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe HieModuleRow) -> IdeAction (Maybe HieModuleRow))
-> IO (Maybe HieModuleRow) -> IdeAction (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ (HieDb -> IO (Maybe HieModuleRow)) -> IO (Maybe HieModuleRow)
WithHieDb
withHieDb (\HieDb
hieDb -> HieDb -> [Char] -> IO (Maybe HieModuleRow)
HieDb.lookupHieFileFromSource HieDb
hieDb ([Char] -> IO (Maybe HieModuleRow))
-> [Char] -> IO (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file)
let hie_loc :: [Char]
hie_loc = HieModuleRow -> [Char]
HieDb.hieModuleHieFile HieModuleRow
row
IO () -> MaybeT IdeAction ()
forall a. IO a -> MaybeT IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IdeAction ()) -> IO () -> MaybeT IdeAction ()
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Logger.Debug (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Log
LogLoadingHieFile NormalizedFilePath
file
ExceptT SomeException IdeAction HieFile -> MaybeT IdeAction HieFile
forall (m :: * -> *) e a. Functor m => ExceptT e m a -> MaybeT m a
exceptToMaybeT (ExceptT SomeException IdeAction HieFile
-> MaybeT IdeAction HieFile)
-> ExceptT SomeException IdeAction HieFile
-> MaybeT IdeAction HieFile
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log)
-> [Char] -> ExceptT SomeException IdeAction HieFile
readHieFileFromDisk Recorder (WithPriority Log)
recorder [Char]
hie_loc
readHieFileFromDisk :: Recorder (WithPriority Log) -> FilePath -> ExceptT SomeException IdeAction Compat.HieFile
readHieFileFromDisk :: Recorder (WithPriority Log)
-> [Char] -> ExceptT SomeException IdeAction HieFile
readHieFileFromDisk Recorder (WithPriority Log)
recorder [Char]
hie_loc = do
NameCache
nc <- (ShakeExtras -> NameCache)
-> ExceptT SomeException IdeAction NameCache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ShakeExtras -> NameCache
ideNc
Either SomeException HieFile
res <- IO (Either SomeException HieFile)
-> ExceptT SomeException IdeAction (Either SomeException HieFile)
forall a. IO a -> ExceptT SomeException IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException HieFile)
-> ExceptT SomeException IdeAction (Either SomeException HieFile))
-> IO (Either SomeException HieFile)
-> ExceptT SomeException IdeAction (Either SomeException HieFile)
forall a b. (a -> b) -> a -> b
$ IO HieFile -> IO (Either SomeException HieFile)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny (IO HieFile -> IO (Either SomeException HieFile))
-> IO HieFile -> IO (Either SomeException HieFile)
forall a b. (a -> b) -> a -> b
$ NameCache -> [Char] -> IO HieFile
loadHieFile (NameCache -> NameCache
mkUpdater NameCache
nc) [Char]
hie_loc
case Either SomeException HieFile
res of
Left SomeException
e -> IO () -> ExceptT SomeException IdeAction ()
forall a. IO a -> ExceptT SomeException IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SomeException IdeAction ())
-> IO () -> ExceptT SomeException IdeAction ()
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Logger.Debug (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> SomeException -> Log
LogLoadingHieFileFail [Char]
hie_loc SomeException
e
Right HieFile
_ -> IO () -> ExceptT SomeException IdeAction ()
forall a. IO a -> ExceptT SomeException IdeAction a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SomeException IdeAction ())
-> IO () -> ExceptT SomeException IdeAction ()
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Logger.Debug (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Log
LogLoadingHieFileSuccess [Char]
hie_loc
Either SomeException HieFile
-> ExceptT SomeException IdeAction HieFile
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except Either SomeException HieFile
res
typeCheckRule :: Recorder (WithPriority Log) -> Rules ()
typeCheckRule :: Recorder (WithPriority Log) -> Rules ()
typeCheckRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (TypeCheck
-> NormalizedFilePath -> Action (IdeResult TcModuleResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((TypeCheck
-> NormalizedFilePath -> Action (IdeResult TcModuleResult))
-> Rules ())
-> (TypeCheck
-> NormalizedFilePath -> Action (IdeResult TcModuleResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \TypeCheck
TypeCheck NormalizedFilePath
file -> do
ParsedModule
pm <- GetParsedModule -> NormalizedFilePath -> Action ParsedModule
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetParsedModule
GetParsedModule NormalizedFilePath
file
HscEnv
hsc <- HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> HscEnv) -> Action HscEnvEq -> Action HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file
IsFileOfInterestResult
foi <- IsFileOfInterest
-> NormalizedFilePath -> Action IsFileOfInterestResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ IsFileOfInterest
IsFileOfInterest NormalizedFilePath
file
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsFileOfInterestResult
foi IsFileOfInterestResult -> IsFileOfInterestResult -> Bool
forall a. Eq a => a -> a -> Bool
== IsFileOfInterestResult
NotFOI) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
Recorder (WithPriority Log) -> Priority -> Log -> Action ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Logger.Warning (Log -> Action ()) -> Log -> Action ()
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Log
LogTypecheckedFOI NormalizedFilePath
file
HscEnv -> ParsedModule -> Action (IdeResult TcModuleResult)
typeCheckRuleDefinition HscEnv
hsc ParsedModule
pm
knownFilesRule :: Recorder (WithPriority Log) -> Rules ()
knownFilesRule :: Recorder (WithPriority Log) -> Rules ()
knownFilesRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (GetKnownTargets -> Action (ByteString, KnownTargets))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetKnownTargets -> Action (ByteString, KnownTargets))
-> Rules ())
-> (GetKnownTargets -> Action (ByteString, KnownTargets))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetKnownTargets
GetKnownTargets -> do
Action ()
alwaysRerun
Hashed KnownTargets
fs <- Action (Hashed KnownTargets)
knownTargets
(ByteString, KnownTargets) -> Action (ByteString, KnownTargets)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ Hashed KnownTargets -> Int
forall a. Hashable a => a -> Int
hash Hashed KnownTargets
fs, Hashed KnownTargets -> KnownTargets
forall a. Hashed a -> a
unhashed Hashed KnownTargets
fs)
getModuleGraphRule :: Recorder (WithPriority Log) -> Rules ()
getModuleGraphRule :: Recorder (WithPriority Log) -> Rules ()
getModuleGraphRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (GetModuleGraph -> Action (ByteString, DependencyInformation))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetModuleGraph -> Action (ByteString, DependencyInformation))
-> Rules ())
-> (GetModuleGraph -> Action (ByteString, DependencyInformation))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetModuleGraph
GetModuleGraph -> do
HashSet NormalizedFilePath
fs <- KnownTargets -> HashSet NormalizedFilePath
toKnownFiles (KnownTargets -> HashSet NormalizedFilePath)
-> Action KnownTargets -> Action (HashSet NormalizedFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetKnownTargets -> Action KnownTargets
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetKnownTargets
GetKnownTargets
[NormalizedFilePath] -> Action (ByteString, DependencyInformation)
dependencyInfoForFiles (HashSet NormalizedFilePath -> [NormalizedFilePath]
forall a. HashSet a -> [a]
HashSet.toList HashSet NormalizedFilePath
fs)
dependencyInfoForFiles :: [NormalizedFilePath] -> Action (BS.ByteString, DependencyInformation)
dependencyInfoForFiles :: [NormalizedFilePath] -> Action (ByteString, DependencyInformation)
dependencyInfoForFiles [NormalizedFilePath]
fs = do
(RawDependencyInformation
rawDepInfo, BootIdMap
bm) <- [NormalizedFilePath]
-> Action (RawDependencyInformation, BootIdMap)
rawDependencyInformation [NormalizedFilePath]
fs
let ([NormalizedFilePath]
all_fs, [FilePathId]
_all_ids) = [(NormalizedFilePath, FilePathId)]
-> ([NormalizedFilePath], [FilePathId])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(NormalizedFilePath, FilePathId)]
-> ([NormalizedFilePath], [FilePathId]))
-> [(NormalizedFilePath, FilePathId)]
-> ([NormalizedFilePath], [FilePathId])
forall a b. (a -> b) -> a -> b
$ HashMap NormalizedFilePath FilePathId
-> [(NormalizedFilePath, FilePathId)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap NormalizedFilePath FilePathId
-> [(NormalizedFilePath, FilePathId)])
-> HashMap NormalizedFilePath FilePathId
-> [(NormalizedFilePath, FilePathId)]
forall a b. (a -> b) -> a -> b
$ PathIdMap -> HashMap NormalizedFilePath FilePathId
pathToIdMap (PathIdMap -> HashMap NormalizedFilePath FilePathId)
-> PathIdMap -> HashMap NormalizedFilePath FilePathId
forall a b. (a -> b) -> a -> b
$ RawDependencyInformation -> PathIdMap
rawPathIdMap RawDependencyInformation
rawDepInfo
[Maybe ModSummaryResult]
msrs <- GetModSummaryWithoutTimestamps
-> [NormalizedFilePath] -> Action [Maybe ModSummaryResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps [NormalizedFilePath]
all_fs
let mss :: [Maybe ModSummary]
mss = (Maybe ModSummaryResult -> Maybe ModSummary)
-> [Maybe ModSummaryResult] -> [Maybe ModSummary]
forall a b. (a -> b) -> [a] -> [b]
map ((ModSummaryResult -> ModSummary)
-> Maybe ModSummaryResult -> Maybe ModSummary
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModSummaryResult -> ModSummary
msrModSummary) [Maybe ModSummaryResult]
msrs
#if MIN_VERSION_ghc(9,3,0)
let deps :: [Maybe (Either ModuleParseError ModuleImports)]
deps = (FilePathId -> Maybe (Either ModuleParseError ModuleImports))
-> [FilePathId] -> [Maybe (Either ModuleParseError ModuleImports)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePathId
i -> Int
-> FilePathIdMap (Either ModuleParseError ModuleImports)
-> Maybe (Either ModuleParseError ModuleImports)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (FilePathId -> Int
getFilePathId FilePathId
i) (RawDependencyInformation
-> FilePathIdMap (Either ModuleParseError ModuleImports)
rawImports RawDependencyInformation
rawDepInfo)) [FilePathId]
_all_ids
nodeKeys :: IntMap NodeKey
nodeKeys = [(Int, NodeKey)] -> IntMap NodeKey
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, NodeKey)] -> IntMap NodeKey)
-> [(Int, NodeKey)] -> IntMap NodeKey
forall a b. (a -> b) -> a -> b
$ [Maybe (Int, NodeKey)] -> [(Int, NodeKey)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int, NodeKey)] -> [(Int, NodeKey)])
-> [Maybe (Int, NodeKey)] -> [(Int, NodeKey)]
forall a b. (a -> b) -> a -> b
$ (FilePathId -> Maybe ModSummary -> Maybe (Int, NodeKey))
-> [FilePathId] -> [Maybe ModSummary] -> [Maybe (Int, NodeKey)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\FilePathId
fi Maybe ModSummary
mms -> (FilePathId -> Int
getFilePathId FilePathId
fi,) (NodeKey -> (Int, NodeKey))
-> (ModSummary -> NodeKey) -> ModSummary -> (Int, NodeKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModNodeKeyWithUid -> NodeKey)
-> (ModSummary -> ModNodeKeyWithUid) -> ModSummary -> NodeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> ModNodeKeyWithUid
msKey (ModSummary -> (Int, NodeKey))
-> Maybe ModSummary -> Maybe (Int, NodeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModSummary
mms) [FilePathId]
_all_ids [Maybe ModSummary]
mss
mns :: [ModuleGraphNode]
mns = [Maybe ModuleGraphNode] -> [ModuleGraphNode]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ModuleGraphNode] -> [ModuleGraphNode])
-> [Maybe ModuleGraphNode] -> [ModuleGraphNode]
forall a b. (a -> b) -> a -> b
$ (Maybe ModSummary
-> Maybe (Either ModuleParseError ModuleImports)
-> Maybe ModuleGraphNode)
-> [Maybe ModSummary]
-> [Maybe (Either ModuleParseError ModuleImports)]
-> [Maybe ModuleGraphNode]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Maybe ModSummary
-> Maybe (Either ModuleParseError ModuleImports)
-> Maybe ModuleGraphNode
go [Maybe ModSummary]
mss [Maybe (Either ModuleParseError ModuleImports)]
deps
go :: Maybe ModSummary
-> Maybe (Either ModuleParseError ModuleImports)
-> Maybe ModuleGraphNode
go (Just ModSummary
ms) (Just (Right (ModuleImports [(Located ModuleName, Maybe FilePathId)]
xs))) = ModuleGraphNode -> Maybe ModuleGraphNode
forall a. a -> Maybe a
Just (ModuleGraphNode -> Maybe ModuleGraphNode)
-> ModuleGraphNode -> Maybe ModuleGraphNode
forall a b. (a -> b) -> a -> b
$ [NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
this_dep_keys ModSummary
ms
where this_dep_ids :: [FilePathId]
this_dep_ids = ((Located ModuleName, Maybe FilePathId) -> Maybe FilePathId)
-> [(Located ModuleName, Maybe FilePathId)] -> [FilePathId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Located ModuleName, Maybe FilePathId) -> Maybe FilePathId
forall a b. (a, b) -> b
snd [(Located ModuleName, Maybe FilePathId)]
xs
this_dep_keys :: [NodeKey]
this_dep_keys = (FilePathId -> Maybe NodeKey) -> [FilePathId] -> [NodeKey]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\FilePathId
fi -> Int -> IntMap NodeKey -> Maybe NodeKey
forall a. Int -> IntMap a -> Maybe a
IM.lookup (FilePathId -> Int
getFilePathId FilePathId
fi) IntMap NodeKey
nodeKeys) [FilePathId]
this_dep_ids
go (Just ModSummary
ms) Maybe (Either ModuleParseError ModuleImports)
_ = ModuleGraphNode -> Maybe ModuleGraphNode
forall a. a -> Maybe a
Just (ModuleGraphNode -> Maybe ModuleGraphNode)
-> ModuleGraphNode -> Maybe ModuleGraphNode
forall a b. (a -> b) -> a -> b
$ [NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [] ModSummary
ms
go Maybe ModSummary
_ Maybe (Either ModuleParseError ModuleImports)
_ = Maybe ModuleGraphNode
forall a. Maybe a
Nothing
mg :: ModuleGraph
mg = [ModuleGraphNode] -> ModuleGraph
mkModuleGraph [ModuleGraphNode]
mns
#else
let mg = mkModuleGraph $
map extendModSummaryNoDeps $
catMaybes mss
#endif
(ByteString, DependencyInformation)
-> Action (ByteString, DependencyInformation)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fingerprint -> ByteString
fingerprintToBS (Fingerprint -> ByteString) -> Fingerprint -> ByteString
forall a b. (a -> b) -> a -> b
$ [Fingerprint] -> Fingerprint
Util.fingerprintFingerprints ([Fingerprint] -> Fingerprint) -> [Fingerprint] -> Fingerprint
forall a b. (a -> b) -> a -> b
$ (Maybe ModSummaryResult -> Fingerprint)
-> [Maybe ModSummaryResult] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint
-> (ModSummaryResult -> Fingerprint)
-> Maybe ModSummaryResult
-> Fingerprint
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Fingerprint
fingerprint0 ModSummaryResult -> Fingerprint
msrFingerprint) [Maybe ModSummaryResult]
msrs, RawDependencyInformation
-> BootIdMap -> ModuleGraph -> DependencyInformation
processDependencyInformation RawDependencyInformation
rawDepInfo BootIdMap
bm ModuleGraph
mg)
typeCheckRuleDefinition
:: HscEnv
-> ParsedModule
-> Action (IdeResult TcModuleResult)
typeCheckRuleDefinition :: HscEnv -> ParsedModule -> Action (IdeResult TcModuleResult)
typeCheckRuleDefinition HscEnv
hsc ParsedModule
pm = do
IdeOptions { optDefer :: IdeOptions -> IdeDefer
optDefer = IdeDefer
defer } <- Action IdeOptions
getIdeOptions
UnliftIO Action
unlift <- Action (UnliftIO Action)
forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
let dets :: TypecheckHelpers
dets = TypecheckHelpers
{ getLinkables :: [NormalizedFilePath] -> IO [LinkableResult]
getLinkables = UnliftIO Action -> forall a. Action a -> IO a
forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO Action
unlift (Action [LinkableResult] -> IO [LinkableResult])
-> ([NormalizedFilePath] -> Action [LinkableResult])
-> [NormalizedFilePath]
-> IO [LinkableResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetLinkable -> [NormalizedFilePath] -> Action [LinkableResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ GetLinkable
GetLinkable
}
Action (IdeResult TcModuleResult)
-> Action (IdeResult TcModuleResult)
forall a.
Action (a, Maybe TcModuleResult)
-> Action (a, Maybe TcModuleResult)
addUsageDependencies (Action (IdeResult TcModuleResult)
-> Action (IdeResult TcModuleResult))
-> Action (IdeResult TcModuleResult)
-> Action (IdeResult TcModuleResult)
forall a b. (a -> b) -> a -> b
$ IO (IdeResult TcModuleResult) -> Action (IdeResult TcModuleResult)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult TcModuleResult)
-> Action (IdeResult TcModuleResult))
-> IO (IdeResult TcModuleResult)
-> Action (IdeResult TcModuleResult)
forall a b. (a -> b) -> a -> b
$
IdeDefer
-> HscEnv
-> TypecheckHelpers
-> ParsedModule
-> IO (IdeResult TcModuleResult)
typecheckModule IdeDefer
defer HscEnv
hsc TypecheckHelpers
dets ParsedModule
pm
where
addUsageDependencies :: Action (a, Maybe TcModuleResult) -> Action (a, Maybe TcModuleResult)
addUsageDependencies :: forall a.
Action (a, Maybe TcModuleResult)
-> Action (a, Maybe TcModuleResult)
addUsageDependencies Action (a, Maybe TcModuleResult)
a = do
r :: (a, Maybe TcModuleResult)
r@(a
_, Maybe TcModuleResult
mtc) <- Action (a, Maybe TcModuleResult)
a
Maybe TcModuleResult -> (TcModuleResult -> Action ()) -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe TcModuleResult
mtc ((TcModuleResult -> Action ()) -> Action ())
-> (TcModuleResult -> Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ \TcModuleResult
tc -> do
[[Char]]
used_files <- IO [[Char]] -> Action [[Char]]
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> Action [[Char]]) -> IO [[Char]] -> Action [[Char]]
forall a b. (a -> b) -> a -> b
$ IORef [[Char]] -> IO [[Char]]
forall a. IORef a -> IO a
readIORef (IORef [[Char]] -> IO [[Char]]) -> IORef [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> IORef [[Char]]
tcg_dependent_files (TcGblEnv -> IORef [[Char]]) -> TcGblEnv -> IORef [[Char]]
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
tc
Action [FileVersion] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [FileVersion] -> Action ())
-> Action [FileVersion] -> Action ()
forall a b. (a -> b) -> a -> b
$ GetModificationTime -> [NormalizedFilePath] -> Action [FileVersion]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ GetModificationTime
GetModificationTime (([Char] -> NormalizedFilePath) -> [[Char]] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> NormalizedFilePath
toNormalizedFilePath' [[Char]]
used_files)
(a, Maybe TcModuleResult) -> Action (a, Maybe TcModuleResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (a, Maybe TcModuleResult)
r
currentLinkables :: Action (ModuleEnv UTCTime)
currentLinkables :: Action (ModuleEnv UTCTime)
currentLinkables = do
Var (ModuleEnv UTCTime)
compiledLinkables <- CompiledLinkables -> Var (ModuleEnv UTCTime)
getCompiledLinkables (CompiledLinkables -> Var (ModuleEnv UTCTime))
-> Action CompiledLinkables -> Action (Var (ModuleEnv UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action CompiledLinkables
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
IO (ModuleEnv UTCTime) -> Action (ModuleEnv UTCTime)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ModuleEnv UTCTime) -> Action (ModuleEnv UTCTime))
-> IO (ModuleEnv UTCTime) -> Action (ModuleEnv UTCTime)
forall a b. (a -> b) -> a -> b
$ Var (ModuleEnv UTCTime) -> IO (ModuleEnv UTCTime)
forall a. Var a -> IO a
readVar Var (ModuleEnv UTCTime)
compiledLinkables
loadGhcSession :: Recorder (WithPriority Log) -> GhcSessionDepsConfig -> Rules ()
loadGhcSession :: Recorder (WithPriority Log) -> GhcSessionDepsConfig -> Rules ()
loadGhcSession Recorder (WithPriority Log)
recorder GhcSessionDepsConfig
ghcSessionDepsConfig = do
Recorder (WithPriority Log)
-> (GhcSessionIO -> Action (ByteString, IdeGhcSession)) -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GhcSessionIO -> Action (ByteString, IdeGhcSession)) -> Rules ())
-> (GhcSessionIO -> Action (ByteString, IdeGhcSession)) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \GhcSessionIO
GhcSessionIO -> do
Action ()
alwaysRerun
IdeOptions
opts <- Action IdeOptions
getIdeOptions
Config
config <- Action Config
getClientConfigAction
IdeGhcSession
res <- IdeOptions -> Action IdeGhcSession
optGhcSession IdeOptions
opts
let fingerprint :: ByteString
fingerprint = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
LBS.concat
[ Int -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Int -> Int
forall a. Hashable a => a -> Int
hash (IdeGhcSession -> Int
sessionVersion IdeGhcSession
res))
, [Char] -> ByteString
forall a. Binary a => a -> ByteString
B.encode (SessionLoadingPreferenceConfig -> [Char]
forall a. Show a => a -> [Char]
show (Config -> SessionLoadingPreferenceConfig
sessionLoading Config
config))
]
(ByteString, IdeGhcSession) -> Action (ByteString, IdeGhcSession)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
fingerprint, IdeGhcSession
res)
Recorder (WithPriority Log)
-> RuleBody GhcSession HscEnvEq -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GhcSession HscEnvEq -> Rules ())
-> RuleBody GhcSession HscEnvEq -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GhcSession
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult HscEnvEq))
-> RuleBody GhcSession HscEnvEq
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
Rule ((GhcSession
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult HscEnvEq))
-> RuleBody GhcSession HscEnvEq)
-> (GhcSession
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult HscEnvEq))
-> RuleBody GhcSession HscEnvEq
forall a b. (a -> b) -> a -> b
$ \GhcSession
GhcSession NormalizedFilePath
file -> do
IdeGhcSession{[Char] -> IO (IdeResult HscEnvEq, [[Char]])
loadSessionFun :: [Char] -> IO (IdeResult HscEnvEq, [[Char]])
loadSessionFun :: IdeGhcSession -> [Char] -> IO (IdeResult HscEnvEq, [[Char]])
loadSessionFun} <- GhcSessionIO -> Action IdeGhcSession
forall k v. IdeRule k v => k -> Action v
useNoFile_ GhcSessionIO
GhcSessionIO
(IdeResult HscEnvEq
val,[[Char]]
deps) <- IO (IdeResult HscEnvEq, [[Char]])
-> Action (IdeResult HscEnvEq, [[Char]])
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult HscEnvEq, [[Char]])
-> Action (IdeResult HscEnvEq, [[Char]]))
-> IO (IdeResult HscEnvEq, [[Char]])
-> Action (IdeResult HscEnvEq, [[Char]])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (IdeResult HscEnvEq, [[Char]])
loadSessionFun ([Char] -> IO (IdeResult HscEnvEq, [[Char]]))
-> [Char] -> IO (IdeResult HscEnvEq, [[Char]])
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file
let addDependency :: [Char] -> Action ()
addDependency [Char]
fp = do
let nfp :: NormalizedFilePath
nfp = [Char] -> NormalizedFilePath
toNormalizedFilePath' [Char]
fp
Bool
itExists <- NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
itExists (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ Action FileVersion -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action FileVersion -> Action ())
-> Action FileVersion -> Action ()
forall a b. (a -> b) -> a -> b
$ do
GetModificationTime -> NormalizedFilePath -> Action FileVersion
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModificationTime
GetModificationTime NormalizedFilePath
nfp
([Char] -> Action ()) -> [[Char]] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> Action ()
addDependency [[Char]]
deps
let cutoffHash :: ByteString
cutoffHash = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Maybe HscEnvEq -> Int
forall a. Hashable a => a -> Int
hash (IdeResult HscEnvEq -> Maybe HscEnvEq
forall a b. (a, b) -> b
snd IdeResult HscEnvEq
val))
(Maybe ByteString, IdeResult HscEnvEq)
-> Action (Maybe ByteString, IdeResult HscEnvEq)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
cutoffHash, IdeResult HscEnvEq
val)
Recorder (WithPriority Log)
-> (GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe HscEnvEq))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GhcSessionDeps -> NormalizedFilePath -> Action (Maybe HscEnvEq))
-> Rules ())
-> (GhcSessionDeps
-> NormalizedFilePath -> Action (Maybe HscEnvEq))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \(GhcSessionDeps_ Bool
fullModSummary) NormalizedFilePath
file -> do
HscEnvEq
env <- GhcSession -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSession
GhcSession NormalizedFilePath
file
Bool
-> GhcSessionDepsConfig
-> HscEnvEq
-> NormalizedFilePath
-> Action (Maybe HscEnvEq)
ghcSessionDepsDefinition Bool
fullModSummary GhcSessionDepsConfig
ghcSessionDepsConfig HscEnvEq
env NormalizedFilePath
file
newtype GhcSessionDepsConfig = GhcSessionDepsConfig
{ GhcSessionDepsConfig -> Bool
fullModuleGraph :: Bool
}
instance Default GhcSessionDepsConfig where
def :: GhcSessionDepsConfig
def = GhcSessionDepsConfig
{ $sel:fullModuleGraph:GhcSessionDepsConfig :: Bool
fullModuleGraph = Bool
True
}
ghcSessionDepsDefinition
::
Bool ->
GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq)
ghcSessionDepsDefinition :: Bool
-> GhcSessionDepsConfig
-> HscEnvEq
-> NormalizedFilePath
-> Action (Maybe HscEnvEq)
ghcSessionDepsDefinition Bool
fullModSummary GhcSessionDepsConfig{Bool
$sel:fullModuleGraph:GhcSessionDepsConfig :: GhcSessionDepsConfig -> Bool
fullModuleGraph :: Bool
..} HscEnvEq
env NormalizedFilePath
file = do
let hsc :: HscEnv
hsc = HscEnvEq -> HscEnv
hscEnv HscEnvEq
env
Maybe [NormalizedFilePath]
mbdeps <- ((Located ModuleName, Maybe ArtifactsLocation)
-> Maybe NormalizedFilePath)
-> [(Located ModuleName, Maybe ArtifactsLocation)]
-> Maybe [NormalizedFilePath]
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((ArtifactsLocation -> NormalizedFilePath)
-> Maybe ArtifactsLocation -> Maybe NormalizedFilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ArtifactsLocation -> NormalizedFilePath
artifactFilePath (Maybe ArtifactsLocation -> Maybe NormalizedFilePath)
-> ((Located ModuleName, Maybe ArtifactsLocation)
-> Maybe ArtifactsLocation)
-> (Located ModuleName, Maybe ArtifactsLocation)
-> Maybe NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located ModuleName, Maybe ArtifactsLocation)
-> Maybe ArtifactsLocation
forall a b. (a, b) -> b
snd) ([(Located ModuleName, Maybe ArtifactsLocation)]
-> Maybe [NormalizedFilePath])
-> Action [(Located ModuleName, Maybe ArtifactsLocation)]
-> Action (Maybe [NormalizedFilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetLocatedImports
-> NormalizedFilePath
-> Action [(Located ModuleName, Maybe ArtifactsLocation)]
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetLocatedImports
GetLocatedImports NormalizedFilePath
file
case Maybe [NormalizedFilePath]
mbdeps of
Maybe [NormalizedFilePath]
Nothing -> Maybe HscEnvEq -> Action (Maybe HscEnvEq)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HscEnvEq
forall a. Maybe a
Nothing
Just [NormalizedFilePath]
deps -> do
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fullModuleGraph (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ Action () -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ ReportImportCycles -> NormalizedFilePath -> Action ()
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ ReportImportCycles
ReportImportCycles NormalizedFilePath
file
ModSummary
ms <- ModSummaryResult -> ModSummary
msrModSummary (ModSummaryResult -> ModSummary)
-> Action ModSummaryResult -> Action ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
fullModSummary
then GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
file
else GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
[HscEnv]
depSessions <- (HscEnvEq -> HscEnv) -> [HscEnvEq] -> [HscEnv]
forall a b. (a -> b) -> [a] -> [b]
map HscEnvEq -> HscEnv
hscEnv ([HscEnvEq] -> [HscEnv]) -> Action [HscEnvEq] -> Action [HscEnv]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps -> [NormalizedFilePath] -> Action [HscEnvEq]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ (Bool -> GhcSessionDeps
GhcSessionDeps_ Bool
fullModSummary) [NormalizedFilePath]
deps
[HiFileResult]
ifaces <- GetModIface -> [NormalizedFilePath] -> Action [HiFileResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ GetModIface
GetModIface [NormalizedFilePath]
deps
let inLoadOrder :: [HomeModInfo]
inLoadOrder = (HiFileResult -> HomeModInfo) -> [HiFileResult] -> [HomeModInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\HiFileResult{Maybe (CoreFile, ByteString)
ByteString
ModuleEnv ByteString
ModDetails
ModIface
ModSummary
hirModSummary :: ModSummary
hirModIface :: ModIface
hirModDetails :: ModDetails
hirIfaceFp :: ByteString
hirRuntimeModules :: ModuleEnv ByteString
hirCoreFp :: Maybe (CoreFile, ByteString)
hirModSummary :: HiFileResult -> ModSummary
hirModIface :: HiFileResult -> ModIface
hirModDetails :: HiFileResult -> ModDetails
hirIfaceFp :: HiFileResult -> ByteString
hirRuntimeModules :: HiFileResult -> ModuleEnv ByteString
hirCoreFp :: HiFileResult -> Maybe (CoreFile, ByteString)
..} -> ModIface -> ModDetails -> HomeModLinkable -> HomeModInfo
HomeModInfo ModIface
hirModIface ModDetails
hirModDetails HomeModLinkable
emptyHomeModInfoLinkable) [HiFileResult]
ifaces
ModuleGraph
mg <- do
if Bool
fullModuleGraph
then DependencyInformation -> ModuleGraph
depModuleGraph (DependencyInformation -> ModuleGraph)
-> Action DependencyInformation -> Action ModuleGraph
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModuleGraph -> Action DependencyInformation
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetModuleGraph
GetModuleGraph
else do
let mgs :: [ModuleGraph]
mgs = (HscEnv -> ModuleGraph) -> [HscEnv] -> [ModuleGraph]
forall a b. (a -> b) -> [a] -> [b]
map HscEnv -> ModuleGraph
hsc_mod_graph [HscEnv]
depSessions
#if MIN_VERSION_ghc(9,3,0)
![NodeKey]
final_deps <- do
[ModSummary]
dep_mss <- (ModSummaryResult -> ModSummary)
-> [ModSummaryResult] -> [ModSummary]
forall a b. (a -> b) -> [a] -> [b]
map ModSummaryResult -> ModSummary
msrModSummary ([ModSummaryResult] -> [ModSummary])
-> Action [ModSummaryResult] -> Action [ModSummary]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> [NormalizedFilePath] -> Action [ModSummaryResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps [NormalizedFilePath]
deps
[NodeKey] -> Action [NodeKey]
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([NodeKey] -> Action [NodeKey]) -> [NodeKey] -> Action [NodeKey]
forall a b. NFData a => (a -> b) -> a -> b
$!! (ModSummary -> NodeKey) -> [ModSummary] -> [NodeKey]
forall a b. (a -> b) -> [a] -> [b]
map (ModNodeKeyWithUid -> NodeKey
NodeKey_Module (ModNodeKeyWithUid -> NodeKey)
-> (ModSummary -> ModNodeKeyWithUid) -> ModSummary -> NodeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> ModNodeKeyWithUid
msKey) [ModSummary]
dep_mss
let module_graph_nodes :: [ModuleGraphNode]
module_graph_nodes =
(ModuleGraphNode -> NodeKey)
-> [ModuleGraphNode] -> [ModuleGraphNode]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn ModuleGraphNode -> NodeKey
mkNodeKey ([NodeKey] -> ModSummary -> ModuleGraphNode
ModuleNode [NodeKey]
final_deps ModSummary
ms ModuleGraphNode -> [ModuleGraphNode] -> [ModuleGraphNode]
forall a. a -> [a] -> [a]
: (ModuleGraph -> [ModuleGraphNode])
-> [ModuleGraph] -> [ModuleGraphNode]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModuleGraph -> [ModuleGraphNode]
mgModSummaries' [ModuleGraph]
mgs)
#else
let module_graph_nodes =
map extendModSummaryNoDeps $
nubOrdOn ms_mod (ms : concatMap mgModSummaries mgs)
#endif
IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ModuleGraphNode -> ()) -> [ModuleGraphNode] -> ()
forall a. (a -> ()) -> [a] -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf ModuleGraphNode -> ()
forall a. a -> ()
rwhnf [ModuleGraphNode]
module_graph_nodes
ModuleGraph -> Action ModuleGraph
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleGraph -> Action ModuleGraph)
-> ModuleGraph -> Action ModuleGraph
forall a b. (a -> b) -> a -> b
$ [ModuleGraphNode] -> ModuleGraph
mkModuleGraph [ModuleGraphNode]
module_graph_nodes
HscEnv
session' <- IO HscEnv -> Action HscEnv
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnv -> Action HscEnv) -> IO HscEnv -> Action HscEnv
forall a b. (a -> b) -> a -> b
$ HscEnv
-> ModuleGraph
-> ModSummary
-> [HomeModInfo]
-> [HscEnv]
-> IO HscEnv
mergeEnvs HscEnv
hsc ModuleGraph
mg ModSummary
ms [HomeModInfo]
inLoadOrder [HscEnv]
depSessions
HscEnvEq -> Maybe HscEnvEq
forall a. a -> Maybe a
Just (HscEnvEq -> Maybe HscEnvEq)
-> Action HscEnvEq -> Action (Maybe HscEnvEq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO HscEnvEq -> Action HscEnvEq
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnvEq -> HscEnv -> IO HscEnvEq
updateHscEnvEq HscEnvEq
env HscEnv
session')
getModIfaceFromDiskRule :: Recorder (WithPriority Log) -> Rules ()
getModIfaceFromDiskRule :: Recorder (WithPriority Log) -> Rules ()
getModIfaceFromDiskRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> RuleBody GetModIfaceFromDisk HiFileResult -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GetModIfaceFromDisk HiFileResult -> Rules ())
-> RuleBody GetModIfaceFromDisk HiFileResult -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetModIfaceFromDisk
-> NormalizedFilePath
-> Value HiFileResult
-> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIfaceFromDisk HiFileResult
forall k v.
(k
-> NormalizedFilePath
-> Value v
-> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
RuleWithOldValue ((GetModIfaceFromDisk
-> NormalizedFilePath
-> Value HiFileResult
-> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIfaceFromDisk HiFileResult)
-> (GetModIfaceFromDisk
-> NormalizedFilePath
-> Value HiFileResult
-> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIfaceFromDisk HiFileResult
forall a b. (a -> b) -> a -> b
$ \GetModIfaceFromDisk
GetModIfaceFromDisk NormalizedFilePath
f Value HiFileResult
old -> do
ModSummary
ms <- ModSummaryResult -> ModSummary
msrModSummary (ModSummaryResult -> ModSummary)
-> Action ModSummaryResult -> Action ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
f
Maybe HscEnvEq
mb_session <- GhcSessionDeps -> NormalizedFilePath -> Action (Maybe HscEnvEq)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSessionDeps
GhcSessionDeps NormalizedFilePath
f
case Maybe HscEnvEq
mb_session of
Maybe HscEnvEq
Nothing -> (Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([], Maybe HiFileResult
forall a. Maybe a
Nothing))
Just HscEnvEq
session -> do
Maybe LinkableType
linkableType <- NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType NormalizedFilePath
f
FileVersion
ver <- GetModificationTime -> NormalizedFilePath -> Action FileVersion
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModificationTime
GetModificationTime NormalizedFilePath
f
let m_old :: Maybe (HiFileResult, FileVersion)
m_old = case Value HiFileResult
old of
Shake.Succeeded (Just FileVersion
old_version) HiFileResult
v -> (HiFileResult, FileVersion) -> Maybe (HiFileResult, FileVersion)
forall a. a -> Maybe a
Just (HiFileResult
v, FileVersion
old_version)
Shake.Stale Maybe PositionDelta
_ (Just FileVersion
old_version) HiFileResult
v -> (HiFileResult, FileVersion) -> Maybe (HiFileResult, FileVersion)
forall a. a -> Maybe a
Just (HiFileResult
v, FileVersion
old_version)
Value HiFileResult
_ -> Maybe (HiFileResult, FileVersion)
forall a. Maybe a
Nothing
recompInfo :: RecompilationInfo Action
recompInfo = RecompilationInfo
{ source_version :: FileVersion
source_version = FileVersion
ver
, old_value :: Maybe (HiFileResult, FileVersion)
old_value = Maybe (HiFileResult, FileVersion)
m_old
, get_file_version :: NormalizedFilePath -> Action (Maybe FileVersion)
get_file_version = GetModificationTime
-> NormalizedFilePath -> Action (Maybe FileVersion)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModificationTime_{missingFileDiagnostics :: Bool
missingFileDiagnostics = Bool
False}
, get_linkable_hashes :: [NormalizedFilePath] -> Action [ByteString]
get_linkable_hashes = \[NormalizedFilePath]
fs -> (HiFileResult -> ByteString) -> [HiFileResult] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((CoreFile, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((CoreFile, ByteString) -> ByteString)
-> (HiFileResult -> (CoreFile, ByteString))
-> HiFileResult
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (CoreFile, ByteString) -> (CoreFile, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CoreFile, ByteString) -> (CoreFile, ByteString))
-> (HiFileResult -> Maybe (CoreFile, ByteString))
-> HiFileResult
-> (CoreFile, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HiFileResult -> Maybe (CoreFile, ByteString)
hirCoreFp) ([HiFileResult] -> [ByteString])
-> Action [HiFileResult] -> Action [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModIface -> [NormalizedFilePath] -> Action [HiFileResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f v)
uses_ GetModIface
GetModIface [NormalizedFilePath]
fs
, regenerate :: Maybe LinkableType -> Action (IdeResult HiFileResult)
regenerate = HscEnvEq
-> NormalizedFilePath
-> ModSummary
-> Maybe LinkableType
-> Action (IdeResult HiFileResult)
regenerateHiFile HscEnvEq
session NormalizedFilePath
f ModSummary
ms
}
IdeResult HiFileResult
r <- HscEnv
-> ModSummary
-> Maybe LinkableType
-> RecompilationInfo Action
-> Action (IdeResult HiFileResult)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
HscEnv
-> ModSummary
-> Maybe LinkableType
-> RecompilationInfo m
-> m (IdeResult HiFileResult)
loadInterface (HscEnvEq -> HscEnv
hscEnv HscEnvEq
session) ModSummary
ms Maybe LinkableType
linkableType RecompilationInfo Action
recompInfo
case IdeResult HiFileResult
r of
([FileDiagnostic]
diags, Maybe HiFileResult
Nothing) -> (Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([FileDiagnostic]
diags, Maybe HiFileResult
forall a. Maybe a
Nothing))
([FileDiagnostic]
diags, Just HiFileResult
x) -> do
let !fp :: Maybe ByteString
fp = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$! HiFileResult -> ByteString
hiFileFingerPrint HiFileResult
x
(Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
fp, ([FileDiagnostic]
diags, HiFileResult -> Maybe HiFileResult
forall a. a -> Maybe a
Just HiFileResult
x))
getModIfaceFromDiskAndIndexRule :: Recorder (WithPriority Log) -> Rules ()
getModIfaceFromDiskAndIndexRule :: Recorder (WithPriority Log) -> Rules ()
getModIfaceFromDiskAndIndexRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GetModIfaceFromDiskAndIndex
-> NormalizedFilePath -> Action (Maybe HiFileResult))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetModIfaceFromDiskAndIndex
-> NormalizedFilePath -> Action (Maybe HiFileResult))
-> Rules ())
-> (GetModIfaceFromDiskAndIndex
-> NormalizedFilePath -> Action (Maybe HiFileResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetModIfaceFromDiskAndIndex
GetModIfaceFromDiskAndIndex NormalizedFilePath
f -> do
HiFileResult
x <- GetModIfaceFromDisk -> NormalizedFilePath -> Action HiFileResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModIfaceFromDisk
GetModIfaceFromDisk NormalizedFilePath
f
se :: ShakeExtras
se@ShakeExtras{WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb :: WithHieDb
withHieDb} <- Action ShakeExtras
getShakeExtras
let ms :: ModSummary
ms = HiFileResult -> ModSummary
hirModSummary HiFileResult
x
hie_loc :: [Char]
hie_loc = ModLocation -> [Char]
Compat.ml_hie_file (ModLocation -> [Char]) -> ModLocation -> [Char]
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
Fingerprint
fileHash <- IO Fingerprint -> Action Fingerprint
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Fingerprint -> Action Fingerprint)
-> IO Fingerprint -> Action Fingerprint
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Fingerprint
Util.getFileHash [Char]
hie_loc
Maybe HieModuleRow
mrow <- IO (Maybe HieModuleRow) -> Action (Maybe HieModuleRow)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe HieModuleRow) -> Action (Maybe HieModuleRow))
-> IO (Maybe HieModuleRow) -> Action (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ (HieDb -> IO (Maybe HieModuleRow)) -> IO (Maybe HieModuleRow)
WithHieDb
withHieDb (\HieDb
hieDb -> HieDb -> [Char] -> IO (Maybe HieModuleRow)
HieDb.lookupHieFileFromSource HieDb
hieDb (NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
f))
let hie_loc' :: Maybe [Char]
hie_loc' = HieModuleRow -> [Char]
HieDb.hieModuleHieFile (HieModuleRow -> [Char]) -> Maybe HieModuleRow -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HieModuleRow
mrow
case Maybe HieModuleRow
mrow of
Just HieModuleRow
row
| Fingerprint
fileHash Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleInfo -> Fingerprint
HieDb.modInfoHash (HieModuleRow -> ModuleInfo
HieDb.hieModInfo HieModuleRow
row)
Bool -> Bool -> Bool
&& [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
hie_loc Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [Char]
hie_loc'
-> do
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IdeTesting -> Bool
forall a b. Coercible a b => a -> b
coerce (IdeTesting -> Bool) -> IdeTesting -> Bool
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IdeTesting
ideTesting ShakeExtras
se) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Maybe (LanguageContextEnv Config) -> LspT Config IO () -> IO ()
forall (m :: * -> *) c.
Applicative m =>
Maybe (LanguageContextEnv c) -> LspT c m () -> m ()
mRunLspT (ShakeExtras -> Maybe (LanguageContextEnv Config)
lspEnv ShakeExtras
se) (LspT Config IO () -> IO ()) -> LspT Config IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
SServerMethod ('Method_CustomMethod "ghcide/reference/ready")
-> MessageParams ('Method_CustomMethod "ghcide/reference/ready")
-> LspT Config IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification (Proxy "ghcide/reference/ready"
-> SServerMethod ('Method_CustomMethod "ghcide/reference/ready")
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"ghcide/reference/ready")) (MessageParams ('Method_CustomMethod "ghcide/reference/ready")
-> LspT Config IO ())
-> MessageParams ('Method_CustomMethod "ghcide/reference/ready")
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Char] -> Value) -> [Char] -> Value
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
f
Maybe HieModuleRow
_ -> do
Either SomeException HieFile
ehf <- IO (Either SomeException HieFile)
-> Action (Either SomeException HieFile)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException HieFile)
-> Action (Either SomeException HieFile))
-> IO (Either SomeException HieFile)
-> Action (Either SomeException HieFile)
forall a b. (a -> b) -> a -> b
$ [Char]
-> ShakeExtras
-> IdeAction (Either SomeException HieFile)
-> IO (Either SomeException HieFile)
forall a. [Char] -> ShakeExtras -> IdeAction a -> IO a
runIdeAction [Char]
"GetModIfaceFromDiskAndIndex" ShakeExtras
se (IdeAction (Either SomeException HieFile)
-> IO (Either SomeException HieFile))
-> IdeAction (Either SomeException HieFile)
-> IO (Either SomeException HieFile)
forall a b. (a -> b) -> a -> b
$ ExceptT SomeException IdeAction HieFile
-> IdeAction (Either SomeException HieFile)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT SomeException IdeAction HieFile
-> IdeAction (Either SomeException HieFile))
-> ExceptT SomeException IdeAction HieFile
-> IdeAction (Either SomeException HieFile)
forall a b. (a -> b) -> a -> b
$
Recorder (WithPriority Log)
-> [Char] -> ExceptT SomeException IdeAction HieFile
readHieFileFromDisk Recorder (WithPriority Log)
recorder [Char]
hie_loc
case Either SomeException HieFile
ehf of
Left SomeException
err -> [Char] -> Action ()
forall a. [Char] -> Action a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Action ()) -> [Char] -> Action ()
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to read .hie file " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
hie_loc [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
err
Right HieFile
hf -> IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Logger.Debug (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Log
LogReindexingHieFile NormalizedFilePath
f
ShakeExtras
-> ModSummary
-> NormalizedFilePath
-> Fingerprint
-> HieFile
-> IO ()
indexHieFile ShakeExtras
se ModSummary
ms NormalizedFilePath
f Fingerprint
fileHash HieFile
hf
Maybe HiFileResult -> Action (Maybe HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (HiFileResult -> Maybe HiFileResult
forall a. a -> Maybe a
Just HiFileResult
x)
newtype DisplayTHWarning = DisplayTHWarning (IO())
instance IsIdeGlobal DisplayTHWarning
getModSummaryRule :: LspT Config IO () -> Recorder (WithPriority Log) -> Rules ()
getModSummaryRule :: LspT Config IO () -> Recorder (WithPriority Log) -> Rules ()
getModSummaryRule LspT Config IO ()
displayTHWarning Recorder (WithPriority Log)
recorder = do
Maybe (LanguageContextEnv Config)
menv <- ShakeExtras -> Maybe (LanguageContextEnv Config)
lspEnv (ShakeExtras -> Maybe (LanguageContextEnv Config))
-> Rules ShakeExtras -> Rules (Maybe (LanguageContextEnv Config))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rules ShakeExtras
getShakeExtrasRules
case Maybe (LanguageContextEnv Config)
menv of
Just LanguageContextEnv Config
env -> do
IO ()
displayItOnce <- IO (IO ()) -> Rules (IO ())
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO ()) -> Rules (IO ())) -> IO (IO ()) -> Rules (IO ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (IO ())
forall a. IO a -> IO (IO a)
once (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ LanguageContextEnv Config -> LspT Config IO () -> IO ()
forall config (m :: * -> *) a.
LanguageContextEnv config -> LspT config m a -> m a
LSP.runLspT LanguageContextEnv Config
env LspT Config IO ()
displayTHWarning
DisplayTHWarning -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (IO () -> DisplayTHWarning
DisplayTHWarning IO ()
displayItOnce)
Maybe (LanguageContextEnv Config)
Nothing -> do
IO ()
logItOnce <- IO (IO ()) -> Rules (IO ())
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO ()) -> Rules (IO ())) -> IO (IO ()) -> Rules (IO ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (IO ())
forall a. IO a -> IO (IO a)
once (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
""
DisplayTHWarning -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (IO () -> DisplayTHWarning
DisplayTHWarning IO ()
logItOnce)
Recorder (WithPriority Log)
-> RuleBody GetModSummary ModSummaryResult -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GetModSummary ModSummaryResult -> Rules ())
-> RuleBody GetModSummary ModSummaryResult -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetModSummary
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult ModSummaryResult))
-> RuleBody GetModSummary ModSummaryResult
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
Rule ((GetModSummary
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult ModSummaryResult))
-> RuleBody GetModSummary ModSummaryResult)
-> (GetModSummary
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult ModSummaryResult))
-> RuleBody GetModSummary ModSummaryResult
forall a b. (a -> b) -> a -> b
$ \GetModSummary
GetModSummary NormalizedFilePath
f -> do
HscEnv
session' <- HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> HscEnv) -> Action HscEnvEq -> Action HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSession -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSession
GhcSession NormalizedFilePath
f
DynFlags -> DynFlags
modify_dflags <- (DynFlagsModifications -> DynFlags -> DynFlags)
-> Action (DynFlags -> DynFlags)
forall a. (DynFlagsModifications -> a) -> Action a
getModifyDynFlags DynFlagsModifications -> DynFlags -> DynFlags
dynFlagsModifyGlobal
let session :: HscEnv
session = DynFlags -> HscEnv -> HscEnv
hscSetFlags (DynFlags -> DynFlags
modify_dflags (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags
hsc_dflags HscEnv
session') HscEnv
session'
(UTCTime
modTime, Maybe Text
mFileContent) <- NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
f
let fp :: [Char]
fp = NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
f
Either [FileDiagnostic] ModSummaryResult
modS <- IO (Either [FileDiagnostic] ModSummaryResult)
-> Action (Either [FileDiagnostic] ModSummaryResult)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [FileDiagnostic] ModSummaryResult)
-> Action (Either [FileDiagnostic] ModSummaryResult))
-> IO (Either [FileDiagnostic] ModSummaryResult)
-> Action (Either [FileDiagnostic] ModSummaryResult)
forall a b. (a -> b) -> a -> b
$ ExceptT [FileDiagnostic] IO ModSummaryResult
-> IO (Either [FileDiagnostic] ModSummaryResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [FileDiagnostic] IO ModSummaryResult
-> IO (Either [FileDiagnostic] ModSummaryResult))
-> ExceptT [FileDiagnostic] IO ModSummaryResult
-> IO (Either [FileDiagnostic] ModSummaryResult)
forall a b. (a -> b) -> a -> b
$
HscEnv
-> [Char]
-> UTCTime
-> Maybe StringBuffer
-> ExceptT [FileDiagnostic] IO ModSummaryResult
getModSummaryFromImports HscEnv
session [Char]
fp UTCTime
modTime (Text -> StringBuffer
textToStringBuffer (Text -> StringBuffer) -> Maybe Text -> Maybe StringBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mFileContent)
case Either [FileDiagnostic] ModSummaryResult
modS of
Right ModSummaryResult
res -> do
Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ModSummary -> Bool
uses_th_qq (ModSummary -> Bool) -> ModSummary -> Bool
forall a b. (a -> b) -> a -> b
$ ModSummaryResult -> ModSummary
msrModSummary ModSummaryResult
res) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
DisplayTHWarning IO ()
act <- Action DisplayTHWarning
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
act
#if MIN_VERSION_ghc(9,3,0)
let bufFingerPrint :: Fingerprint
bufFingerPrint = ModSummary -> Fingerprint
ms_hs_hash (ModSummaryResult -> ModSummary
msrModSummary ModSummaryResult
res)
#else
bufFingerPrint <- liftIO $
fingerprintFromStringBuffer $ fromJust $ ms_hspp_buf $ msrModSummary res
#endif
let fingerPrint :: Fingerprint
fingerPrint = [Fingerprint] -> Fingerprint
Util.fingerprintFingerprints
[ ModSummaryResult -> Fingerprint
msrFingerprint ModSummaryResult
res, Fingerprint
bufFingerPrint ]
(Maybe ByteString, IdeResult ModSummaryResult)
-> Action (Maybe ByteString, IdeResult ModSummaryResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Fingerprint -> ByteString
fingerprintToBS Fingerprint
fingerPrint) , ([], ModSummaryResult -> Maybe ModSummaryResult
forall a. a -> Maybe a
Just ModSummaryResult
res))
Left [FileDiagnostic]
diags -> (Maybe ByteString, IdeResult ModSummaryResult)
-> Action (Maybe ByteString, IdeResult ModSummaryResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([FileDiagnostic]
diags, Maybe ModSummaryResult
forall a. Maybe a
Nothing))
Recorder (WithPriority Log)
-> RuleBody GetModSummaryWithoutTimestamps ModSummaryResult
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GetModSummaryWithoutTimestamps ModSummaryResult
-> Rules ())
-> RuleBody GetModSummaryWithoutTimestamps ModSummaryResult
-> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe ModSummaryResult))
-> RuleBody GetModSummaryWithoutTimestamps ModSummaryResult
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleNoDiagnostics ((GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe ModSummaryResult))
-> RuleBody GetModSummaryWithoutTimestamps ModSummaryResult)
-> (GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe ModSummaryResult))
-> RuleBody GetModSummaryWithoutTimestamps ModSummaryResult
forall a b. (a -> b) -> a -> b
$ \GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
f -> do
Maybe ModSummaryResult
mbMs <- GetModSummary
-> NormalizedFilePath -> Action (Maybe ModSummaryResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummary
GetModSummary NormalizedFilePath
f
case Maybe ModSummaryResult
mbMs of
Just res :: ModSummaryResult
res@ModSummaryResult{[LImportDecl GhcPs]
Fingerprint
ModSummary
HscEnv
msrModSummary :: ModSummaryResult -> ModSummary
msrHscEnv :: ModSummaryResult -> HscEnv
msrFingerprint :: ModSummaryResult -> Fingerprint
msrModSummary :: ModSummary
msrImports :: [LImportDecl GhcPs]
msrFingerprint :: Fingerprint
msrHscEnv :: HscEnv
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
..} -> do
let ms :: ModSummary
ms = ModSummary
msrModSummary {
#if !MIN_VERSION_ghc(9,3,0)
ms_hs_date = error "use GetModSummary instead of GetModSummaryWithoutTimestamps",
#endif
ms_hspp_buf = error "use GetModSummary instead of GetModSummaryWithoutTimestamps"
}
fp :: ByteString
fp = Fingerprint -> ByteString
fingerprintToBS Fingerprint
msrFingerprint
(Maybe ByteString, Maybe ModSummaryResult)
-> Action (Maybe ByteString, Maybe ModSummaryResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
fp, ModSummaryResult -> Maybe ModSummaryResult
forall a. a -> Maybe a
Just ModSummaryResult
res{msrModSummary = ms})
Maybe ModSummaryResult
Nothing -> (Maybe ByteString, Maybe ModSummaryResult)
-> Action (Maybe ByteString, Maybe ModSummaryResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, Maybe ModSummaryResult
forall a. Maybe a
Nothing)
generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts)
generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts)
generateCore RunSimplifier
runSimplifier NormalizedFilePath
file = do
HscEnv
packageState <- HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> HscEnv) -> Action HscEnvEq -> Action HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file
TcModuleResult
tm <- TypeCheck -> NormalizedFilePath -> Action TcModuleResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ TypeCheck
TypeCheck NormalizedFilePath
file
IO (IdeResult ModGuts) -> Action (IdeResult ModGuts)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult ModGuts) -> Action (IdeResult ModGuts))
-> IO (IdeResult ModGuts) -> Action (IdeResult ModGuts)
forall a b. (a -> b) -> a -> b
$ RunSimplifier
-> HscEnv -> ModSummary -> TcGblEnv -> IO (IdeResult ModGuts)
compileModule RunSimplifier
runSimplifier HscEnv
packageState (TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tm) (TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
tm)
generateCoreRule :: Recorder (WithPriority Log) -> Rules ()
generateCoreRule :: Recorder (WithPriority Log) -> Rules ()
generateCoreRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> (GenerateCore
-> NormalizedFilePath -> Action (IdeResult ModGuts))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GenerateCore -> NormalizedFilePath -> Action (IdeResult ModGuts))
-> Rules ())
-> (GenerateCore
-> NormalizedFilePath -> Action (IdeResult ModGuts))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GenerateCore
GenerateCore -> RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts)
generateCore (Bool -> RunSimplifier
RunSimplifier Bool
True)
getModIfaceRule :: Recorder (WithPriority Log) -> Rules ()
getModIfaceRule :: Recorder (WithPriority Log) -> Rules ()
getModIfaceRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> RuleBody GetModIface HiFileResult -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GetModIface HiFileResult -> Rules ())
-> RuleBody GetModIface HiFileResult -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetModIface
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIface HiFileResult
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
Rule ((GetModIface
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIface HiFileResult)
-> (GetModIface
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIface HiFileResult
forall a b. (a -> b) -> a -> b
$ \GetModIface
GetModIface NormalizedFilePath
f -> do
IsFileOfInterestResult
fileOfInterest <- IsFileOfInterest
-> NormalizedFilePath -> Action IsFileOfInterestResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ IsFileOfInterest
IsFileOfInterest NormalizedFilePath
f
(Maybe ByteString, IdeResult HiFileResult)
res <- case IsFileOfInterestResult
fileOfInterest of
IsFOI FileOfInterestStatus
status -> do
TcModuleResult
tmr <- TypeCheck -> NormalizedFilePath -> Action TcModuleResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ TypeCheck
TypeCheck NormalizedFilePath
f
Maybe LinkableType
linkableType <- NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType NormalizedFilePath
f
HscEnv
hsc <- HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> HscEnv) -> Action HscEnvEq -> Action HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSessionDeps -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
f
let compile :: Action (IdeResult ModGuts)
compile = (Maybe ModGuts -> IdeResult ModGuts)
-> Action (Maybe ModGuts) -> Action (IdeResult ModGuts)
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([],) (Action (Maybe ModGuts) -> Action (IdeResult ModGuts))
-> Action (Maybe ModGuts) -> Action (IdeResult ModGuts)
forall a b. (a -> b) -> a -> b
$ GenerateCore -> NormalizedFilePath -> Action (Maybe ModGuts)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GenerateCore
GenerateCore NormalizedFilePath
f
ShakeExtras
se <- Action ShakeExtras
getShakeExtras
([FileDiagnostic]
diags, !Maybe HiFileResult
mbHiFile) <- ShakeExtras
-> HscEnv
-> Maybe LinkableType
-> Action (IdeResult ModGuts)
-> TcModuleResult
-> Action (IdeResult HiFileResult)
writeCoreFileIfNeeded ShakeExtras
se HscEnv
hsc Maybe LinkableType
linkableType Action (IdeResult ModGuts)
compile TcModuleResult
tmr
let fp :: Maybe ByteString
fp = HiFileResult -> ByteString
hiFileFingerPrint (HiFileResult -> ByteString)
-> Maybe HiFileResult -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HiFileResult
mbHiFile
[FileDiagnostic]
hiDiags <- case Maybe HiFileResult
mbHiFile of
Just HiFileResult
hiFile
| FileOfInterestStatus
OnDisk <- FileOfInterestStatus
status
, Bool -> Bool
not (TcModuleResult -> Bool
tmrDeferredError TcModuleResult
tmr) -> IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FileDiagnostic] -> Action [FileDiagnostic])
-> IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> HscEnv -> HiFileResult -> IO [FileDiagnostic]
writeHiFile ShakeExtras
se HscEnv
hsc HiFileResult
hiFile
Maybe HiFileResult
_ -> [FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
(Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
fp, ([FileDiagnostic]
diags[FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. [a] -> [a] -> [a]
++[FileDiagnostic]
hiDiags, Maybe HiFileResult
mbHiFile))
IsFileOfInterestResult
NotFOI -> do
Maybe HiFileResult
hiFile <- GetModIfaceFromDiskAndIndex
-> NormalizedFilePath -> Action (Maybe HiFileResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModIfaceFromDiskAndIndex
GetModIfaceFromDiskAndIndex NormalizedFilePath
f
let fp :: Maybe ByteString
fp = HiFileResult -> ByteString
hiFileFingerPrint (HiFileResult -> ByteString)
-> Maybe HiFileResult -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HiFileResult
hiFile
(Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
fp, ([], Maybe HiFileResult
hiFile))
(Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString, IdeResult HiFileResult)
res
newtype RebuildCounter = RebuildCounter { RebuildCounter -> TVar Int
getRebuildCountVar :: TVar Int }
instance IsIdeGlobal RebuildCounter
getRebuildCount :: Action Int
getRebuildCount :: Action Int
getRebuildCount = do
TVar Int
count <- RebuildCounter -> TVar Int
getRebuildCountVar (RebuildCounter -> TVar Int)
-> Action RebuildCounter -> Action (TVar Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action RebuildCounter
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
IO Int -> Action Int
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Action Int) -> IO Int -> Action Int
forall a b. (a -> b) -> a -> b
$ TVar Int -> IO Int
forall a. TVar a -> IO a
readTVarIO TVar Int
count
incrementRebuildCount :: Action ()
incrementRebuildCount :: Action ()
incrementRebuildCount = do
TVar Int
count <- RebuildCounter -> TVar Int
getRebuildCountVar (RebuildCounter -> TVar Int)
-> Action RebuildCounter -> Action (TVar Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action RebuildCounter
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
count (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult)
regenerateHiFile :: HscEnvEq
-> NormalizedFilePath
-> ModSummary
-> Maybe LinkableType
-> Action (IdeResult HiFileResult)
regenerateHiFile HscEnvEq
sess NormalizedFilePath
f ModSummary
ms Maybe LinkableType
compNeeded = do
let hsc :: HscEnv
hsc = HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess
IdeOptions
opt <- Action IdeOptions
getIdeOptions
([FileDiagnostic]
diags, Maybe ParsedModule
mb_pm) <- IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule))
-> IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
forall a b. (a -> b) -> a -> b
$ HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
hsc IdeOptions
opt NormalizedFilePath
f (ModSummary -> ModSummary
withOptHaddock ModSummary
ms)
case Maybe ParsedModule
mb_pm of
Maybe ParsedModule
Nothing -> IdeResult HiFileResult -> Action (IdeResult HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileDiagnostic]
diags, Maybe HiFileResult
forall a. Maybe a
Nothing)
Just ParsedModule
pm -> do
([FileDiagnostic]
diags', Maybe TcModuleResult
mtmr) <- HscEnv -> ParsedModule -> Action (IdeResult TcModuleResult)
typeCheckRuleDefinition HscEnv
hsc ParsedModule
pm
case Maybe TcModuleResult
mtmr of
Maybe TcModuleResult
Nothing -> IdeResult HiFileResult -> Action (IdeResult HiFileResult)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags', Maybe HiFileResult
forall a. Maybe a
Nothing)
Just TcModuleResult
tmr -> do
let compile :: Action (IdeResult ModGuts)
compile = IO (IdeResult ModGuts) -> Action (IdeResult ModGuts)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult ModGuts) -> Action (IdeResult ModGuts))
-> IO (IdeResult ModGuts) -> Action (IdeResult ModGuts)
forall a b. (a -> b) -> a -> b
$ RunSimplifier
-> HscEnv -> ModSummary -> TcGblEnv -> IO (IdeResult ModGuts)
compileModule (Bool -> RunSimplifier
RunSimplifier Bool
True) HscEnv
hsc (ParsedModule -> ModSummary
pm_mod_summary ParsedModule
pm) (TcGblEnv -> IO (IdeResult ModGuts))
-> TcGblEnv -> IO (IdeResult ModGuts)
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
tmr
ShakeExtras
se <- Action ShakeExtras
getShakeExtras
([FileDiagnostic]
diags'', !Maybe HiFileResult
res) <- ShakeExtras
-> HscEnv
-> Maybe LinkableType
-> Action (IdeResult ModGuts)
-> TcModuleResult
-> Action (IdeResult HiFileResult)
writeCoreFileIfNeeded ShakeExtras
se HscEnv
hsc Maybe LinkableType
compNeeded Action (IdeResult ModGuts)
compile TcModuleResult
tmr
[FileDiagnostic]
hiDiags <- case Maybe HiFileResult
res of
Just !HiFileResult
hiFile -> do
ShakeExtras
se' <- Action ShakeExtras
getShakeExtras
([FileDiagnostic]
gDiags, Maybe (HieASTs Type)
masts) <- IO ([FileDiagnostic], Maybe (HieASTs Type))
-> Action ([FileDiagnostic], Maybe (HieASTs Type))
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([FileDiagnostic], Maybe (HieASTs Type))
-> Action ([FileDiagnostic], Maybe (HieASTs Type)))
-> IO ([FileDiagnostic], Maybe (HieASTs Type))
-> Action ([FileDiagnostic], Maybe (HieASTs Type))
forall a b. (a -> b) -> a -> b
$ HscEnv
-> TcModuleResult -> IO ([FileDiagnostic], Maybe (HieASTs Type))
generateHieAsts HscEnv
hsc TcModuleResult
tmr
ByteString
source <- NormalizedFilePath -> Action ByteString
getSourceFileSource NormalizedFilePath
f
Maybe [FileDiagnostic]
wDiags <- Maybe (HieASTs Type)
-> (HieASTs Type -> Action [FileDiagnostic])
-> Action (Maybe [FileDiagnostic])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (HieASTs Type)
masts ((HieASTs Type -> Action [FileDiagnostic])
-> Action (Maybe [FileDiagnostic]))
-> (HieASTs Type -> Action [FileDiagnostic])
-> Action (Maybe [FileDiagnostic])
forall a b. (a -> b) -> a -> b
$ \HieASTs Type
asts ->
IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FileDiagnostic] -> Action [FileDiagnostic])
-> IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ HscEnv
-> ShakeExtras
-> ModSummary
-> NormalizedFilePath
-> [AvailInfo]
-> HieASTs Type
-> ByteString
-> IO [FileDiagnostic]
writeAndIndexHieFile HscEnv
hsc ShakeExtras
se' (TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr) NormalizedFilePath
f (TcGblEnv -> [AvailInfo]
tcg_exports (TcGblEnv -> [AvailInfo]) -> TcGblEnv -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
tmr) HieASTs Type
asts ByteString
source
[FileDiagnostic]
hiDiags <- if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> Bool
tmrDeferredError TcModuleResult
tmr
then IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FileDiagnostic] -> Action [FileDiagnostic])
-> IO [FileDiagnostic] -> Action [FileDiagnostic]
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> HscEnv -> HiFileResult -> IO [FileDiagnostic]
writeHiFile ShakeExtras
se' HscEnv
hsc HiFileResult
hiFile
else [FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
[FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
hiDiags [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
gDiags [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> Maybe [FileDiagnostic] -> [FileDiagnostic]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Maybe [FileDiagnostic]
wDiags)
Maybe HiFileResult
Nothing -> [FileDiagnostic] -> Action [FileDiagnostic]
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
IdeResult HiFileResult -> Action (IdeResult HiFileResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileDiagnostic]
diags [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
diags' [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
diags'' [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
hiDiags, Maybe HiFileResult
res)
writeCoreFileIfNeeded :: ShakeExtras -> HscEnv -> Maybe LinkableType -> Action (IdeResult ModGuts) -> TcModuleResult -> Action (IdeResult HiFileResult)
writeCoreFileIfNeeded :: ShakeExtras
-> HscEnv
-> Maybe LinkableType
-> Action (IdeResult ModGuts)
-> TcModuleResult
-> Action (IdeResult HiFileResult)
writeCoreFileIfNeeded ShakeExtras
_ HscEnv
hsc Maybe LinkableType
Nothing Action (IdeResult ModGuts)
_ TcModuleResult
tmr = do
Action ()
incrementRebuildCount
HiFileResult
res <- IO HiFileResult -> Action HiFileResult
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HiFileResult -> Action HiFileResult)
-> IO HiFileResult -> Action HiFileResult
forall a b. (a -> b) -> a -> b
$ HscEnv -> TcModuleResult -> IO HiFileResult
mkHiFileResultNoCompile HscEnv
hsc TcModuleResult
tmr
IdeResult HiFileResult -> Action (IdeResult HiFileResult)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], HiFileResult -> Maybe HiFileResult
forall a. a -> Maybe a
Just (HiFileResult -> Maybe HiFileResult)
-> HiFileResult -> Maybe HiFileResult
forall a b. (a -> b) -> a -> b
$! HiFileResult
res)
writeCoreFileIfNeeded ShakeExtras
se HscEnv
hsc (Just LinkableType
_) Action (IdeResult ModGuts)
getGuts TcModuleResult
tmr = do
Action ()
incrementRebuildCount
([FileDiagnostic]
diags, Maybe ModGuts
mguts) <- Action (IdeResult ModGuts)
getGuts
case Maybe ModGuts
mguts of
Maybe ModGuts
Nothing -> IdeResult HiFileResult -> Action (IdeResult HiFileResult)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags, Maybe HiFileResult
forall a. Maybe a
Nothing)
Just ModGuts
guts -> do
([FileDiagnostic]
diags', !Maybe HiFileResult
res) <- IO (IdeResult HiFileResult) -> Action (IdeResult HiFileResult)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult HiFileResult) -> Action (IdeResult HiFileResult))
-> IO (IdeResult HiFileResult) -> Action (IdeResult HiFileResult)
forall a b. (a -> b) -> a -> b
$ ShakeExtras
-> HscEnv
-> TcModuleResult
-> ModGuts
-> IO (IdeResult HiFileResult)
mkHiFileResultCompile ShakeExtras
se HscEnv
hsc TcModuleResult
tmr ModGuts
guts
IdeResult HiFileResult -> Action (IdeResult HiFileResult)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags[FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. [a] -> [a] -> [a]
++[FileDiagnostic]
diags', Maybe HiFileResult
res)
getClientSettingsRule :: Recorder (WithPriority Log) -> Rules ()
getClientSettingsRule :: Recorder (WithPriority Log) -> Rules ()
getClientSettingsRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (GetClientSettings -> Action (ByteString, Hashed (Maybe Value)))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((GetClientSettings -> Action (ByteString, Hashed (Maybe Value)))
-> Rules ())
-> (GetClientSettings -> Action (ByteString, Hashed (Maybe Value)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetClientSettings
GetClientSettings -> do
Action ()
alwaysRerun
Hashed (Maybe Value)
settings <- IdeConfiguration -> Hashed (Maybe Value)
clientSettings (IdeConfiguration -> Hashed (Maybe Value))
-> Action IdeConfiguration -> Action (Hashed (Maybe Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action IdeConfiguration
getIdeConfiguration
(ByteString, Hashed (Maybe Value))
-> Action (ByteString, Hashed (Maybe Value))
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ Hashed (Maybe Value) -> Int
forall a. Hashable a => a -> Int
hash Hashed (Maybe Value)
settings, Hashed (Maybe Value)
settings)
usePropertyAction ::
(HasProperty s k t r) =>
KeyNameProxy s ->
PluginId ->
Properties r ->
Action (ToHsType t)
usePropertyAction :: forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
(r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction KeyNameProxy s
kn PluginId
plId Properties r
p = do
PluginConfig
pluginConfig <- PluginId -> Action PluginConfig
getPluginConfigAction PluginId
plId
ToHsType t -> Action (ToHsType t)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ToHsType t -> Action (ToHsType t))
-> ToHsType t -> Action (ToHsType t)
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> Properties r -> Object -> ToHsType t
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
(r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> Object -> ToHsType t
useProperty KeyNameProxy s
kn Properties r
p (Object -> ToHsType t) -> Object -> ToHsType t
forall a b. (a -> b) -> a -> b
$ PluginConfig -> Object
plcConfig PluginConfig
pluginConfig
usePropertyByPathAction ::
(HasPropertyByPath props path t) =>
KeyNamePath path ->
PluginId ->
Properties props ->
Action (ToHsType t)
usePropertyByPathAction :: forall (props :: [PropertyKey]) (path :: NonEmptyList Symbol)
(t :: PropertyType).
HasPropertyByPath props path t =>
KeyNamePath path
-> PluginId -> Properties props -> Action (ToHsType t)
usePropertyByPathAction KeyNamePath path
path PluginId
plId Properties props
p = do
PluginConfig
pluginConfig <- PluginId -> Action PluginConfig
getPluginConfigAction PluginId
plId
ToHsType t -> Action (ToHsType t)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ToHsType t -> Action (ToHsType t))
-> ToHsType t -> Action (ToHsType t)
forall a b. (a -> b) -> a -> b
$ KeyNamePath path
-> Properties props
-> Object
-> ToHsType (FindByKeyPath path props)
forall (rs :: [PropertyKey]) (r :: NonEmptyList Symbol).
ParsePropertyPath rs r =>
KeyNamePath r
-> Properties rs -> Object -> ToHsType (FindByKeyPath r rs)
usePropertyByPath KeyNamePath path
path Properties props
p (Object -> ToHsType (FindByKeyPath path props))
-> Object -> ToHsType (FindByKeyPath path props)
forall a b. (a -> b) -> a -> b
$ PluginConfig -> Object
plcConfig PluginConfig
pluginConfig
getLinkableRule :: Recorder (WithPriority Log) -> Rules ()
getLinkableRule :: Recorder (WithPriority Log) -> Rules ()
getLinkableRule Recorder (WithPriority Log)
recorder =
Recorder (WithPriority Log)
-> RuleBody GetLinkable LinkableResult -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GetLinkable LinkableResult -> Rules ())
-> RuleBody GetLinkable LinkableResult -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetLinkable
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult LinkableResult))
-> RuleBody GetLinkable LinkableResult
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
Rule ((GetLinkable
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult LinkableResult))
-> RuleBody GetLinkable LinkableResult)
-> (GetLinkable
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult LinkableResult))
-> RuleBody GetLinkable LinkableResult
forall a b. (a -> b) -> a -> b
$ \GetLinkable
GetLinkable NormalizedFilePath
f -> do
ModSummaryResult{msrModSummary :: ModSummaryResult -> ModSummary
msrModSummary = ModSummary
ms} <- GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
f
HiFileResult{ModIface
hirModIface :: HiFileResult -> ModIface
hirModIface :: ModIface
hirModIface, ModDetails
hirModDetails :: HiFileResult -> ModDetails
hirModDetails :: ModDetails
hirModDetails, Maybe (CoreFile, ByteString)
hirCoreFp :: HiFileResult -> Maybe (CoreFile, ByteString)
hirCoreFp :: Maybe (CoreFile, ByteString)
hirCoreFp} <- GetModIface -> NormalizedFilePath -> Action HiFileResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModIface
GetModIface NormalizedFilePath
f
let obj_file :: [Char]
obj_file = ModLocation -> [Char]
ml_obj_file (ModSummary -> ModLocation
ms_location ModSummary
ms)
core_file :: [Char]
core_file = ModLocation -> [Char]
ml_core_file (ModSummary -> ModLocation
ms_location ModSummary
ms)
case Maybe (CoreFile, ByteString)
hirCoreFp of
Maybe (CoreFile, ByteString)
Nothing -> [Char] -> Action (Maybe ByteString, IdeResult LinkableResult)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Action (Maybe ByteString, IdeResult LinkableResult))
-> [Char] -> Action (Maybe ByteString, IdeResult LinkableResult)
forall a b. (a -> b) -> a -> b
$ [Char]
"called GetLinkable for a file without a linkable: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> [Char]
forall a. Show a => a -> [Char]
show NormalizedFilePath
f
Just (CoreFile
bin_core, ByteString
fileHash) -> do
HscEnvEq
session <- GhcSessionDeps -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSessionDeps
GhcSessionDeps NormalizedFilePath
f
LinkableType
linkableType <- NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType NormalizedFilePath
f Action (Maybe LinkableType)
-> (Maybe LinkableType -> Action LinkableType)
-> Action LinkableType
forall a b. Action a -> (a -> Action b) -> Action b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe LinkableType
Nothing -> [Char] -> Action LinkableType
forall a. HasCallStack => [Char] -> a
error ([Char] -> Action LinkableType) -> [Char] -> Action LinkableType
forall a b. (a -> b) -> a -> b
$ [Char]
"called GetLinkable for a file which doesn't need compilation: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> [Char]
forall a. Show a => a -> [Char]
show NormalizedFilePath
f
Just LinkableType
t -> LinkableType -> Action LinkableType
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LinkableType
t
POSIXTime
core_t <- IO POSIXTime -> Action POSIXTime
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO POSIXTime -> Action POSIXTime)
-> IO POSIXTime -> Action POSIXTime
forall a b. (a -> b) -> a -> b
$ [Char] -> IO POSIXTime
getModTime [Char]
core_file
([FileDiagnostic]
warns, Maybe HomeModInfo
hmi) <- case LinkableType
linkableType of
LinkableType
BCOLinkable -> IO ([FileDiagnostic], Maybe HomeModInfo)
-> Action ([FileDiagnostic], Maybe HomeModInfo)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([FileDiagnostic], Maybe HomeModInfo)
-> Action ([FileDiagnostic], Maybe HomeModInfo))
-> IO ([FileDiagnostic], Maybe HomeModInfo)
-> Action ([FileDiagnostic], Maybe HomeModInfo)
forall a b. (a -> b) -> a -> b
$ LinkableType
-> HscEnv
-> ModSummary
-> ModIface
-> ModDetails
-> CoreFile
-> UTCTime
-> IO ([FileDiagnostic], Maybe HomeModInfo)
coreFileToLinkable LinkableType
linkableType (HscEnvEq -> HscEnv
hscEnv HscEnvEq
session) ModSummary
ms ModIface
hirModIface ModDetails
hirModDetails CoreFile
bin_core (POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
core_t)
LinkableType
ObjectLinkable -> do
Bool
exists <- IO Bool -> Action Bool
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Action Bool) -> IO Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
obj_file
Maybe POSIXTime
mobj_time <- IO (Maybe POSIXTime) -> Action (Maybe POSIXTime)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe POSIXTime) -> Action (Maybe POSIXTime))
-> IO (Maybe POSIXTime) -> Action (Maybe POSIXTime)
forall a b. (a -> b) -> a -> b
$
if Bool
exists
then POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (POSIXTime -> Maybe POSIXTime)
-> IO POSIXTime -> IO (Maybe POSIXTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO POSIXTime
getModTime [Char]
obj_file
else Maybe POSIXTime -> IO (Maybe POSIXTime)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe POSIXTime
forall a. Maybe a
Nothing
case Maybe POSIXTime
mobj_time of
Just POSIXTime
obj_t
| POSIXTime
obj_t POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
>= POSIXTime
core_t -> ([FileDiagnostic], Maybe HomeModInfo)
-> Action ([FileDiagnostic], Maybe HomeModInfo)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], HomeModInfo -> Maybe HomeModInfo
forall a. a -> Maybe a
Just (HomeModInfo -> Maybe HomeModInfo)
-> HomeModInfo -> Maybe HomeModInfo
forall a b. (a -> b) -> a -> b
$ ModIface -> ModDetails -> HomeModLinkable -> HomeModInfo
HomeModInfo ModIface
hirModIface ModDetails
hirModDetails (Linkable -> HomeModLinkable
justObjects (Linkable -> HomeModLinkable) -> Linkable -> HomeModLinkable
forall a b. (a -> b) -> a -> b
$ UTCTime -> GenModule Unit -> [Unlinked] -> Linkable
LM (POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
obj_t) (ModSummary -> GenModule Unit
ms_mod ModSummary
ms) [[Char] -> Unlinked
DotO [Char]
obj_file]))
Maybe POSIXTime
_ -> IO ([FileDiagnostic], Maybe HomeModInfo)
-> Action ([FileDiagnostic], Maybe HomeModInfo)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([FileDiagnostic], Maybe HomeModInfo)
-> Action ([FileDiagnostic], Maybe HomeModInfo))
-> IO ([FileDiagnostic], Maybe HomeModInfo)
-> Action ([FileDiagnostic], Maybe HomeModInfo)
forall a b. (a -> b) -> a -> b
$ LinkableType
-> HscEnv
-> ModSummary
-> ModIface
-> ModDetails
-> CoreFile
-> UTCTime
-> IO ([FileDiagnostic], Maybe HomeModInfo)
coreFileToLinkable LinkableType
linkableType (HscEnvEq -> HscEnv
hscEnv HscEnvEq
session) ModSummary
ms ModIface
hirModIface ModDetails
hirModDetails CoreFile
bin_core ([Char] -> UTCTime
forall a. HasCallStack => [Char] -> a
error [Char]
"object doesn't have time")
Maybe Linkable -> (Linkable -> Action ()) -> Action ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust ((HomeModInfo -> Maybe Linkable
homeModInfoByteCode (HomeModInfo -> Maybe Linkable)
-> Maybe HomeModInfo -> Maybe Linkable
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe HomeModInfo
hmi) Maybe Linkable -> Maybe Linkable -> Maybe Linkable
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HomeModInfo -> Maybe Linkable
homeModInfoObject (HomeModInfo -> Maybe Linkable)
-> Maybe HomeModInfo -> Maybe Linkable
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe HomeModInfo
hmi)) ((Linkable -> Action ()) -> Action ())
-> (Linkable -> Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ \(LM UTCTime
time GenModule Unit
mod [Unlinked]
_) -> do
Var (ModuleEnv UTCTime)
compiledLinkables <- CompiledLinkables -> Var (ModuleEnv UTCTime)
getCompiledLinkables (CompiledLinkables -> Var (ModuleEnv UTCTime))
-> Action CompiledLinkables -> Action (Var (ModuleEnv UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action CompiledLinkables
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
IO () -> Action ()
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Var (ModuleEnv UTCTime)
-> (ModuleEnv UTCTime -> IO (ModuleEnv UTCTime, ())) -> IO ()
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var (ModuleEnv UTCTime)
compiledLinkables ((ModuleEnv UTCTime -> IO (ModuleEnv UTCTime, ())) -> IO ())
-> (ModuleEnv UTCTime -> IO (ModuleEnv UTCTime, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ModuleEnv UTCTime
old -> do
let !to_keep :: ModuleEnv UTCTime
to_keep = ModuleEnv UTCTime -> GenModule Unit -> UTCTime -> ModuleEnv UTCTime
forall a. ModuleEnv a -> GenModule Unit -> a -> ModuleEnv a
extendModuleEnv ModuleEnv UTCTime
old GenModule Unit
mod UTCTime
time
HscEnv -> [Linkable] -> IO ()
unload (HscEnvEq -> HscEnv
hscEnv HscEnvEq
session) (((GenModule Unit, UTCTime) -> Linkable)
-> [(GenModule Unit, UTCTime)] -> [Linkable]
forall a b. (a -> b) -> [a] -> [b]
map (\(GenModule Unit
mod', UTCTime
time') -> UTCTime -> GenModule Unit -> [Unlinked] -> Linkable
LM UTCTime
time' GenModule Unit
mod' []) ([(GenModule Unit, UTCTime)] -> [Linkable])
-> [(GenModule Unit, UTCTime)] -> [Linkable]
forall a b. (a -> b) -> a -> b
$ ModuleEnv UTCTime -> [(GenModule Unit, UTCTime)]
forall a. ModuleEnv a -> [(GenModule Unit, a)]
moduleEnvToList ModuleEnv UTCTime
to_keep)
(ModuleEnv UTCTime, ()) -> IO (ModuleEnv UTCTime, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleEnv UTCTime
to_keep, ())
(Maybe ByteString, IdeResult LinkableResult)
-> Action (Maybe ByteString, IdeResult LinkableResult)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
fileHash ByteString -> Maybe HomeModInfo -> Maybe ByteString
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe HomeModInfo
hmi, ([FileDiagnostic]
warns, HomeModInfo -> ByteString -> LinkableResult
LinkableResult (HomeModInfo -> ByteString -> LinkableResult)
-> Maybe HomeModInfo -> Maybe (ByteString -> LinkableResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HomeModInfo
hmi Maybe (ByteString -> LinkableResult)
-> Maybe ByteString -> Maybe LinkableResult
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
fileHash))
getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType NormalizedFilePath
f = NeedsCompilation
-> NormalizedFilePath -> Action (Maybe LinkableType)
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ NeedsCompilation
NeedsCompilation NormalizedFilePath
f
needsCompilationRule :: NormalizedFilePath -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
needsCompilationRule :: NormalizedFilePath
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
needsCompilationRule NormalizedFilePath
file
| [Char]
"boot" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` NormalizedFilePath -> [Char]
fromNormalizedFilePath NormalizedFilePath
file =
IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Maybe LinkableType -> ByteString
encodeLinkableType Maybe LinkableType
forall a. Maybe a
Nothing, Maybe LinkableType -> Maybe (Maybe LinkableType)
forall a. a -> Maybe a
Just Maybe LinkableType
forall a. Maybe a
Nothing)
needsCompilationRule NormalizedFilePath
file = do
Maybe DependencyInformation
graph <- GetModuleGraph -> Action (Maybe DependencyInformation)
forall k v. IdeRule k v => k -> Action (Maybe v)
useNoFile GetModuleGraph
GetModuleGraph
Maybe LinkableType
res <- case Maybe DependencyInformation
graph of
Maybe DependencyInformation
Nothing -> Maybe LinkableType -> Action (Maybe LinkableType)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LinkableType
forall a. Maybe a
Nothing
Just DependencyInformation
depinfo -> case NormalizedFilePath
-> DependencyInformation -> Maybe [NormalizedFilePath]
immediateReverseDependencies NormalizedFilePath
file DependencyInformation
depinfo of
Maybe [NormalizedFilePath]
Nothing -> [Char] -> Action (Maybe LinkableType)
forall a. [Char] -> Action a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Action (Maybe LinkableType))
-> [Char] -> Action (Maybe LinkableType)
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to get the immediate reverse dependencies of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> [Char]
forall a. Show a => a -> [Char]
show NormalizedFilePath
file
Just [NormalizedFilePath]
revdeps -> do
([Maybe ModSummary]
modsums,[Maybe (Maybe LinkableType)]
needsComps) <- ([Maybe ModSummary]
-> [Maybe (Maybe LinkableType)]
-> ([Maybe ModSummary], [Maybe (Maybe LinkableType)]))
-> Action [Maybe ModSummary]
-> Action [Maybe (Maybe LinkableType)]
-> Action ([Maybe ModSummary], [Maybe (Maybe LinkableType)])
forall a b c. (a -> b -> c) -> Action a -> Action b -> Action c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
(,) ((Maybe (ModSummaryResult, PositionMapping) -> Maybe ModSummary)
-> [Maybe (ModSummaryResult, PositionMapping)]
-> [Maybe ModSummary]
forall a b. (a -> b) -> [a] -> [b]
map (((ModSummaryResult, PositionMapping) -> ModSummary)
-> Maybe (ModSummaryResult, PositionMapping) -> Maybe ModSummary
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummaryResult -> ModSummary
msrModSummary (ModSummaryResult -> ModSummary)
-> ((ModSummaryResult, PositionMapping) -> ModSummaryResult)
-> (ModSummaryResult, PositionMapping)
-> ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModSummaryResult, PositionMapping) -> ModSummaryResult
forall a b. (a, b) -> a
fst)) ([Maybe (ModSummaryResult, PositionMapping)] -> [Maybe ModSummary])
-> Action [Maybe (ModSummaryResult, PositionMapping)]
-> Action [Maybe ModSummary]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> [NormalizedFilePath]
-> Action [Maybe (ModSummaryResult, PositionMapping)]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k
-> f NormalizedFilePath -> Action (f (Maybe (v, PositionMapping)))
usesWithStale GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps [NormalizedFilePath]
revdeps)
(NeedsCompilation
-> [NormalizedFilePath] -> Action [Maybe (Maybe LinkableType)]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses NeedsCompilation
NeedsCompilation [NormalizedFilePath]
revdeps)
Maybe LinkableType -> Action (Maybe LinkableType)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LinkableType -> Action (Maybe LinkableType))
-> Maybe LinkableType -> Action (Maybe LinkableType)
forall a b. (a -> b) -> a -> b
$ [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
computeLinkableType [Maybe ModSummary]
modsums ((Maybe (Maybe LinkableType) -> Maybe LinkableType)
-> [Maybe (Maybe LinkableType)] -> [Maybe LinkableType]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (Maybe LinkableType) -> Maybe LinkableType
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [Maybe (Maybe LinkableType)]
needsComps)
IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Maybe LinkableType -> ByteString
encodeLinkableType Maybe LinkableType
res, Maybe LinkableType -> Maybe (Maybe LinkableType)
forall a. a -> Maybe a
Just Maybe LinkableType
res)
where
computeLinkableType :: [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
computeLinkableType :: [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
computeLinkableType [Maybe ModSummary]
deps [Maybe LinkableType]
xs
| LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
ObjectLinkable Maybe LinkableType -> [Maybe LinkableType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe LinkableType]
xs = LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
ObjectLinkable
| LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
BCOLinkable Maybe LinkableType -> [Maybe LinkableType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe LinkableType]
xs = LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
BCOLinkable
| (Maybe ModSummary -> Bool) -> [Maybe ModSummary] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> (ModSummary -> Bool) -> Maybe ModSummary -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ModSummary -> Bool
uses_th_qq) [Maybe ModSummary]
deps = LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
BCOLinkable
| Bool
otherwise = Maybe LinkableType
forall a. Maybe a
Nothing
uses_th_qq :: ModSummary -> Bool
uses_th_qq :: ModSummary -> Bool
uses_th_qq (ModSummary -> DynFlags
ms_hspp_opts -> DynFlags
dflags) =
Extension -> DynFlags -> Bool
xopt Extension
LangExt.TemplateHaskell DynFlags
dflags Bool -> Bool -> Bool
|| Extension -> DynFlags -> Bool
xopt Extension
LangExt.QuasiQuotes DynFlags
dflags
newtype CompiledLinkables = CompiledLinkables { CompiledLinkables -> Var (ModuleEnv UTCTime)
getCompiledLinkables :: Var (ModuleEnv UTCTime) }
instance IsIdeGlobal CompiledLinkables
data RulesConfig = RulesConfig
{
RulesConfig -> Bool
fullModuleGraph :: Bool
, RulesConfig -> Bool
enableTemplateHaskell :: Bool
, RulesConfig -> LspT Config IO ()
templateHaskellWarning :: LspT Config IO ()
}
instance Default RulesConfig where
def :: RulesConfig
def = Bool -> Bool -> LspT Config IO () -> RulesConfig
RulesConfig Bool
True Bool
True LspT Config IO ()
forall c. LspT c IO ()
displayTHWarning
where
displayTHWarning :: LspT c IO ()
displayTHWarning :: forall c. LspT c IO ()
displayTHWarning
| Bool -> Bool
not Bool
isWindows Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hostIsDynamic = do
SServerMethod 'Method_WindowShowMessage
-> MessageParams 'Method_WindowShowMessage -> LspT c IO ()
forall (m :: Method 'ServerToClient 'Notification) (f :: * -> *)
config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'Method_WindowShowMessage
SMethod_WindowShowMessage (MessageParams 'Method_WindowShowMessage -> LspT c IO ())
-> MessageParams 'Method_WindowShowMessage -> LspT c IO ()
forall a b. (a -> b) -> a -> b
$
MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MessageType_Info Text
thWarningMessage
| Bool
otherwise = () -> LspT c IO ()
forall a. a -> LspT c IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
thWarningMessage :: T.Text
thWarningMessage :: Text
thWarningMessage = [Text] -> Text
T.unwords
[ Text
"This HLS binary does not support Template Haskell."
, Text
"Follow the [instructions](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
templateHaskellInstructions Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
, Text
"to build an HLS binary with support for Template Haskell."
]
mainRule :: Recorder (WithPriority Log) -> RulesConfig -> Rules ()
mainRule :: Recorder (WithPriority Log) -> RulesConfig -> Rules ()
mainRule Recorder (WithPriority Log)
recorder RulesConfig{Bool
LspT Config IO ()
$sel:fullModuleGraph:RulesConfig :: RulesConfig -> Bool
$sel:enableTemplateHaskell:RulesConfig :: RulesConfig -> Bool
$sel:templateHaskellWarning:RulesConfig :: RulesConfig -> LspT Config IO ()
fullModuleGraph :: Bool
enableTemplateHaskell :: Bool
templateHaskellWarning :: LspT Config IO ()
..} = do
Var (ModuleEnv UTCTime)
linkables <- IO (Var (ModuleEnv UTCTime)) -> Rules (Var (ModuleEnv UTCTime))
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Var (ModuleEnv UTCTime)) -> Rules (Var (ModuleEnv UTCTime)))
-> IO (Var (ModuleEnv UTCTime)) -> Rules (Var (ModuleEnv UTCTime))
forall a b. (a -> b) -> a -> b
$ ModuleEnv UTCTime -> IO (Var (ModuleEnv UTCTime))
forall a. a -> IO (Var a)
newVar ModuleEnv UTCTime
forall a. ModuleEnv a
emptyModuleEnv
CompiledLinkables -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (CompiledLinkables -> Rules ()) -> CompiledLinkables -> Rules ()
forall a b. (a -> b) -> a -> b
$ Var (ModuleEnv UTCTime) -> CompiledLinkables
CompiledLinkables Var (ModuleEnv UTCTime)
linkables
TVar Int
rebuildCountVar <- IO (TVar Int) -> Rules (TVar Int)
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar Int) -> Rules (TVar Int))
-> IO (TVar Int) -> Rules (TVar Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
RebuildCounter -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (RebuildCounter -> Rules ()) -> RebuildCounter -> Rules ()
forall a b. (a -> b) -> a -> b
$ TVar Int -> RebuildCounter
RebuildCounter TVar Int
rebuildCountVar
Recorder (WithPriority Log) -> Rules ()
getParsedModuleRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getParsedModuleWithCommentsRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getLocatedImportsRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
reportImportCyclesRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
typeCheckRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getDocMapRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> GhcSessionDepsConfig -> Rules ()
loadGhcSession Recorder (WithPriority Log)
recorder GhcSessionDepsConfig{Bool
$sel:fullModuleGraph:GhcSessionDepsConfig :: Bool
fullModuleGraph :: Bool
fullModuleGraph}
Recorder (WithPriority Log) -> Rules ()
getModIfaceFromDiskRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getModIfaceFromDiskAndIndexRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getModIfaceRule Recorder (WithPriority Log)
recorder
LspT Config IO () -> Recorder (WithPriority Log) -> Rules ()
getModSummaryRule LspT Config IO ()
templateHaskellWarning Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getModuleGraphRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
knownFilesRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getClientSettingsRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getHieAstsRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getBindingsRule Recorder (WithPriority Log)
recorder
if Bool
enableTemplateHaskell
then Recorder (WithPriority Log)
-> RuleBody NeedsCompilation (Maybe LinkableType) -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody NeedsCompilation (Maybe LinkableType) -> Rules ())
-> RuleBody NeedsCompilation (Maybe LinkableType) -> Rules ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString -> Bool)
-> (NeedsCompilation
-> NormalizedFilePath
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)))
-> RuleBody NeedsCompilation (Maybe LinkableType)
forall k v.
(ByteString -> ByteString -> Bool)
-> (k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleWithCustomNewnessCheck ByteString -> ByteString -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ((NeedsCompilation
-> NormalizedFilePath
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)))
-> RuleBody NeedsCompilation (Maybe LinkableType))
-> (NeedsCompilation
-> NormalizedFilePath
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType)))
-> RuleBody NeedsCompilation (Maybe LinkableType)
forall a b. (a -> b) -> a -> b
$ \NeedsCompilation
NeedsCompilation NormalizedFilePath
file ->
NormalizedFilePath
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
needsCompilationRule NormalizedFilePath
file
else Recorder (WithPriority Log)
-> (NeedsCompilation
-> NormalizedFilePath -> Action (Maybe (Maybe LinkableType)))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) ((NeedsCompilation
-> NormalizedFilePath -> Action (Maybe (Maybe LinkableType)))
-> Rules ())
-> (NeedsCompilation
-> NormalizedFilePath -> Action (Maybe (Maybe LinkableType)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NeedsCompilation
NeedsCompilation NormalizedFilePath
_ -> Maybe (Maybe LinkableType) -> Action (Maybe (Maybe LinkableType))
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe LinkableType) -> Action (Maybe (Maybe LinkableType)))
-> Maybe (Maybe LinkableType)
-> Action (Maybe (Maybe LinkableType))
forall a b. (a -> b) -> a -> b
$ Maybe LinkableType -> Maybe (Maybe LinkableType)
forall a. a -> Maybe a
Just Maybe LinkableType
forall a. Maybe a
Nothing
Recorder (WithPriority Log) -> Rules ()
generateCoreRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
getImportMapRule Recorder (WithPriority Log)
recorder
Recorder (WithPriority Log) -> Rules ()
persistentHieFileRule Recorder (WithPriority Log)
recorder
Rules ()
persistentDocMapRule
Rules ()
persistentImportMapRule
Recorder (WithPriority Log) -> Rules ()
getLinkableRule Recorder (WithPriority Log)
recorder
getHieFile :: NormalizedFilePath -> Action (Maybe HieFile)
getHieFile :: NormalizedFilePath -> Action (Maybe HieFile)
getHieFile NormalizedFilePath
nfp = MaybeT Action HieFile -> Action (Maybe HieFile)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Action HieFile -> Action (Maybe HieFile))
-> MaybeT Action HieFile -> Action (Maybe HieFile)
forall a b. (a -> b) -> a -> b
$ do
HAR {HieASTs a
hieAst :: HieASTs a
hieAst :: ()
hieAst} <- Action (Maybe HieAstResult) -> MaybeT Action HieAstResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe HieAstResult) -> MaybeT Action HieAstResult)
-> Action (Maybe HieAstResult) -> MaybeT Action HieAstResult
forall a b. (a -> b) -> a -> b
$ GetHieAst -> NormalizedFilePath -> Action (Maybe HieAstResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetHieAst
GetHieAst NormalizedFilePath
nfp
TcModuleResult
tmr <- Action (Maybe TcModuleResult) -> MaybeT Action TcModuleResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe TcModuleResult) -> MaybeT Action TcModuleResult)
-> Action (Maybe TcModuleResult) -> MaybeT Action TcModuleResult
forall a b. (a -> b) -> a -> b
$ TypeCheck -> NormalizedFilePath -> Action (Maybe TcModuleResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
nfp
HscEnvEq
ghc <- Action (Maybe HscEnvEq) -> MaybeT Action HscEnvEq
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe HscEnvEq) -> MaybeT Action HscEnvEq)
-> Action (Maybe HscEnvEq) -> MaybeT Action HscEnvEq
forall a b. (a -> b) -> a -> b
$ GhcSession -> NormalizedFilePath -> Action (Maybe HscEnvEq)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSession
GhcSession NormalizedFilePath
nfp
ModSummaryResult
msr <- Action (Maybe ModSummaryResult) -> MaybeT Action ModSummaryResult
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe ModSummaryResult) -> MaybeT Action ModSummaryResult)
-> Action (Maybe ModSummaryResult)
-> MaybeT Action ModSummaryResult
forall a b. (a -> b) -> a -> b
$ GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action (Maybe ModSummaryResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
nfp
ByteString
source <- Action ByteString -> MaybeT Action ByteString
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Action ByteString -> MaybeT Action ByteString)
-> Action ByteString -> MaybeT Action ByteString
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Action ByteString
getSourceFileSource NormalizedFilePath
nfp
let exports :: [AvailInfo]
exports = TcGblEnv -> [AvailInfo]
tcg_exports (TcGblEnv -> [AvailInfo]) -> TcGblEnv -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> TcGblEnv
tmrTypechecked TcModuleResult
tmr
HieASTs Type
typedAst <- Action (Maybe (HieASTs Type)) -> MaybeT Action (HieASTs Type)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe (HieASTs Type)) -> MaybeT Action (HieASTs Type))
-> Action (Maybe (HieASTs Type)) -> MaybeT Action (HieASTs Type)
forall a b. (a -> b) -> a -> b
$ Maybe (HieASTs Type) -> Action (Maybe (HieASTs Type))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HieASTs Type) -> Action (Maybe (HieASTs Type)))
-> Maybe (HieASTs Type) -> Action (Maybe (HieASTs Type))
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Maybe (HieASTs Type)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast HieASTs a
hieAst
IO HieFile -> MaybeT Action HieFile
forall a. IO a -> MaybeT Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HieFile -> MaybeT Action HieFile)
-> IO HieFile -> MaybeT Action HieFile
forall a b. (a -> b) -> a -> b
$ HscEnv -> Hsc HieFile -> IO HieFile
forall a. HscEnv -> Hsc a -> IO a
runHsc (HscEnvEq -> HscEnv
hscEnv HscEnvEq
ghc) (Hsc HieFile -> IO HieFile) -> Hsc HieFile -> IO HieFile
forall a b. (a -> b) -> a -> b
$ ModSummary
-> [AvailInfo] -> HieASTs Type -> ByteString -> Hsc HieFile
mkHieFile' (ModSummaryResult -> ModSummary
msrModSummary ModSummaryResult
msr) [AvailInfo]
exports HieASTs Type
typedAst ByteString
source