-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE TypeFamilies          #-}

-- | A Shake implementation of the compiler service, built
--   using the "Shaker" abstraction layer for in-memory use.
--
module Development.IDE.Core.Rules(
    -- * Types
    IdeState, GetParsedModule(..), TransitiveDependencies(..),
    Priority(..), GhcSessionIO(..), GetClientSettings(..),
    -- * Functions
    priorityTypeCheck,
    priorityGenerateCore,
    priorityFilesOfInterest,
    runAction,
    toIdeResult,
    defineNoFile,
    defineEarlyCutOffNoFile,
    mainRule,
    RulesConfig(..),
    getDependencies,
    getParsedModule,
    getParsedModuleWithComments,
    getClientConfigAction,
    usePropertyAction,
    -- * Rules
    CompiledLinkables(..),
    IsHiFileStable(..),
    getParsedModuleRule,
    getParsedModuleWithCommentsRule,
    getLocatedImportsRule,
    getDependencyInformationRule,
    reportImportCyclesRule,
    typeCheckRule,
    getDocMapRule,
    loadGhcSession,
    getModIfaceFromDiskRule,
    getModIfaceRule,
    getModSummaryRule,
    isHiFileStableRule,
    getModuleGraphRule,
    knownFilesRule,
    getClientSettingsRule,
    getHieAstsRule,
    getBindingsRule,
    needsCompilationRule,
    computeLinkableTypeForDynFlags,
    generateCoreRule,
    getImportMapRule,
    regenerateHiFile,
    ghcSessionDepsDefinition,
    getParsedModuleDefinition,
    typeCheckRuleDefinition,
    GhcSessionDepsConfig(..),
    ) where

#if !MIN_VERSION_ghc(8,8,0)
import           Control.Applicative                          (liftA2)
#endif
import           Control.Concurrent.Async                     (concurrently)
import           Control.Concurrent.Strict
import           Control.Exception.Safe
import           Control.Monad.Extra
import           Control.Monad.Reader
import           Control.Monad.State
import           Control.Monad.Trans.Except                   (ExceptT, except,
                                                               runExceptT)
import           Control.Monad.Trans.Maybe
import           Data.Aeson                                   (Result (Success),
                                                               toJSON)
import qualified Data.Aeson.Types                             as A
import qualified Data.Binary                                  as B
import qualified Data.ByteString                              as BS
import qualified Data.ByteString.Lazy                         as LBS
import           Data.Coerce
import           Data.Foldable
import qualified Data.HashMap.Strict                          as HM
import qualified Data.HashSet                                 as HashSet
import           Data.Hashable
import           Data.IORef
import           Data.IntMap.Strict                           (IntMap)
import qualified Data.IntMap.Strict                           as IntMap
import           Data.List
import qualified Data.Map                                     as M
import           Data.Maybe
import qualified Data.Rope.UTF16                              as Rope
import qualified Data.Set                                     as Set
import qualified Data.Text                                    as T
import qualified Data.Text.Encoding                           as T
import           Data.Time                                    (UTCTime (..))
import           Data.Tuple.Extra
import           Development.IDE.Core.Compile
import           Development.IDE.Core.FileExists
import           Development.IDE.Core.FileStore               (getFileContents,
                                                               modificationTime,
                                                               resetInterfaceStore)
import           Development.IDE.Core.IdeConfiguration
import           Development.IDE.Core.OfInterest
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat                   hiding
                                                              (parseModule,
                                                               TargetId(..),
                                                               loadInterface,
                                                               Var)
import qualified Development.IDE.GHC.Compat                   as Compat
import qualified Development.IDE.GHC.Compat.Util              as Util
import           Development.IDE.GHC.Error
import           Development.IDE.GHC.ExactPrint
import           Development.IDE.GHC.Util                     hiding
                                                              (modifyDynFlags)
import           Development.IDE.Graph
import           Development.IDE.Graph.Classes
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 qualified Development.IDE.Types.Logger                 as L
import           Development.IDE.Types.Options
import           GHC.Generics                                 (Generic)
import qualified GHC.LanguageExtensions                       as LangExt
import qualified HieDb
import           Ide.Plugin.Config
import qualified Language.LSP.Server                          as LSP
import           Language.LSP.Types                           (SMethod (SCustomMethod, SWindowShowMessage), ShowMessageParams (ShowMessageParams), MessageType (MtInfo))
import           Language.LSP.VFS
import           System.Directory                             (makeAbsolute)
import           Data.Default                                 (def, Default)
import           Ide.Plugin.Properties                        (HasProperty,
                                                               KeyNameProxy,
                                                               Properties,
                                                               ToHsType,
                                                               useProperty)
import           Ide.PluginUtils                              (configForPlugin)
import           Ide.Types                                    (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser),
                                                               PluginId)
import Control.Concurrent.STM.Stats (atomically)
import Language.LSP.Server (LspT)
import System.Info.Extra (isWindows)
import HIE.Bios.Ghc.Gap (hostIsDynamic)

templateHaskellInstructions :: T.Text
templateHaskellInstructions :: Text
templateHaskellInstructions = Text
"https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"

-- | This is useful for rules to convert rules that can only produce errors or
-- a result into the more general IdeResult type that supports producing
-- warnings while also producing a result.
toIdeResult :: Either [FileDiagnostic] v -> IdeResult v
toIdeResult :: 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)

------------------------------------------------------------
-- Exposed API
------------------------------------------------------------
-- | Get all transitive file dependencies of a given module.
-- Does not include the file itself.
getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
getDependencies :: NormalizedFilePath -> Action (Maybe [NormalizedFilePath])
getDependencies NormalizedFilePath
file =
    (TransitiveDependencies -> [NormalizedFilePath])
-> Maybe TransitiveDependencies -> Maybe [NormalizedFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TransitiveDependencies -> [NormalizedFilePath]
transitiveModuleDeps (Maybe TransitiveDependencies -> Maybe [NormalizedFilePath])
-> (DependencyInformation -> Maybe TransitiveDependencies)
-> DependencyInformation
-> Maybe [NormalizedFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DependencyInformation
-> NormalizedFilePath -> Maybe TransitiveDependencies
`transitiveDeps` NormalizedFilePath
file) (DependencyInformation -> Maybe [NormalizedFilePath])
-> Action DependencyInformation
-> Action (Maybe [NormalizedFilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetDependencyInformation
-> NormalizedFilePath -> Action DependencyInformation
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetDependencyInformation
GetDependencyInformation NormalizedFilePath
file

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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Action ByteString)
-> IO ByteString -> Action ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
nfp)
        Just Text
source -> ByteString -> Action ByteString
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

-- | Parse the contents of a haskell file.
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

-- | Parse the contents of a haskell file,
-- ensuring comments are preserved in annotations
getParsedModuleWithComments :: NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModuleWithComments :: NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModuleWithComments = GetParsedModuleWithComments
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModuleWithComments
GetParsedModuleWithComments

------------------------------------------------------------
-- Rules
-- These typically go from key to value and are oracles.

priorityTypeCheck :: Priority
priorityTypeCheck :: Priority
priorityTypeCheck = Double -> Priority
Priority Double
0

priorityGenerateCore :: Priority
priorityGenerateCore :: Priority
priorityGenerateCore = Double -> Priority
Priority (-Double
1)

priorityFilesOfInterest :: Priority
priorityFilesOfInterest :: Priority
priorityFilesOfInterest = Double -> Priority
Priority (-Double
2)

-- | WARNING:
-- We currently parse the module both with and without Opt_Haddock, and
-- return the one with Haddocks if it -- succeeds. However, this may not work
-- for hlint or any client code that might need the parsed source with all
-- annotations, including comments.
-- For that use case you might want to use `getParsedModuleWithCommentsRule`
-- See https://github.com/haskell/ghcide/pull/350#discussion_r370878197
-- and https://github.com/mpickering/ghcide/pull/22#issuecomment-625070490
-- GHC wiki about: https://gitlab.haskell.org/ghc/ghc/-/wikis/api-annotations
getParsedModuleRule :: Rules ()
getParsedModuleRule :: Rules ()
getParsedModuleRule =
  -- this rule does not have early cutoff since all its dependencies already have it
  (GetParsedModule
 -> NormalizedFilePath -> Action (IdeResult ParsedModule))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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'} <- GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
file
    HscEnvEq
sess <- GhcSession -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSession
GhcSession NormalizedFilePath
file
    let hsc :: HscEnv
hsc = HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess
    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 :: DynFlags
ms_hspp_opts = DynFlags -> DynFlags
modify_dflags (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms' }
        reset_ms :: ParsedModule -> ParsedModule
reset_ms ParsedModule
pm = ParsedModule
pm { pm_mod_summary :: ModSummary
pm_mod_summary = ModSummary
ms' }

    -- We still parse with Haddocks whether Opt_Haddock is True or False to collect information
    -- but we no longer need to parse with and without Haddocks separately for above GHC90.
    res :: IdeResult ParsedModule
res@([FileDiagnostic]
_,Maybe ParsedModule
pmod) <- if GhcVersion
Compat.ghcVersion GhcVersion -> GhcVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= GhcVersion
Compat.GHC90 then
      IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
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 (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 (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 (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)
    else do
        let dflags :: DynFlags
dflags    = ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms
            mainParse :: IO (IdeResult ParsedModule)
mainParse = HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
hsc IdeOptions
opt NormalizedFilePath
file ModSummary
ms

        -- Parse again (if necessary) to capture Haddock parse errors
        if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Haddock DynFlags
dflags
            then
                IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
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 (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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ParsedModule -> ParsedModule
reset_ms IO (IdeResult ParsedModule)
mainParse
            else do
                let haddockParse :: IO (IdeResult ParsedModule)
haddockParse = HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
hsc IdeOptions
opt NormalizedFilePath
file (ModSummary -> ModSummary
withOptHaddock ModSummary
ms)

                -- parse twice, with and without Haddocks, concurrently
                -- we cannot ignore Haddock parse errors because files of
                -- non-interest are always parsed with Haddocks
                -- If we can parse Haddocks, might as well use them
                (([FileDiagnostic]
diags,Maybe ParsedModule
res),([FileDiagnostic]
diagsh,Maybe ParsedModule
resh)) <- IO (IdeResult ParsedModule, IdeResult ParsedModule)
-> Action (IdeResult ParsedModule, IdeResult ParsedModule)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult ParsedModule, IdeResult ParsedModule)
 -> Action (IdeResult ParsedModule, IdeResult ParsedModule))
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
-> Action (IdeResult ParsedModule, IdeResult ParsedModule)
forall a b. (a -> b) -> a -> b
$ (((IdeResult ParsedModule, IdeResult ParsedModule)
 -> (IdeResult ParsedModule, IdeResult ParsedModule))
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((IdeResult ParsedModule, IdeResult ParsedModule)
  -> (IdeResult ParsedModule, IdeResult ParsedModule))
 -> IO (IdeResult ParsedModule, IdeResult ParsedModule)
 -> IO (IdeResult ParsedModule, IdeResult ParsedModule))
-> ((ParsedModule -> ParsedModule)
    -> (IdeResult ParsedModule, IdeResult ParsedModule)
    -> (IdeResult ParsedModule, IdeResult ParsedModule))
-> (ParsedModule -> ParsedModule)
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IdeResult ParsedModule -> IdeResult ParsedModule)
-> (IdeResult ParsedModule, IdeResult ParsedModule)
-> (IdeResult ParsedModule, IdeResult ParsedModule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((IdeResult ParsedModule -> IdeResult ParsedModule)
 -> (IdeResult ParsedModule, IdeResult ParsedModule)
 -> (IdeResult ParsedModule, IdeResult ParsedModule))
-> ((ParsedModule -> ParsedModule)
    -> IdeResult ParsedModule -> IdeResult ParsedModule)
-> (ParsedModule -> ParsedModule)
-> (IdeResult ParsedModule, IdeResult ParsedModule)
-> (IdeResult ParsedModule, IdeResult ParsedModule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ParsedModule -> Maybe ParsedModule)
-> IdeResult ParsedModule -> IdeResult ParsedModule
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ParsedModule -> ParsedModule
reset_ms (IO (IdeResult ParsedModule, IdeResult ParsedModule)
 -> IO (IdeResult ParsedModule, IdeResult ParsedModule))
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
forall a b. (a -> b) -> a -> b
$ IO (IdeResult ParsedModule)
-> IO (IdeResult ParsedModule)
-> IO (IdeResult ParsedModule, IdeResult ParsedModule)
forall a b. IO a -> IO b -> IO (a, b)
concurrently IO (IdeResult ParsedModule)
mainParse IO (IdeResult ParsedModule)
haddockParse

                -- Merge haddock and regular diagnostics so we can always report haddock
                -- parse errors
                let diagsM :: [FileDiagnostic]
diagsM = [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
mergeParseErrorsHaddock [FileDiagnostic]
diags [FileDiagnostic]
diagsh
                case Maybe ParsedModule
resh of
                  Just ParsedModule
_
                    | OptHaddockParse
HaddockParse <- IdeOptions -> OptHaddockParse
optHaddockParse IdeOptions
opt
                    -> IdeResult ParsedModule -> Action (IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diagsM, Maybe ParsedModule
resh)
                  -- If we fail to parse haddocks, report the haddock diagnostics as well and
                  -- return the non-haddock parse.
                  -- This seems to be the correct behaviour because the Haddock flag is added
                  -- by us and not the user, so our IDE shouldn't stop working because of it.
                  Maybe ParsedModule
_ -> IdeResult ParsedModule -> Action (IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diagsM, Maybe ParsedModule
res)
    -- Add dependencies on included files
    [Maybe FileVersion]
_ <- GetModificationTime
-> [NormalizedFilePath] -> Action [Maybe FileVersion]
forall k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe v]
uses GetModificationTime
GetModificationTime ([NormalizedFilePath] -> Action [Maybe FileVersion])
-> [NormalizedFilePath] -> Action [Maybe FileVersion]
forall a b. (a -> b) -> a -> b
$ (FilePath -> NormalizedFilePath)
-> [FilePath] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> NormalizedFilePath
toNormalizedFilePath' ([FilePath]
-> (ParsedModule -> [FilePath]) -> Maybe ParsedModule -> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ParsedModule -> [FilePath]
pm_extra_src_files Maybe ParsedModule
pmod)
    IdeResult ParsedModule -> Action (IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeResult ParsedModule
res

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 :: DynFlags
ms_hspp_opts= DynFlags -> GeneralFlag -> DynFlags
gopt_set (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms) GeneralFlag
opt}

withoutOption :: GeneralFlag -> ModSummary -> ModSummary
withoutOption :: GeneralFlag -> ModSummary -> ModSummary
withoutOption GeneralFlag
opt ModSummary
ms = ModSummary
ms{ms_hspp_opts :: DynFlags
ms_hspp_opts= DynFlags -> GeneralFlag -> DynFlags
gopt_unset (ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms) GeneralFlag
opt}

-- | Given some normal parse errors (first) and some from Haddock (second), merge them.
--   Ignore Haddock errors that are in both. Demote Haddock-only errors to warnings.
mergeParseErrorsHaddock :: [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
mergeParseErrorsHaddock :: [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
mergeParseErrorsHaddock [FileDiagnostic]
normal [FileDiagnostic]
haddock = [FileDiagnostic]
normal [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. [a] -> [a] -> [a]
++
    [ (NormalizedFilePath
a,ShowDiagnostic
b,Diagnostic
c{$sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsWarning, $sel:_message:Diagnostic :: Text
_message = Text -> Text
fixMessage (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Diagnostic -> Text
_message Diagnostic
c})
    | (NormalizedFilePath
a,ShowDiagnostic
b,Diagnostic
c) <- [FileDiagnostic]
haddock, Diagnostic -> Range
Diag._range Diagnostic
c Range -> Set Range -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Range
locations]
  where
    locations :: Set Range
locations = [Range] -> Set Range
forall a. Ord a => [a] -> Set a
Set.fromList ([Range] -> Set Range) -> [Range] -> Set Range
forall a b. (a -> b) -> a -> b
$ (FileDiagnostic -> Range) -> [FileDiagnostic] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map (Diagnostic -> Range
Diag._range (Diagnostic -> Range)
-> (FileDiagnostic -> Diagnostic) -> FileDiagnostic -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileDiagnostic -> Diagnostic
forall a b c. (a, b, c) -> c
thd3) [FileDiagnostic]
normal

    fixMessage :: Text -> Text
fixMessage Text
x | Text
"parse error " Text -> Text -> Bool
`T.isPrefixOf` Text
x = Text
"Haddock " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
                 | Bool
otherwise = Text
"Haddock: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x

-- | This rule provides a ParsedModule preserving all annotations,
-- including keywords, punctuation and comments.
-- So it is suitable for use cases where you need a perfect edit.
getParsedModuleWithCommentsRule :: Rules ()
getParsedModuleWithCommentsRule :: Rules ()
getParsedModuleWithCommentsRule =
  -- The parse diagnostics are owned by the GetParsedModule rule
  -- For this reason, this rule does not produce any diagnostics
  (GetParsedModuleWithComments
 -> NormalizedFilePath -> Action (Maybe ParsedModule))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((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} <- GetModSummary -> NormalizedFilePath -> Action ModSummaryResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
file
    HscEnvEq
sess <- GhcSession -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSession
GhcSession 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 :: DynFlags
ms_hspp_opts = DynFlags -> DynFlags
modify_dflags (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms' }
        reset_ms :: ParsedModule -> ParsedModule
reset_ms ParsedModule
pm = ParsedModule
pm { pm_mod_summary :: ModSummary
pm_mod_summary = ModSummary
ms' }

    IO (Maybe ParsedModule) -> Action (Maybe ParsedModule)
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParsedModule -> ParsedModule)
-> Maybe ParsedModule -> Maybe ParsedModule
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 (HscEnvEq -> HscEnv
hscEnv HscEnvEq
sess) IdeOptions
opt NormalizedFilePath
file ModSummary
ms

getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a
getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a
getModifyDynFlags DynFlagsModifications -> a
f = do
  IdeOptions
opts <- Action IdeOptions
getIdeOptions
  Config
cfg <- Config -> Action Config
getClientConfigAction Config
forall a. Default a => a
def
  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 :: FilePath
fp = NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
file
    ([FileDiagnostic]
diag, Maybe ParsedModule
res) <- IdeOptions
-> HscEnv -> FilePath -> ModSummary -> IO (IdeResult ParsedModule)
parseModule IdeOptions
opt HscEnv
packageState FilePath
fp ModSummary
ms
    case Maybe ParsedModule
res of
        Maybe ParsedModule
Nothing   -> IdeResult ParsedModule -> IO (IdeResult ParsedModule)
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 (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diag, ParsedModule -> Maybe ParsedModule
forall a. a -> Maybe a
Just ParsedModule
modu)

getLocatedImportsRule :: Rules ()
getLocatedImportsRule :: Rules ()
getLocatedImportsRule =
    (GetLocatedImports
 -> NormalizedFilePath
 -> Action
      (IdeResult [(Located ModuleName, Maybe ArtifactsLocation)]))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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
        HashMap Target (HashSet NormalizedFilePath)
targets <- GetKnownTargets
-> Action (HashMap Target (HashSet NormalizedFilePath))
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetKnownTargets
GetKnownTargets
        let targetsMap :: HashMap Target Target
targetsMap = (Target -> HashSet NormalizedFilePath -> Target)
-> HashMap Target (HashSet NormalizedFilePath)
-> HashMap Target Target
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey Target -> HashSet NormalizedFilePath -> Target
forall a b. a -> b -> a
const HashMap Target (HashSet NormalizedFilePath)
targets
        let imports :: [(Bool, (Maybe FastString, Located ModuleName))]
imports = [(Bool
False, (Maybe FastString, Located ModuleName)
imp) | (Maybe FastString, Located ModuleName)
imp <- ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_textual_imps ModSummary
ms] [(Bool, (Maybe FastString, Located ModuleName))]
-> [(Bool, (Maybe FastString, Located ModuleName))]
-> [(Bool, (Maybe FastString, Located ModuleName))]
forall a. [a] -> [a] -> [a]
++ [(Bool
True, (Maybe FastString, Located ModuleName)
imp) | (Maybe FastString, Located ModuleName)
imp <- ModSummary -> [(Maybe FastString, 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 FilePath) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Set FilePath) -> Bool) -> Maybe (Set FilePath) -> Bool
forall a b. (a -> b) -> a -> b
$ HscEnvEq -> Maybe (Set FilePath)
envImportPaths HscEnvEq
env_eq
        DynFlags
dflags <- DynFlags -> Action DynFlags
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags -> Action DynFlags) -> DynFlags -> Action DynFlags
forall a b. (a -> b) -> a -> b
$ if Bool
isImplicitCradle
                    then NormalizedFilePath -> ModuleName -> DynFlags -> DynFlags
addRelativeImport NormalizedFilePath
file (Module -> ModuleName
moduleName (Module -> ModuleName) -> Module -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModSummary -> Module
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 (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
                    -- reuse the existing NormalizedFilePath in order to maximize sharing
                    Bool
itExists <- NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp'
                    Maybe NormalizedFilePath -> Action (Maybe NormalizedFilePath)
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
                    -- reuse the existing NormalizedFilePath in order to maximize sharing
                    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 (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 (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 (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, (Maybe FastString, Located ModuleName))]
-> ((Bool, (Maybe FastString, 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, (Maybe FastString, Located ModuleName))]
imports (((Bool, (Maybe FastString, Located ModuleName))
  -> Action
       ([FileDiagnostic],
        Maybe (Located ModuleName, Maybe ArtifactsLocation)))
 -> Action
      [([FileDiagnostic],
        Maybe (Located ModuleName, Maybe ArtifactsLocation))])
-> ((Bool, (Maybe FastString, 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, (Maybe FastString
mbPkgName, Located ModuleName
modName)) -> do
            Either [FileDiagnostic] Import
diagOrImp <- HscEnv
-> [(UnitId, DynFlags)]
-> [FilePath]
-> (ModuleName
    -> NormalizedFilePath -> Action (Maybe NormalizedFilePath))
-> Located ModuleName
-> Maybe FastString
-> Bool
-> Action (Either [FileDiagnostic] Import)
forall (m :: * -> *).
MonadIO m =>
HscEnv
-> [(UnitId, DynFlags)]
-> [FilePath]
-> (ModuleName
    -> NormalizedFilePath -> m (Maybe NormalizedFilePath))
-> Located ModuleName
-> Maybe FastString
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule (DynFlags -> HscEnv -> HscEnv
hscSetFlags DynFlags
dflags HscEnv
env) [(UnitId, DynFlags)]
import_dirs (IdeOptions -> [FilePath]
optExtensions IdeOptions
opt) ModuleName
-> NormalizedFilePath -> Action (Maybe NormalizedFilePath)
getTargetFor Located ModuleName
modName Maybe FastString
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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ([], Maybe (Located ModuleName, Maybe ArtifactsLocation)
forall a. Maybe a
Nothing)

        {- IS THIS REALLY NEEDED? DOESNT SEEM SO

        -- does this module have an hs-boot file? If so add a direct dependency
        let bootPath = toNormalizedFilePath' $ fromNormalizedFilePath file <.> "hs-boot"
        boot <- use GetFileExists bootPath
        bootArtifact <- if boot == Just True
              then do
                let modName = ms_mod_name ms
                loc <- liftIO $ mkHomeModLocation dflags modName (fromNormalizedFilePath bootPath)
                return $ Just (noLoc modName, Just (ArtifactsLocation bootPath (Just loc) True))
              else pure 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 (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 :: 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 -> BootIdMap -> RawDependencyInformation
RawDependencyInformation FilePathIdMap (Either ModuleParseError ModuleImports)
forall a. IntMap a
IntMap.empty PathIdMap
emptyPathIdMap BootIdMap
forall a. IntMap a
IntMap.empty
        , IntMap a1
forall a. IntMap a
IntMap.empty
        )

-- | Given a target file path, construct the raw dependency results by following
-- imports recursively.
rawDependencyInformation :: [NormalizedFilePath] -> Action RawDependencyInformation
rawDependencyInformation :: [NormalizedFilePath] -> Action RawDependencyInformation
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 = (Key -> ArtifactsLocation -> BootIdMap -> BootIdMap)
-> BootIdMap -> IntMap ArtifactsLocation -> BootIdMap
forall a b. (Key -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey (RawDependencyInformation
-> Key -> ArtifactsLocation -> BootIdMap -> BootIdMap
updateBootMap RawDependencyInformation
rdi) BootIdMap
forall a. IntMap a
IntMap.empty IntMap ArtifactsLocation
ss
    RawDependencyInformation -> Action RawDependencyInformation
forall (m :: * -> *) a. Monad m => a -> m a
return (RawDependencyInformation
rdi { rawBootMap :: BootIdMap
rawBootMap = 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 (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 (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 (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 k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [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 -- ^ Current module being processed
       -> Maybe ModSummary   -- ^ ModSummary of the module
       -> RawDepM FilePathId
    go :: NormalizedFilePath
-> Maybe ModSummary
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
go NormalizedFilePath
f Maybe ModSummary
msum = do
      -- First check to see if we have already processed the FilePath
      -- If we have, just return its Id but don't update any of the state.
      -- Otherwise, we need to process its imports.
      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
msum
          -- Get a fresh FilePathId for the new file
          FilePathId
fId <- ArtifactsLocation
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
getFreshFid ArtifactsLocation
al
          -- Adding an edge to the bootmap so we can make sure to
          -- insert boot nodes before the real files.
          ArtifactsLocation -> FilePathId -> RawDepM ()
addBootMap ArtifactsLocation
al FilePathId
fId
          -- Try to parse the imports of the file
          Maybe [(Located ModuleName, Maybe ArtifactsLocation)]
importsOrErr <- Action (Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     (Maybe [(Located ModuleName, Maybe ArtifactsLocation)])
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
            -- File doesn't parse so add the module as a failure into the
            -- dependency information, continue processing the other
            -- elements in the queue
              (RawDependencyInformation -> RawDependencyInformation)
-> RawDepM ()
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 (m :: * -> *) a. Monad m => a -> m a
return FilePathId
fId
            Just [(Located ModuleName, Maybe ArtifactsLocation)]
modImports -> do
              -- Get NFPs of the imports which have corresponding files
              -- Imports either come locally from a file or from a package.
              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
              -- Recursively process all the imports we just learnt about
              -- and get back a list of their FilePathIds
              [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
              -- Associate together the ModuleName with the FilePathId
              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)
              -- Insert into the map the information about this modules
              -- imports.
              (RawDependencyInformation -> RawDependencyInformation)
-> RawDepM ()
modifyRawDepInfo ((RawDependencyInformation -> RawDependencyInformation)
 -> RawDepM ())
-> (RawDependencyInformation -> RawDependencyInformation)
-> RawDepM ()
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 (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 (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)
-> RawDepM ()
modifyRawDepInfo RawDependencyInformation -> RawDependencyInformation
f = ((RawDependencyInformation, IntMap ArtifactsLocation)
 -> (RawDependencyInformation, IntMap ArtifactsLocation))
-> RawDepM ()
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 -> RawDepM ()
addBootMap ArtifactsLocation
al FilePathId
fId =
      ((RawDependencyInformation, IntMap ArtifactsLocation)
 -> (RawDependencyInformation, IntMap ArtifactsLocation))
-> RawDepM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(RawDependencyInformation
rd, IntMap ArtifactsLocation
ss) -> (RawDependencyInformation
rd, if ArtifactsLocation -> Bool
isBootLocation ArtifactsLocation
al
                                  then Key
-> ArtifactsLocation
-> IntMap ArtifactsLocation
-> IntMap ArtifactsLocation
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert (FilePathId -> Key
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)
      -- Insert the File into the bootmap if it's a boot module
      let rawDepInfo' :: RawDependencyInformation
rawDepInfo' = RawDependencyInformation
rawDepInfo { rawPathIdMap :: PathIdMap
rawPathIdMap = PathIdMap
path_map }
      (RawDependencyInformation, IntMap ArtifactsLocation) -> RawDepM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RawDependencyInformation
rawDepInfo', IntMap ArtifactsLocation
ss)
      FilePathId
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
forall (m :: * -> *) a. Monad m => a -> m a
return FilePathId
fId

    -- Split in (package imports, local imports)
    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 (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
-> Key -> ArtifactsLocation -> BootIdMap -> BootIdMap
updateBootMap RawDependencyInformation
pm Key
boot_mod_id ArtifactsLocation{Bool
Maybe ModLocation
NormalizedFilePath
artifactIsSource :: ArtifactsLocation -> Bool
artifactModLocation :: ArtifactsLocation -> Maybe ModLocation
artifactIsSource :: Bool
artifactModLocation :: Maybe ModLocation
artifactFilePath :: NormalizedFilePath
artifactFilePath :: ArtifactsLocation -> NormalizedFilePath
..} 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) (FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropBootSuffix (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
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 (Key -> FilePathId
FilePathId Key
boot_mod_id) BootIdMap
bm
               Maybe FilePathId
Nothing -> BootIdMap
bm
        else BootIdMap
bm

    dropBootSuffix :: FilePath -> FilePath
    dropBootSuffix :: FilePath -> FilePath
dropBootSuffix FilePath
hs_src = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> FilePath -> FilePath
forall a. Key -> [a] -> [a]
drop (FilePath -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length @[] FilePath
"-boot") (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
hs_src

getDependencyInformationRule :: Rules ()
getDependencyInformationRule :: Rules ()
getDependencyInformationRule =
    (GetDependencyInformation
 -> NormalizedFilePath -> Action (IdeResult DependencyInformation))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((GetDependencyInformation
  -> NormalizedFilePath -> Action (IdeResult DependencyInformation))
 -> Rules ())
-> (GetDependencyInformation
    -> NormalizedFilePath -> Action (IdeResult DependencyInformation))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetDependencyInformation
GetDependencyInformation NormalizedFilePath
file -> do
       RawDependencyInformation
rawDepInfo <- [NormalizedFilePath] -> Action RawDependencyInformation
rawDependencyInformation [NormalizedFilePath
file]
       IdeResult DependencyInformation
-> Action (IdeResult DependencyInformation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], DependencyInformation -> Maybe DependencyInformation
forall a. a -> Maybe a
Just (DependencyInformation -> Maybe DependencyInformation)
-> DependencyInformation -> Maybe DependencyInformation
forall a b. (a -> b) -> a -> b
$ RawDependencyInformation -> DependencyInformation
processDependencyInformation RawDependencyInformation
rawDepInfo)

reportImportCyclesRule :: Rules ()
reportImportCyclesRule :: Rules ()
reportImportCyclesRule =
    (ReportImportCycles -> NormalizedFilePath -> Action (IdeResult ()))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((ReportImportCycles
  -> NormalizedFilePath -> Action (IdeResult ()))
 -> Rules ())
-> (ReportImportCycles
    -> NormalizedFilePath -> Action (IdeResult ()))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \ReportImportCycles
ReportImportCycles NormalizedFilePath
file -> ([FileDiagnostic] -> IdeResult ())
-> Action [FileDiagnostic] -> Action (IdeResult ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[FileDiagnostic]
errs -> if [FileDiagnostic] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FileDiagnostic]
errs then ([], () -> Maybe ()
forall a. a -> Maybe a
Just ()) else ([FileDiagnostic]
errs, Maybe ()
forall a. Maybe a
Nothing)) (Action [FileDiagnostic] -> Action (IdeResult ()))
-> Action [FileDiagnostic] -> Action (IdeResult ())
forall a b. (a -> b) -> a -> b
$ do
        DependencyInformation{FilePathIdMap (NonEmpty NodeError)
IntMap IntSet
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depReverseModuleDeps :: DependencyInformation -> IntMap IntSet
depModuleDeps :: DependencyInformation -> IntMap IntSet
depModuleNames :: DependencyInformation -> FilePathIdMap ShowableModuleName
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depReverseModuleDeps :: IntMap IntSet
depModuleDeps :: IntMap IntSet
depModuleNames :: FilePathIdMap ShowableModuleName
depErrorNodes :: FilePathIdMap (NonEmpty NodeError)
..} <- GetDependencyInformation
-> NormalizedFilePath -> Action DependencyInformation
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetDependencyInformation
GetDependencyInformation NormalizedFilePath
file
        let fileId :: FilePathId
fileId = PathIdMap -> NormalizedFilePath -> FilePathId
pathToId PathIdMap
depPathIdMap NormalizedFilePath
file
        case Key
-> FilePathIdMap (NonEmpty NodeError) -> Maybe (NonEmpty NodeError)
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup (FilePathId -> Key
getFilePathId FilePathId
fileId) FilePathIdMap (NonEmpty NodeError)
depErrorNodes of
            Maybe (NonEmpty NodeError)
Nothing -> [FileDiagnostic] -> Action [FileDiagnostic]
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 (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty NodeError
errs)
                -- Convert cycles of files into cycles of module names
                [(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
                    [FilePath]
modNames <- [FilePathId]
-> (FilePathId -> Action FilePath) -> Action [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePathId]
files ((FilePathId -> Action FilePath) -> Action [FilePath])
-> (FilePathId -> Action FilePath) -> Action [FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePathId
fileId -> do
                        let file :: NormalizedFilePath
file = PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap FilePathId
fileId
                        NormalizedFilePath -> Action FilePath
getModuleName NormalizedFilePath
file
                    FileDiagnostic -> Action FileDiagnostic
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileDiagnostic -> Action FileDiagnostic)
-> FileDiagnostic -> Action FileDiagnostic
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> [FilePath] -> FileDiagnostic
forall a. HasSrcSpan a => a -> [FilePath] -> FileDiagnostic
toDiag Located ModuleName
imp ([FilePath] -> FileDiagnostic) -> [FilePath] -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [FilePath]
modNames
    where cycleErrorInFile :: FilePathId -> NodeError -> Maybe (Located ModuleName, [FilePathId])
cycleErrorInFile FilePathId
f (PartOfCycle Located ModuleName
imp [FilePathId]
fs)
            | FilePathId
f FilePathId -> [FilePathId] -> 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 -> [FilePath] -> FileDiagnostic
toDiag a
imp [FilePath]
mods = (NormalizedFilePath
fp , ShowDiagnostic
ShowDiag , ) (Diagnostic -> FileDiagnostic) -> Diagnostic -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ Diagnostic :: Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe Text
-> Text
-> Maybe (List DiagnosticTag)
-> Maybe (List DiagnosticRelatedInformation)
-> Diagnostic
Diagnostic
            { $sel:_range:Diagnostic :: Range
_range = Range
rng
            , $sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
DsError
            , $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
<> [FilePath] -> Text
showCycle [FilePath]
mods
            , $sel:_code:Diagnostic :: Maybe (Int32 |? Text)
_code = Maybe (Int32 |? Text)
forall a. Maybe a
Nothing
            , $sel:_relatedInformation:Diagnostic :: Maybe (List DiagnosticRelatedInformation)
_relatedInformation = Maybe (List DiagnosticRelatedInformation)
forall a. Maybe a
Nothing
            , $sel:_tags:Diagnostic :: Maybe (List DiagnosticTag)
_tags = Maybe (List DiagnosticTag)
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 = FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
noFilePath (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe FilePath
srcSpanToFilename (a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
imp)
          getModuleName :: NormalizedFilePath -> Action FilePath
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
           FilePath -> Action FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath)
-> (ModSummary -> ModuleName) -> ModSummary -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
moduleName (Module -> ModuleName)
-> (ModSummary -> Module) -> ModSummary -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod (ModSummary -> FilePath) -> ModSummary -> FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary
ms)
          showCycle :: [FilePath] -> Text
showCycle [FilePath]
mods  = Text -> [Text] -> Text
T.intercalate Text
", " ((FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
T.pack [FilePath]
mods)

getHieAstsRule :: Rules ()
getHieAstsRule :: Rules ()
getHieAstsRule =
    (GetHieAst
 -> NormalizedFilePath -> Action (IdeResult HieAstResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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 :: Rules ()
persistentHieFileRule :: Rules ()
persistentHieFileRule = GetHieAst
-> (NormalizedFilePath
    -> IdeAction
         (Maybe (HieAstResult, PositionDelta, TextDocumentVersion)))
-> Rules ()
forall k v.
IdeRule k v =>
k
-> (NormalizedFilePath
    -> IdeAction (Maybe (v, PositionDelta, TextDocumentVersion)))
-> Rules ()
addPersistentRule GetHieAst
GetHieAst ((NormalizedFilePath
  -> IdeAction
       (Maybe (HieAstResult, PositionDelta, TextDocumentVersion)))
 -> Rules ())
-> (NormalizedFilePath
    -> IdeAction
         (Maybe (HieAstResult, PositionDelta, TextDocumentVersion)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> MaybeT IdeAction (HieAstResult, PositionDelta, TextDocumentVersion)
-> IdeAction
     (Maybe (HieAstResult, PositionDelta, TextDocumentVersion))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   IdeAction (HieAstResult, PositionDelta, TextDocumentVersion)
 -> IdeAction
      (Maybe (HieAstResult, PositionDelta, TextDocumentVersion)))
-> MaybeT
     IdeAction (HieAstResult, PositionDelta, TextDocumentVersion)
-> IdeAction
     (Maybe (HieAstResult, PositionDelta, TextDocumentVersion))
forall a b. (a -> b) -> a -> b
$ do
  HieFile
res <- NormalizedFilePath -> MaybeT IdeAction HieFile
readHieFileForSrcFromDisk NormalizedFilePath
file
  VFSHandle
vfs <- (ShakeExtras -> VFSHandle) -> MaybeT IdeAction VFSHandle
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ShakeExtras -> VFSHandle
vfs
  (Text
currentSource,TextDocumentVersion
ver) <- IO (Text, TextDocumentVersion)
-> MaybeT IdeAction (Text, TextDocumentVersion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, TextDocumentVersion)
 -> MaybeT IdeAction (Text, TextDocumentVersion))
-> IO (Text, TextDocumentVersion)
-> MaybeT IdeAction (Text, TextDocumentVersion)
forall a b. (a -> b) -> a -> b
$ do
    Maybe VirtualFile
mvf <- VFSHandle -> NormalizedUri -> IO (Maybe VirtualFile)
getVirtualFile VFSHandle
vfs (NormalizedUri -> IO (Maybe VirtualFile))
-> NormalizedUri -> IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
filePathToUri' NormalizedFilePath
file
    case Maybe VirtualFile
mvf of
      Maybe VirtualFile
Nothing -> (,TextDocumentVersion
forall a. Maybe a
Nothing) (Text -> (Text, TextDocumentVersion))
-> (ByteString -> Text)
-> ByteString
-> (Text, TextDocumentVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> (Text, TextDocumentVersion))
-> IO ByteString -> IO (Text, TextDocumentVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
file)
      Just VirtualFile
vf -> (Text, TextDocumentVersion) -> IO (Text, TextDocumentVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rope -> Text
Rope.toText (Rope -> Text) -> Rope -> Text
forall a b. (a -> b) -> a -> b
$ VirtualFile -> Rope
_text VirtualFile
vf, Int32 -> TextDocumentVersion
forall a. a -> Maybe a
Just (Int32 -> TextDocumentVersion) -> Int32 -> TextDocumentVersion
forall a b. (a -> b) -> a -> b
$ VirtualFile -> Int32
_lsp_version VirtualFile
vf)
  let refmap :: Map Identifier [(Span, IdentifierDetails Key)]
refmap = Map FastString (HieAST Key)
-> Map Identifier [(Span, IdentifierDetails Key)]
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a) -> Map Identifier [(Span, IdentifierDetails a)]
Compat.generateReferencesMap (Map FastString (HieAST Key)
 -> Map Identifier [(Span, IdentifierDetails Key)])
-> (HieFile -> Map FastString (HieAST Key))
-> HieFile
-> Map Identifier [(Span, IdentifierDetails Key)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieASTs Key -> Map FastString (HieAST Key)
forall a. HieASTs a -> Map FastString (HieAST a)
Compat.getAsts (HieASTs Key -> Map FastString (HieAST Key))
-> (HieFile -> HieASTs Key)
-> HieFile
-> Map FastString (HieAST Key)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> HieASTs Key
Compat.hie_asts (HieFile -> Map Identifier [(Span, IdentifierDetails Key)])
-> HieFile -> Map Identifier [(Span, IdentifierDetails Key)]
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, TextDocumentVersion)
-> MaybeT
     IdeAction (HieAstResult, PositionDelta, TextDocumentVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Module
-> HieASTs Key
-> Map Identifier [(Span, IdentifierDetails Key)]
-> Map Name [Span]
-> HieKind Key
-> HieAstResult
forall a.
Module
-> HieASTs a
-> RefMap a
-> Map Name [Span]
-> HieKind a
-> HieAstResult
HAR (HieFile -> Module
Compat.hie_module HieFile
res) (HieFile -> HieASTs Key
Compat.hie_asts HieFile
res) Map Identifier [(Span, IdentifierDetails Key)]
refmap Map Name [Span]
forall a. Monoid a => a
mempty (HieFile -> HieKind Key
HieFromDisk HieFile
res),PositionDelta
del,TextDocumentVersion
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 (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
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 (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 'CustomMethod
-> MessageParams 'CustomMethod -> LspT Config IO ()
forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification (Text -> SServerMethod 'CustomMethod
forall (f :: From) (t :: MethodType). Text -> SMethod 'CustomMethod
SCustomMethod Text
"ghcide/reference/ready") (MessageParams 'CustomMethod -> LspT Config IO ())
-> MessageParams 'CustomMethod -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
          FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON (FilePath -> Value) -> FilePath -> Value
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f
      [FileDiagnostic] -> Action [FileDiagnostic]
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
              msum :: ModSummary
msum = TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr
          IO [FileDiagnostic] -> Action [FileDiagnostic]
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
msum NormalizedFilePath
f [AvailInfo]
exports HieASTs Type
asts ByteString
source
    IsFileOfInterestResult
_ -> [FileDiagnostic] -> Action [FileDiagnostic]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  let refmap :: Maybe (Map Identifier [(Span, IdentifierDetails Type)])
refmap = Map FastString (HieAST Type)
-> Map Identifier [(Span, IdentifierDetails Type)]
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a) -> Map Identifier [(Span, IdentifierDetails a)]
Compat.generateReferencesMap (Map FastString (HieAST Type)
 -> Map Identifier [(Span, IdentifierDetails Type)])
-> (HieASTs Type -> Map FastString (HieAST Type))
-> HieASTs Type
-> Map Identifier [(Span, IdentifierDetails Type)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieASTs Type -> Map FastString (HieAST Type)
forall a. HieASTs a -> Map FastString (HieAST a)
Compat.getAsts (HieASTs Type -> Map Identifier [(Span, IdentifierDetails Type)])
-> Maybe (HieASTs Type)
-> Maybe (Map Identifier [(Span, IdentifierDetails Type)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HieASTs Type)
masts
      typemap :: Maybe (Map Name [Span])
typemap = Map FastString (HieAST Type) -> Map Name [Span]
forall (f :: * -> *).
Foldable f =>
f (HieAST Type) -> Map Name [Span]
AtPoint.computeTypeReferences (Map FastString (HieAST Type) -> Map Name [Span])
-> (HieASTs Type -> Map FastString (HieAST Type))
-> HieASTs Type
-> Map Name [Span]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieASTs Type -> Map FastString (HieAST Type)
forall a. HieASTs a -> Map FastString (HieAST a)
Compat.getAsts (HieASTs Type -> Map Name [Span])
-> Maybe (HieASTs Type) -> Maybe (Map Name [Span])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HieASTs Type)
masts
  IdeResult HieAstResult -> Action (IdeResult HieAstResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
diagsWrite, Module
-> HieASTs Type
-> Map Identifier [(Span, IdentifierDetails Type)]
-> Map Name [Span]
-> HieKind Type
-> HieAstResult
forall a.
Module
-> HieASTs a
-> RefMap a
-> Map Name [Span]
-> HieKind a
-> HieAstResult
HAR (ModSummary -> Module
ms_mod (ModSummary -> Module) -> ModSummary -> Module
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr) (HieASTs Type
 -> Map Identifier [(Span, IdentifierDetails Type)]
 -> Map Name [Span]
 -> HieKind Type
 -> HieAstResult)
-> Maybe (HieASTs Type)
-> Maybe
     (Map Identifier [(Span, IdentifierDetails Type)]
      -> Map Name [Span] -> HieKind Type -> HieAstResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HieASTs Type)
masts Maybe
  (Map Identifier [(Span, IdentifierDetails Type)]
   -> Map Name [Span] -> HieKind Type -> HieAstResult)
-> Maybe (Map Identifier [(Span, IdentifierDetails Type)])
-> Maybe (Map Name [Span] -> HieKind Type -> HieAstResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Map Identifier [(Span, IdentifierDetails Type)])
refmap Maybe (Map Name [Span] -> HieKind Type -> HieAstResult)
-> Maybe (Map Name [Span]) -> Maybe (HieKind Type -> HieAstResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Map Name [Span])
typemap Maybe (HieKind Type -> HieAstResult)
-> Maybe (HieKind Type) -> Maybe HieAstResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HieKind Type -> Maybe (HieKind Type)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HieKind Type
HieFresh)

getImportMapRule :: Rules ()
getImportMapRule :: Rules ()
getImportMapRule = (GetImportMap
 -> NormalizedFilePath -> Action (IdeResult ImportMap))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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 :: [(a, Maybe ArtifactsLocation)]
-> Map (SrcSpanLess a) NormalizedFilePath
mkImports [(a, Maybe ArtifactsLocation)]
fileImports = [(SrcSpanLess a, NormalizedFilePath)]
-> Map (SrcSpanLess a) NormalizedFilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SrcSpanLess a, NormalizedFilePath)]
 -> Map (SrcSpanLess a) NormalizedFilePath)
-> [(SrcSpanLess a, NormalizedFilePath)]
-> Map (SrcSpanLess a) NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ ((a, Maybe ArtifactsLocation)
 -> Maybe (SrcSpanLess a, NormalizedFilePath))
-> [(a, Maybe ArtifactsLocation)]
-> [(SrcSpanLess a, NormalizedFilePath)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(a
m, Maybe ArtifactsLocation
mfp) -> (a -> SrcSpanLess a
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc a
m,) (NormalizedFilePath -> (SrcSpanLess a, NormalizedFilePath))
-> (ArtifactsLocation -> NormalizedFilePath)
-> ArtifactsLocation
-> (SrcSpanLess a, NormalizedFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtifactsLocation -> NormalizedFilePath
artifactFilePath (ArtifactsLocation -> (SrcSpanLess a, NormalizedFilePath))
-> Maybe ArtifactsLocation
-> Maybe (SrcSpanLess a, NormalizedFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ArtifactsLocation
mfp) [(a, Maybe ArtifactsLocation)]
fileImports
  IdeResult ImportMap -> Action (IdeResult ImportMap)
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 a.
(Ord (SrcSpanLess a), HasSrcSpan a) =>
[(a, Maybe ArtifactsLocation)]
-> Map (SrcSpanLess a) 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)

-- | Ensure that go to definition doesn't block on startup
persistentImportMapRule :: Rules ()
persistentImportMapRule :: Rules ()
persistentImportMapRule = GetImportMap
-> (NormalizedFilePath
    -> IdeAction
         (Maybe (ImportMap, PositionDelta, TextDocumentVersion)))
-> Rules ()
forall k v.
IdeRule k v =>
k
-> (NormalizedFilePath
    -> IdeAction (Maybe (v, PositionDelta, TextDocumentVersion)))
-> Rules ()
addPersistentRule GetImportMap
GetImportMap ((NormalizedFilePath
  -> IdeAction
       (Maybe (ImportMap, PositionDelta, TextDocumentVersion)))
 -> Rules ())
-> (NormalizedFilePath
    -> IdeAction
         (Maybe (ImportMap, PositionDelta, TextDocumentVersion)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
_ -> Maybe (ImportMap, PositionDelta, TextDocumentVersion)
-> IdeAction
     (Maybe (ImportMap, PositionDelta, TextDocumentVersion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ImportMap, PositionDelta, TextDocumentVersion)
 -> IdeAction
      (Maybe (ImportMap, PositionDelta, TextDocumentVersion)))
-> Maybe (ImportMap, PositionDelta, TextDocumentVersion)
-> IdeAction
     (Maybe (ImportMap, PositionDelta, TextDocumentVersion))
forall a b. (a -> b) -> a -> b
$ (ImportMap, PositionDelta, TextDocumentVersion)
-> Maybe (ImportMap, PositionDelta, TextDocumentVersion)
forall a. a -> Maybe a
Just (Map ModuleName NormalizedFilePath -> ImportMap
ImportMap Map ModuleName NormalizedFilePath
forall a. Monoid a => a
mempty, PositionDelta
idDelta, TextDocumentVersion
forall a. Maybe a
Nothing)

getBindingsRule :: Rules ()
getBindingsRule :: Rules ()
getBindingsRule =
  (GetBindings -> NormalizedFilePath -> Action (IdeResult Bindings))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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 (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
$ Map Identifier [(Span, IdentifierDetails Type)] -> Bindings
bindings RefMap a
Map Identifier [(Span, IdentifierDetails Type)]
rm)
      HieFromDisk HieFile
_ -> IdeResult Bindings -> Action (IdeResult Bindings)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Maybe Bindings
forall a. Maybe a
Nothing)

getDocMapRule :: Rules ()
getDocMapRule :: Rules ()
getDocMapRule =
    (GetDocMap
 -> NormalizedFilePath -> Action (IdeResult DocAndKindMap))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((GetDocMap
  -> NormalizedFilePath -> Action (IdeResult DocAndKindMap))
 -> Rules ())
-> (GetDocMap
    -> NormalizedFilePath -> Action (IdeResult DocAndKindMap))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetDocMap
GetDocMap NormalizedFilePath
file -> do
      -- Stale data for the scenario where a broken module has previously typechecked
      -- but we never generated a DocMap for it
      (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

      DocAndKindMap
dkMap <- IO DocAndKindMap -> Action DocAndKindMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DocAndKindMap -> Action DocAndKindMap)
-> IO DocAndKindMap -> Action DocAndKindMap
forall a b. (a -> b) -> a -> b
$ HscEnv -> RefMap a -> TcGblEnv -> IO DocAndKindMap
forall a. HscEnv -> RefMap a -> TcGblEnv -> IO DocAndKindMap
mkDocMap HscEnv
hsc RefMap a
rf TcGblEnv
tc
      IdeResult DocAndKindMap -> Action (IdeResult DocAndKindMap)
forall (m :: * -> *) a. Monad m => a -> m a
return ([],DocAndKindMap -> Maybe DocAndKindMap
forall a. a -> Maybe a
Just DocAndKindMap
dkMap)

-- | Persistent rule to ensure that hover doesn't block on startup
persistentDocMapRule :: Rules ()
persistentDocMapRule :: Rules ()
persistentDocMapRule = GetDocMap
-> (NormalizedFilePath
    -> IdeAction
         (Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)))
-> Rules ()
forall k v.
IdeRule k v =>
k
-> (NormalizedFilePath
    -> IdeAction (Maybe (v, PositionDelta, TextDocumentVersion)))
-> Rules ()
addPersistentRule GetDocMap
GetDocMap ((NormalizedFilePath
  -> IdeAction
       (Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)))
 -> Rules ())
-> (NormalizedFilePath
    -> IdeAction
         (Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
_ -> Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)
-> IdeAction
     (Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)
 -> IdeAction
      (Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)))
-> Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)
-> IdeAction
     (Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion))
forall a b. (a -> b) -> a -> b
$ (DocAndKindMap, PositionDelta, TextDocumentVersion)
-> Maybe (DocAndKindMap, PositionDelta, TextDocumentVersion)
forall a. a -> Maybe a
Just (DocMap -> KindMap -> DocAndKindMap
DKMap DocMap
forall a. Monoid a => a
mempty KindMap
forall a. Monoid a => a
mempty, PositionDelta
idDelta, TextDocumentVersion
forall a. Maybe a
Nothing)

readHieFileForSrcFromDisk :: NormalizedFilePath -> MaybeT IdeAction Compat.HieFile
readHieFileForSrcFromDisk :: NormalizedFilePath -> MaybeT IdeAction HieFile
readHieFileForSrcFromDisk NormalizedFilePath
file = do
  ShakeExtras{WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb :: WithHieDb
withHieDb} <- MaybeT IdeAction ShakeExtras
forall r (m :: * -> *). MonadReader r m => m r
ask
  Text -> IO ()
log <- (ShakeExtras -> Text -> IO ()) -> MaybeT IdeAction (Text -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ShakeExtras -> Text -> IO ())
 -> MaybeT IdeAction (Text -> IO ()))
-> (ShakeExtras -> Text -> IO ())
-> MaybeT IdeAction (Text -> IO ())
forall a b. (a -> b) -> a -> b
$ Logger -> Text -> IO ()
L.logDebug (Logger -> Text -> IO ())
-> (ShakeExtras -> Logger) -> ShakeExtras -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeExtras -> Logger
logger
  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 (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 -> FilePath -> IO (Maybe HieModuleRow)
HieDb.lookupHieFileFromSource HieDb
hieDb (FilePath -> IO (Maybe HieModuleRow))
-> FilePath -> IO (Maybe HieModuleRow)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
file)
  let hie_loc :: FilePath
hie_loc = HieModuleRow -> FilePath
HieDb.hieModuleHieFile HieModuleRow
row
  IO () -> MaybeT IdeAction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IdeAction ()) -> IO () -> MaybeT IdeAction ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
log (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"LOADING HIE FILE :" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (NormalizedFilePath -> FilePath
forall a. Show a => a -> FilePath
show 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
$ FilePath -> ExceptT SomeException IdeAction HieFile
readHieFileFromDisk FilePath
hie_loc

readHieFileFromDisk :: FilePath -> ExceptT SomeException IdeAction Compat.HieFile
readHieFileFromDisk :: FilePath -> ExceptT SomeException IdeAction HieFile
readHieFileFromDisk FilePath
hie_loc = do
  IORef NameCache
nc <- (ShakeExtras -> IORef NameCache)
-> ExceptT SomeException IdeAction (IORef NameCache)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ShakeExtras -> IORef NameCache
ideNc
  Text -> IO ()
log <- (ShakeExtras -> Text -> IO ())
-> ExceptT SomeException IdeAction (Text -> IO ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ShakeExtras -> Text -> IO ())
 -> ExceptT SomeException IdeAction (Text -> IO ()))
-> (ShakeExtras -> Text -> IO ())
-> ExceptT SomeException IdeAction (Text -> IO ())
forall a b. (a -> b) -> a -> b
$ Logger -> Text -> IO ()
L.logDebug (Logger -> Text -> IO ())
-> (ShakeExtras -> Logger) -> ShakeExtras -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShakeExtras -> Logger
logger
  Either SomeException HieFile
res <- IO (Either SomeException HieFile)
-> ExceptT SomeException IdeAction (Either SomeException HieFile)
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.
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
$ NameCacheUpdater -> FilePath -> IO HieFile
loadHieFile (IORef NameCache -> NameCacheUpdater
mkUpdater IORef NameCache
nc) FilePath
hie_loc
  IO () -> ExceptT SomeException IdeAction ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SomeException IdeAction ())
-> (Text -> IO ()) -> Text -> ExceptT SomeException IdeAction ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
log (Text -> ExceptT SomeException IdeAction ())
-> Text -> ExceptT SomeException IdeAction ()
forall a b. (a -> b) -> a -> b
$ (SomeException -> Text)
-> (HieFile -> Text) -> Either SomeException HieFile -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> SomeException -> Text
forall a b. a -> b -> a
const (Text -> SomeException -> Text) -> Text -> SomeException -> Text
forall a b. (a -> b) -> a -> b
$ Text
"FAILED LOADING HIE FILE FOR:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
hie_loc))
                        (Text -> HieFile -> Text
forall a b. a -> b -> a
const (Text -> HieFile -> Text) -> Text -> HieFile -> Text
forall a b. (a -> b) -> a -> b
$ Text
"SUCCEEDED LOADING HIE FILE FOR:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
hie_loc))
                        Either SomeException HieFile
res
  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

-- | Typechecks a module.
typeCheckRule :: Rules ()
typeCheckRule :: Rules ()
typeCheckRule = (TypeCheck
 -> NormalizedFilePath -> Action (IdeResult TcModuleResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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
    HscEnv -> ParsedModule -> Action (IdeResult TcModuleResult)
typeCheckRuleDefinition HscEnv
hsc ParsedModule
pm

knownFilesRule :: Rules ()
knownFilesRule :: Rules ()
knownFilesRule = (GetKnownTargets
 -> Action
      (ByteString, HashMap Target (HashSet NormalizedFilePath)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((GetKnownTargets
  -> Action
       (ByteString, HashMap Target (HashSet NormalizedFilePath)))
 -> Rules ())
-> (GetKnownTargets
    -> Action
         (ByteString, HashMap Target (HashSet NormalizedFilePath)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetKnownTargets
GetKnownTargets -> do
  Action ()
alwaysRerun
  Hashed (HashMap Target (HashSet NormalizedFilePath))
fs <- Action (Hashed (HashMap Target (HashSet NormalizedFilePath)))
knownTargets
  (ByteString, HashMap Target (HashSet NormalizedFilePath))
-> Action (ByteString, HashMap Target (HashSet NormalizedFilePath))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Key -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Key -> ByteString) -> Key -> ByteString
forall a b. (a -> b) -> a -> b
$ Hashed (HashMap Target (HashSet NormalizedFilePath)) -> Key
forall a. Hashable a => a -> Key
hash Hashed (HashMap Target (HashSet NormalizedFilePath))
fs, Hashed (HashMap Target (HashSet NormalizedFilePath))
-> HashMap Target (HashSet NormalizedFilePath)
forall a. Hashed a -> a
unhashed Hashed (HashMap Target (HashSet NormalizedFilePath))
fs)

getModuleGraphRule :: Rules ()
getModuleGraphRule :: Rules ()
getModuleGraphRule = (GetModuleGraph -> Action DependencyInformation) -> Rules ()
forall k v. IdeRule k v => (k -> Action v) -> Rules ()
defineNoFile ((GetModuleGraph -> Action DependencyInformation) -> Rules ())
-> (GetModuleGraph -> Action DependencyInformation) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetModuleGraph
GetModuleGraph -> do
  HashSet NormalizedFilePath
fs <- HashMap Target (HashSet NormalizedFilePath)
-> HashSet NormalizedFilePath
toKnownFiles (HashMap Target (HashSet NormalizedFilePath)
 -> HashSet NormalizedFilePath)
-> Action (HashMap Target (HashSet NormalizedFilePath))
-> Action (HashSet NormalizedFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetKnownTargets
-> Action (HashMap Target (HashSet NormalizedFilePath))
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetKnownTargets
GetKnownTargets
  RawDependencyInformation
rawDepInfo <- [NormalizedFilePath] -> Action RawDependencyInformation
rawDependencyInformation (HashSet NormalizedFilePath -> [NormalizedFilePath]
forall a. HashSet a -> [a]
HashSet.toList HashSet NormalizedFilePath
fs)
  DependencyInformation -> Action DependencyInformation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DependencyInformation -> Action DependencyInformation)
-> DependencyInformation -> Action DependencyInformation
forall a b. (a -> b) -> a -> b
$ RawDependencyInformation -> DependencyInformation
processDependencyInformation RawDependencyInformation
rawDepInfo

-- This is factored out so it can be directly called from the GetModIface
-- rule. Directly calling this rule means that on the initial load we can
-- garbage collect all the intermediate typechecked modules rather than
-- retain the information forever in the shake graph.
typeCheckRuleDefinition
    :: HscEnv
    -> ParsedModule
    -> Action (IdeResult TcModuleResult)
typeCheckRuleDefinition :: HscEnv -> ParsedModule -> Action (IdeResult TcModuleResult)
typeCheckRuleDefinition HscEnv
hsc ParsedModule
pm = do
  Priority -> Action ()
setPriority Priority
priorityTypeCheck
  IdeOptions { optDefer :: IdeOptions -> IdeDefer
optDefer = IdeDefer
defer } <- Action IdeOptions
getIdeOptions

  [Linkable]
linkables_to_keep <- Action [Linkable]
currentLinkables
  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 (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
-> [Linkable]
-> ParsedModule
-> IO (IdeResult TcModuleResult)
typecheckModule IdeDefer
defer HscEnv
hsc [Linkable]
linkables_to_keep ParsedModule
pm
  where
    addUsageDependencies :: Action (a, Maybe TcModuleResult) -> Action (a, Maybe TcModuleResult)
    addUsageDependencies :: 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
        [FilePath]
used_files <- IO [FilePath] -> Action [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Action [FilePath])
-> IO [FilePath] -> Action [FilePath]
forall a b. (a -> b) -> a -> b
$ IORef [FilePath] -> IO [FilePath]
forall a. IORef a -> IO a
readIORef (IORef [FilePath] -> IO [FilePath])
-> IORef [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> IORef [FilePath]
tcg_dependent_files (TcGblEnv -> IORef [FilePath]) -> TcGblEnv -> IORef [FilePath]
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 k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ GetModificationTime
GetModificationTime ((FilePath -> NormalizedFilePath)
-> [FilePath] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> NormalizedFilePath
toNormalizedFilePath' [FilePath]
used_files)
      (a, Maybe TcModuleResult) -> Action (a, Maybe TcModuleResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (a, Maybe TcModuleResult)
r

-- | Get all the linkables stored in the graph, i.e. the ones we *do not* need to unload.
-- Doesn't actually contain the code, since we don't need it to unload
currentLinkables :: Action [Linkable]
currentLinkables :: Action [Linkable]
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. IsIdeGlobal a => Action a
getIdeGlobalAction
    ModuleEnv UTCTime
hm <- IO (ModuleEnv UTCTime) -> Action (ModuleEnv UTCTime)
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
    [Linkable] -> Action [Linkable]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Linkable] -> Action [Linkable])
-> [Linkable] -> Action [Linkable]
forall a b. (a -> b) -> a -> b
$ ((Module, UTCTime) -> Linkable)
-> [(Module, UTCTime)] -> [Linkable]
forall a b. (a -> b) -> [a] -> [b]
map (Module, UTCTime) -> Linkable
go ([(Module, UTCTime)] -> [Linkable])
-> [(Module, UTCTime)] -> [Linkable]
forall a b. (a -> b) -> a -> b
$ ModuleEnv UTCTime -> [(Module, UTCTime)]
forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv UTCTime
hm
  where
    go :: (Module, UTCTime) -> Linkable
go (Module
mod, UTCTime
time) = UTCTime -> Module -> [Unlinked] -> Linkable
LM UTCTime
time Module
mod []

loadGhcSession :: GhcSessionDepsConfig -> Rules ()
loadGhcSession :: GhcSessionDepsConfig -> Rules ()
loadGhcSession GhcSessionDepsConfig
ghcSessionDepsConfig = do
    -- This function should always be rerun because it tracks changes
    -- to the version of the collection of HscEnv's.
    (GhcSessionIO -> Action (ByteString, IdeGhcSession)) -> Rules ()
forall k v.
IdeRule k v =>
(k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((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
        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
$ Key -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Key -> ByteString) -> Key -> ByteString
forall a b. (a -> b) -> a -> b
$ Key -> Key
forall a. Hashable a => a -> Key
hash (IdeGhcSession -> Key
sessionVersion IdeGhcSession
res)
        (ByteString, IdeGhcSession) -> Action (ByteString, IdeGhcSession)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
fingerprint, IdeGhcSession
res)

    RuleBody GhcSession HscEnvEq -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (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{FilePath -> IO (IdeResult HscEnvEq, [FilePath])
loadSessionFun :: IdeGhcSession -> FilePath -> IO (IdeResult HscEnvEq, [FilePath])
loadSessionFun :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
loadSessionFun} <- GhcSessionIO -> Action IdeGhcSession
forall k v. IdeRule k v => k -> Action v
useNoFile_ GhcSessionIO
GhcSessionIO
        (IdeResult HscEnvEq
val,[FilePath]
deps) <- IO (IdeResult HscEnvEq, [FilePath])
-> Action (IdeResult HscEnvEq, [FilePath])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult HscEnvEq, [FilePath])
 -> Action (IdeResult HscEnvEq, [FilePath]))
-> IO (IdeResult HscEnvEq, [FilePath])
-> Action (IdeResult HscEnvEq, [FilePath])
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (IdeResult HscEnvEq, [FilePath])
loadSessionFun (FilePath -> IO (IdeResult HscEnvEq, [FilePath]))
-> FilePath -> IO (IdeResult HscEnvEq, [FilePath])
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
file

        -- add the deps to the Shake graph
        let addDependency :: FilePath -> Action ()
addDependency FilePath
fp = do
                -- VSCode uses absolute paths in its filewatch notifications
                FilePath
afp <- IO FilePath -> Action FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> Action FilePath) -> IO FilePath -> Action FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
makeAbsolute FilePath
fp
                let nfp :: NormalizedFilePath
nfp = FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
afp
                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
        (FilePath -> Action ()) -> [FilePath] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> Action ()
addDependency [FilePath]
deps

        IdeOptions
opts <- Action IdeOptions
getIdeOptions
        let cutoffHash :: ByteString
cutoffHash =
              case IdeOptions -> Maybe FilePath
optShakeFiles IdeOptions
opts of
                -- optShakeFiles is only set in the DAML case.
                -- https://github.com/haskell/ghcide/pull/522#discussion_r428622915
                Just {} -> ByteString
""
                -- Hash the HscEnvEq returned so cutoff if it didn't change
                -- from last time
                Maybe FilePath
Nothing -> ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Key -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Maybe HscEnvEq -> Key
forall a. Hashable a => a -> Key
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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
cutoffHash, IdeResult HscEnvEq
val)

    (GhcSessionDeps -> NormalizedFilePath -> Action (Maybe HscEnvEq))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((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
checkForImportCycles :: Bool
    }
instance Default GhcSessionDepsConfig where
  def :: GhcSessionDepsConfig
def = GhcSessionDepsConfig :: Bool -> GhcSessionDepsConfig
GhcSessionDepsConfig
    { $sel:checkForImportCycles:GhcSessionDepsConfig :: Bool
checkForImportCycles = Bool
True
    }

ghcSessionDepsDefinition
    :: -- | full mod summary
        Bool ->
        GhcSessionDepsConfig -> HscEnvEq -> NormalizedFilePath -> Action (Maybe HscEnvEq)
ghcSessionDepsDefinition :: Bool
-> GhcSessionDepsConfig
-> HscEnvEq
-> NormalizedFilePath
-> Action (Maybe HscEnvEq)
ghcSessionDepsDefinition Bool
fullModSummary GhcSessionDepsConfig{Bool
checkForImportCycles :: Bool
$sel:checkForImportCycles:GhcSessionDepsConfig :: GhcSessionDepsConfig -> 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)
mapM((ArtifactsLocation -> NormalizedFilePath)
-> Maybe ArtifactsLocation -> Maybe NormalizedFilePath
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 (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
checkForImportCycles (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]
uses_ ReportImportCycles
ReportImportCycles [NormalizedFilePath]
deps
            [ModSummary]
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
<$> if Bool
fullModSummary
                then GetModSummary -> [NormalizedFilePath] -> Action [ModSummaryResult]
forall k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ GetModSummary
GetModSummary [NormalizedFilePath]
deps
                else GetModSummaryWithoutTimestamps
-> [NormalizedFilePath] -> Action [ModSummaryResult]
forall k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps [NormalizedFilePath]
deps

            [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 k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ (Bool -> GhcSessionDeps
GhcSessionDeps_ Bool
fullModSummary) [NormalizedFilePath]
deps
            [HiFileResult]
ifaces <- GetModIface -> [NormalizedFilePath] -> Action [HiFileResult]
forall k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ GetModIface
GetModIface [NormalizedFilePath]
deps

            let inLoadOrder :: [HomeModInfo]
inLoadOrder = (HiFileResult -> HomeModInfo) -> [HiFileResult] -> [HomeModInfo]
forall a b. (a -> b) -> [a] -> [b]
map HiFileResult -> HomeModInfo
hirHomeMod [HiFileResult]
ifaces
            HscEnv
session' <- IO HscEnv -> Action HscEnv
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 -> [ModSummary] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv
mergeEnvs HscEnv
hsc [ModSummary]
mss [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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe (Set FilePath)
-> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
newHscEnvEqWithImportPaths (HscEnvEq -> Maybe (Set FilePath)
envImportPaths HscEnvEq
env) HscEnv
session' [])

-- | Load a iface from disk, or generate it if there isn't one or it is out of date
-- This rule also ensures that the `.hie` and `.o` (if needed) files are written out.
getModIfaceFromDiskRule :: Rules ()
getModIfaceFromDiskRule :: Rules ()
getModIfaceFromDiskRule = RuleBody GetModIfaceFromDisk HiFileResult -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (RuleBody GetModIfaceFromDisk HiFileResult -> Rules ())
-> RuleBody GetModIfaceFromDisk HiFileResult -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetModIfaceFromDisk
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIfaceFromDisk HiFileResult
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
Rule ((GetModIfaceFromDisk
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult HiFileResult))
 -> RuleBody GetModIfaceFromDisk HiFileResult)
-> (GetModIfaceFromDisk
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult HiFileResult))
-> RuleBody GetModIfaceFromDisk HiFileResult
forall a b. (a -> b) -> a -> b
$ \GetModIfaceFromDisk
GetModIfaceFromDisk NormalizedFilePath
f -> 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 (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
      SourceModified
sourceModified <- IsHiFileStable -> NormalizedFilePath -> Action SourceModified
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ IsHiFileStable
IsHiFileStable NormalizedFilePath
f
      Maybe LinkableType
linkableType <- NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType NormalizedFilePath
f
      IdeResult HiFileResult
r <- HscEnv
-> ModSummary
-> SourceModified
-> Maybe LinkableType
-> (Maybe LinkableType -> Action (IdeResult HiFileResult))
-> Action (IdeResult HiFileResult)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
HscEnv
-> ModSummary
-> SourceModified
-> Maybe LinkableType
-> (Maybe LinkableType -> m (IdeResult HiFileResult))
-> m (IdeResult HiFileResult)
loadInterface (HscEnvEq -> HscEnv
hscEnv HscEnvEq
session) ModSummary
ms SourceModified
sourceModified Maybe LinkableType
linkableType (HscEnvEq
-> NormalizedFilePath
-> ModSummary
-> Maybe LinkableType
-> Action (IdeResult HiFileResult)
regenerateHiFile HscEnvEq
session NormalizedFilePath
f ModSummary
ms)
      case IdeResult HiFileResult
r of
        ([FileDiagnostic]
diags, Maybe HiFileResult
Nothing) -> (Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
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 (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
fp, ([FileDiagnostic]
diags, HiFileResult -> Maybe HiFileResult
forall a. a -> Maybe a
Just HiFileResult
x))

-- | Check state of hiedb after loading an iface from disk - have we indexed the corresponding `.hie` file?
-- This function is responsible for ensuring database consistency
-- Whenever we read a `.hi` file, we must check to ensure we have also
-- indexed the corresponding `.hie` file. If this is not the case (for example,
-- `ghcide` could be killed before indexing finishes), we must re-index the
-- `.hie` file. There should be an up2date `.hie` file on
-- disk since we are careful to write out the `.hie` file before writing the
-- `.hi` file
getModIfaceFromDiskAndIndexRule :: Rules ()
getModIfaceFromDiskAndIndexRule :: Rules ()
getModIfaceFromDiskAndIndexRule =
  -- doesn't need early cutoff since all its dependencies already have it
  (GetModIfaceFromDiskAndIndex
 -> NormalizedFilePath -> Action (Maybe HiFileResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((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
withHieDb :: WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb} <- Action ShakeExtras
getShakeExtras

  -- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db
  let ms :: ModSummary
ms = HiFileResult -> ModSummary
hirModSummary HiFileResult
x
      hie_loc :: FilePath
hie_loc = ModLocation -> FilePath
Compat.ml_hie_file (ModLocation -> FilePath) -> ModLocation -> FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
  Fingerprint
hash <- IO Fingerprint -> Action Fingerprint
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
$ FilePath -> IO Fingerprint
Util.getFileHash FilePath
hie_loc
  Maybe HieModuleRow
mrow <- IO (Maybe HieModuleRow) -> Action (Maybe HieModuleRow)
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 -> FilePath -> IO (Maybe HieModuleRow)
HieDb.lookupHieFileFromSource HieDb
hieDb (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f))
  Maybe FilePath
hie_loc' <- IO (Maybe FilePath) -> Action (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> Action (Maybe FilePath))
-> IO (Maybe FilePath) -> Action (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (HieModuleRow -> IO FilePath)
-> Maybe HieModuleRow -> IO (Maybe FilePath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath -> IO FilePath
makeAbsolute (FilePath -> IO FilePath)
-> (HieModuleRow -> FilePath) -> HieModuleRow -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieModuleRow -> FilePath
HieDb.hieModuleHieFile) Maybe HieModuleRow
mrow
  case Maybe HieModuleRow
mrow of
    Just HieModuleRow
row
      | Fingerprint
hash Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleInfo -> Fingerprint
HieDb.modInfoHash (HieModuleRow -> ModuleInfo
HieDb.hieModInfo HieModuleRow
row)
      Bool -> Bool -> Bool
&& FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
hie_loc Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe FilePath
hie_loc'
      -> do
      -- All good, the db has indexed the file
      Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IdeTesting -> Bool
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 (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 'CustomMethod
-> MessageParams 'CustomMethod -> LspT Config IO ()
forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification (Text -> SServerMethod 'CustomMethod
forall (f :: From) (t :: MethodType). Text -> SMethod 'CustomMethod
SCustomMethod Text
"ghcide/reference/ready") (MessageParams 'CustomMethod -> LspT Config IO ())
-> MessageParams 'CustomMethod -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
          FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON (FilePath -> Value) -> FilePath -> Value
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f
    -- Not in db, must re-index
    Maybe HieModuleRow
_ -> do
      Either SomeException HieFile
ehf <- IO (Either SomeException HieFile)
-> Action (Either SomeException HieFile)
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
$ FilePath
-> ShakeExtras
-> IdeAction (Either SomeException HieFile)
-> IO (Either SomeException HieFile)
forall a. FilePath -> ShakeExtras -> IdeAction a -> IO a
runIdeAction FilePath
"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
$
        FilePath -> ExceptT SomeException IdeAction HieFile
readHieFileFromDisk FilePath
hie_loc
      case Either SomeException HieFile
ehf of
        -- Uh oh, we failed to read the file for some reason, need to regenerate it
        Left SomeException
err -> FilePath -> Action ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"failed to read .hie file " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
hie_loc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException SomeException
err
        -- can just re-index the file we read from disk
        Right HieFile
hf -> IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
          Logger -> Text -> IO ()
L.logDebug (ShakeExtras -> Logger
logger ShakeExtras
se) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Re-indexing hie file for" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f)
          ShakeExtras
-> ModSummary
-> NormalizedFilePath
-> Fingerprint
-> HieFile
-> IO ()
indexHieFile ShakeExtras
se ModSummary
ms NormalizedFilePath
f Fingerprint
hash HieFile
hf

  Maybe HiFileResult -> Action (Maybe HiFileResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (HiFileResult -> Maybe HiFileResult
forall a. a -> Maybe a
Just HiFileResult
x)

isHiFileStableRule :: Rules ()
isHiFileStableRule :: Rules ()
isHiFileStableRule = RuleBody IsHiFileStable SourceModified -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (RuleBody IsHiFileStable SourceModified -> Rules ())
-> RuleBody IsHiFileStable SourceModified -> Rules ()
forall a b. (a -> b) -> a -> b
$ (IsHiFileStable
 -> NormalizedFilePath
 -> Action (Maybe ByteString, Maybe SourceModified))
-> RuleBody IsHiFileStable SourceModified
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleNoDiagnostics ((IsHiFileStable
  -> NormalizedFilePath
  -> Action (Maybe ByteString, Maybe SourceModified))
 -> RuleBody IsHiFileStable SourceModified)
-> (IsHiFileStable
    -> NormalizedFilePath
    -> Action (Maybe ByteString, Maybe SourceModified))
-> RuleBody IsHiFileStable SourceModified
forall a b. (a -> b) -> a -> b
$ \IsHiFileStable
IsHiFileStable NormalizedFilePath
f -> 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
f
    let hiFile :: NormalizedFilePath
hiFile = FilePath -> NormalizedFilePath
toNormalizedFilePath'
                (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ ModLocation -> FilePath
Compat.ml_hi_file (ModLocation -> FilePath) -> ModLocation -> FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
    Maybe FileVersion
mbHiVersion <- GetModificationTime
-> NormalizedFilePath -> Action (Maybe FileVersion)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use  GetModificationTime_ :: Bool -> GetModificationTime
GetModificationTime_{missingFileDiagnostics :: Bool
missingFileDiagnostics=Bool
False} NormalizedFilePath
hiFile
    FileVersion
modVersion  <- GetModificationTime -> NormalizedFilePath -> Action FileVersion
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModificationTime
GetModificationTime NormalizedFilePath
f
    SourceModified
sourceModified <- case Maybe FileVersion
mbHiVersion of
        Maybe FileVersion
Nothing -> SourceModified -> Action SourceModified
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceModified
SourceModified
        Just FileVersion
x ->
            if FileVersion -> Maybe UTCTime
modificationTime FileVersion
x Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< FileVersion -> Maybe UTCTime
modificationTime FileVersion
modVersion
                then SourceModified -> Action SourceModified
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceModified
SourceModified
                else do
                    [(Located ModuleName, Maybe ArtifactsLocation)]
fileImports <- GetLocatedImports
-> NormalizedFilePath
-> Action [(Located ModuleName, Maybe ArtifactsLocation)]
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetLocatedImports
GetLocatedImports NormalizedFilePath
f
                    let imports :: [Maybe NormalizedFilePath]
imports = (ArtifactsLocation -> NormalizedFilePath)
-> Maybe ArtifactsLocation -> Maybe NormalizedFilePath
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)
-> [(Located ModuleName, Maybe ArtifactsLocation)]
-> [Maybe NormalizedFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Located ModuleName, Maybe ArtifactsLocation)]
fileImports
                    [SourceModified]
deps <- IsHiFileStable -> [NormalizedFilePath] -> Action [SourceModified]
forall k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ IsHiFileStable
IsHiFileStable ([Maybe NormalizedFilePath] -> [NormalizedFilePath]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NormalizedFilePath]
imports)
                    SourceModified -> Action SourceModified
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceModified -> Action SourceModified)
-> SourceModified -> Action SourceModified
forall a b. (a -> b) -> a -> b
$ if (SourceModified -> Bool) -> [SourceModified] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SourceModified -> SourceModified -> Bool
forall a. Eq a => a -> a -> Bool
== SourceModified
SourceUnmodifiedAndStable) [SourceModified]
deps
                           then SourceModified
SourceUnmodifiedAndStable
                           else SourceModified
SourceUnmodified
    (Maybe ByteString, Maybe SourceModified)
-> Action (Maybe ByteString, Maybe SourceModified)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (SourceModified -> ByteString
summarize SourceModified
sourceModified), SourceModified -> Maybe SourceModified
forall a. a -> Maybe a
Just SourceModified
sourceModified)
  where
      summarize :: SourceModified -> ByteString
summarize SourceModified
SourceModified            = Word8 -> ByteString
BS.singleton Word8
1
      summarize SourceModified
SourceUnmodified          = Word8 -> ByteString
BS.singleton Word8
2
      summarize SourceModified
SourceUnmodifiedAndStable = Word8 -> ByteString
BS.singleton Word8
3

displayTHWarning :: LspT c IO ()
displayTHWarning :: LspT c IO ()
displayTHWarning
  | Bool -> Bool
not Bool
isWindows Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hostIsDynamic = do
      SServerMethod 'WindowShowMessage
-> MessageParams 'WindowShowMessage -> LspT c IO ()
forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod m -> MessageParams m -> f ()
LSP.sendNotification SServerMethod 'WindowShowMessage
SWindowShowMessage (MessageParams 'WindowShowMessage -> LspT c IO ())
-> MessageParams 'WindowShowMessage -> LspT c IO ()
forall a b. (a -> b) -> a -> b
$
        MessageType -> Text -> ShowMessageParams
ShowMessageParams MessageType
MtInfo (Text -> ShowMessageParams) -> Text -> ShowMessageParams
forall a b. (a -> b) -> a -> b
$ [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."
          ]
  | Bool
otherwise = () -> LspT c IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

newtype DisplayTHWarning = DisplayTHWarning (IO ())
instance IsIdeGlobal DisplayTHWarning

getModSummaryRule :: Rules ()
getModSummaryRule :: Rules ()
getModSummaryRule = do
    Maybe (LanguageContextEnv Config)
env <- 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
    IO ()
displayItOnce <- IO (IO ()) -> Rules (IO ())
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 (Maybe (LanguageContextEnv Config) -> LanguageContextEnv Config
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LanguageContextEnv Config)
env) LspT Config IO ()
forall c. LspT c IO ()
displayTHWarning
    DisplayTHWarning -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (IO () -> DisplayTHWarning
DisplayTHWarning IO ()
displayItOnce)

    RuleBody GetModSummary ModSummaryResult -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (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 :: FilePath
fp = NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f
        Either [FileDiagnostic] ModSummaryResult
modS <- IO (Either [FileDiagnostic] ModSummaryResult)
-> Action (Either [FileDiagnostic] ModSummaryResult)
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
-> FilePath
-> UTCTime
-> Maybe StringBuffer
-> ExceptT [FileDiagnostic] IO ModSummaryResult
getModSummaryFromImports HscEnv
session FilePath
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
                -- Check for Template Haskell
                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. IsIdeGlobal a => Action a
getIdeGlobalAction
                    IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
act
                Fingerprint
bufFingerPrint <- IO Fingerprint -> Action Fingerprint
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
$
                    StringBuffer -> IO Fingerprint
fingerprintFromStringBuffer (StringBuffer -> IO Fingerprint) -> StringBuffer -> IO Fingerprint
forall a b. (a -> b) -> a -> b
$ Maybe StringBuffer -> StringBuffer
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe StringBuffer -> StringBuffer)
-> Maybe StringBuffer -> StringBuffer
forall a b. (a -> b) -> a -> b
$ ModSummary -> Maybe StringBuffer
ms_hspp_buf (ModSummary -> Maybe StringBuffer)
-> ModSummary -> Maybe StringBuffer
forall a b. (a -> b) -> a -> b
$ ModSummaryResult -> ModSummary
msrModSummary ModSummaryResult
res
                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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([FileDiagnostic]
diags, Maybe ModSummaryResult
forall a. Maybe a
Nothing))

    RuleBody GetModSummaryWithoutTimestamps ModSummaryResult
-> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (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
ms <- GetModSummary
-> NormalizedFilePath -> Action (Maybe ModSummaryResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummary
GetModSummary NormalizedFilePath
f
        case Maybe ModSummaryResult
ms of
            Just res :: ModSummaryResult
res@ModSummaryResult{[LImportDecl GhcPs]
Fingerprint
ModSummary
msrImports :: ModSummaryResult -> [LImportDecl GhcPs]
msrFingerprint :: Fingerprint
msrImports :: [LImportDecl GhcPs]
msrModSummary :: ModSummary
msrFingerprint :: ModSummaryResult -> Fingerprint
msrModSummary :: ModSummaryResult -> ModSummary
..} -> do
                let ms :: ModSummary
ms = ModSummary
msrModSummary {
                    ms_hs_date :: UTCTime
ms_hs_date = FilePath -> UTCTime
forall a. HasCallStack => FilePath -> a
error FilePath
"use GetModSummary instead of GetModSummaryWithoutTimestamps",
                    ms_hspp_buf :: Maybe StringBuffer
ms_hspp_buf = FilePath -> Maybe StringBuffer
forall a. HasCallStack => FilePath -> a
error FilePath
"use GetModSummary instead of GetModSummaryWithoutTimestamps"
                    }
                    fp :: ByteString
fp = Fingerprint -> ByteString
fingerprintToBS Fingerprint
msrFingerprint
                (Maybe ByteString, Maybe ModSummaryResult)
-> Action (Maybe ByteString, Maybe ModSummaryResult)
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 :: ModSummary
msrModSummary = ModSummary
ms})
            Maybe ModSummaryResult
Nothing -> (Maybe ByteString, Maybe ModSummaryResult)
-> Action (Maybe ByteString, Maybe ModSummaryResult)
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
    Priority -> Action ()
setPriority Priority
priorityGenerateCore
    IO (IdeResult ModGuts) -> Action (IdeResult ModGuts)
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 :: Rules ()
generateCoreRule :: Rules ()
generateCoreRule =
    (GenerateCore -> NormalizedFilePath -> Action (IdeResult ModGuts))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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 :: Rules ()
getModIfaceRule :: Rules ()
getModIfaceRule = RuleBody GetModIface HiFileResult -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (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
  res :: (Maybe ByteString, IdeResult HiFileResult)
res@(Maybe ByteString
_,([FileDiagnostic]
_,Maybe HiFileResult
mhmi)) <- case IsFileOfInterestResult
fileOfInterest of
    IsFOI FileOfInterestStatus
status -> do
      -- Never load from disk for files of interest
      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 (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
      ([FileDiagnostic]
diags, !Maybe HiFileResult
hiFile) <- HscEnv
-> Maybe LinkableType
-> Action (IdeResult ModGuts)
-> TcModuleResult
-> Action (IdeResult HiFileResult)
forall (m :: * -> *).
MonadIO m =>
HscEnv
-> Maybe LinkableType
-> CompileMod m
-> TcModuleResult
-> m (IdeResult HiFileResult)
compileToObjCodeIfNeeded 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
hiFile
      [FileDiagnostic]
hiDiags <- case Maybe HiFileResult
hiFile of
        Just HiFileResult
hiFile
          | FileOfInterestStatus
OnDisk <- FileOfInterestStatus
status
          , Bool -> Bool
not (TcModuleResult -> Bool
tmrDeferedError TcModuleResult
tmr) -> HscEnv -> HiFileResult -> Action [FileDiagnostic]
writeHiFileAction HscEnv
hsc HiFileResult
hiFile
        Maybe HiFileResult
_ -> [FileDiagnostic] -> Action [FileDiagnostic]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      (Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
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
hiFile))
    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 (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
fp, ([], Maybe HiFileResult
hiFile))

  -- Record the linkable so we know not to unload it
  Maybe Linkable -> (Linkable -> Action ()) -> Action ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (HomeModInfo -> Maybe Linkable
hm_linkable (HomeModInfo -> Maybe Linkable)
-> (HiFileResult -> HomeModInfo) -> HiFileResult -> Maybe Linkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HiFileResult -> HomeModInfo
hirHomeMod (HiFileResult -> Maybe Linkable)
-> Maybe HiFileResult -> Maybe Linkable
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe HiFileResult
mhmi) ((Linkable -> Action ()) -> Action ())
-> (Linkable -> Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ \(LM UTCTime
time Module
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. IsIdeGlobal a => Action a
getIdeGlobalAction
      IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ IO (ModuleEnv UTCTime) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ModuleEnv UTCTime) -> IO ())
-> IO (ModuleEnv UTCTime) -> IO ()
forall a b. (a -> b) -> a -> b
$ Var (ModuleEnv UTCTime)
-> (ModuleEnv UTCTime -> ModuleEnv UTCTime)
-> IO (ModuleEnv UTCTime)
forall a. Var a -> (a -> a) -> IO a
modifyVar' Var (ModuleEnv UTCTime)
compiledLinkables ((ModuleEnv UTCTime -> ModuleEnv UTCTime)
 -> IO (ModuleEnv UTCTime))
-> (ModuleEnv UTCTime -> ModuleEnv UTCTime)
-> IO (ModuleEnv UTCTime)
forall a b. (a -> b) -> a -> b
$ \ModuleEnv UTCTime
old -> ModuleEnv UTCTime -> Module -> UTCTime -> ModuleEnv UTCTime
forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv ModuleEnv UTCTime
old Module
mod UTCTime
time
  (Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString, IdeResult HiFileResult)
res

-- | Also generates and indexes the `.hie` file, along with the `.o` file if needed
-- Invariant maintained is that if the `.hi` file was successfully written, then the
-- `.hie` and `.o` file (if needed) were also successfully written
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

    -- Embed haddocks in the interface file
    ([FileDiagnostic]
diags, Maybe ParsedModule
mb_pm) <- IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
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)
    ([FileDiagnostic]
diags, Maybe ParsedModule
mb_pm) <-
        -- We no longer need to parse again if GHC version is above 9.0. https://github.com/haskell/haskell-language-server/issues/1892
        if GhcVersion
Compat.ghcVersion GhcVersion -> GhcVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= GhcVersion
Compat.GHC90 Bool -> Bool -> Bool
|| Maybe ParsedModule -> Bool
forall a. Maybe a -> Bool
isJust Maybe ParsedModule
mb_pm then do
            IdeResult ParsedModule -> Action (IdeResult ParsedModule)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileDiagnostic]
diags, Maybe ParsedModule
mb_pm)
        else do
            -- if parsing fails, try parsing again with Haddock turned off
            ([FileDiagnostic]
diagsNoHaddock, Maybe ParsedModule
mb_pm) <- IO (IdeResult ParsedModule) -> Action (IdeResult ParsedModule)
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
ms
            IdeResult ParsedModule -> Action (IdeResult ParsedModule)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
mergeParseErrorsHaddock [FileDiagnostic]
diagsNoHaddock [FileDiagnostic]
diags, Maybe ParsedModule
mb_pm)
    case Maybe ParsedModule
mb_pm of
        Maybe ParsedModule
Nothing -> IdeResult HiFileResult -> Action (IdeResult HiFileResult)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileDiagnostic]
diags, Maybe HiFileResult
forall a. Maybe a
Nothing)
        Just ParsedModule
pm -> do
            -- Invoke typechecking directly to update it without incurring a dependency
            -- on the parsed module and the typecheck rules
            ([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 (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags', Maybe HiFileResult
forall a. Maybe a
Nothing)
              Just TcModuleResult
tmr -> do

                -- compile writes .o file
                let compile :: IO (IdeResult ModGuts)
compile = 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

                -- Bang pattern is important to avoid leaking 'tmr'
                ([FileDiagnostic]
diags'', !Maybe HiFileResult
res) <- IO (IdeResult HiFileResult) -> Action (IdeResult HiFileResult)
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
$ HscEnv
-> Maybe LinkableType
-> IO (IdeResult ModGuts)
-> TcModuleResult
-> IO (IdeResult HiFileResult)
forall (m :: * -> *).
MonadIO m =>
HscEnv
-> Maybe LinkableType
-> CompileMod m
-> TcModuleResult
-> m (IdeResult HiFileResult)
compileToObjCodeIfNeeded HscEnv
hsc Maybe LinkableType
compNeeded IO (IdeResult ModGuts)
compile TcModuleResult
tmr

                -- Write hi file
                [FileDiagnostic]
hiDiags <- case Maybe HiFileResult
res of
                  Just !HiFileResult
hiFile -> do

                    -- Write hie file. Do this before writing the .hi file to
                    -- ensure that we always have a up2date .hie file if we have
                    -- a .hi file
                    ShakeExtras
se <- Action ShakeExtras
getShakeExtras
                    ([FileDiagnostic]
gDiags, Maybe (HieASTs Type)
masts) <- IO ([FileDiagnostic], Maybe (HieASTs Type))
-> Action ([FileDiagnostic], Maybe (HieASTs Type))
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 (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

                    -- We don't write the `.hi` file if there are defered errors, since we won't get
                    -- accurate diagnostics next time if we do
                    [FileDiagnostic]
hiDiags <- if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> Bool
tmrDeferedError TcModuleResult
tmr
                               then HscEnv -> HiFileResult -> Action [FileDiagnostic]
writeHiFileAction HscEnv
hsc HiFileResult
hiFile
                               else [FileDiagnostic] -> Action [FileDiagnostic]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

                    [FileDiagnostic] -> Action [FileDiagnostic]
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 (f :: * -> *) a. Applicative f => a -> f a
pure []


                IdeResult HiFileResult -> Action (IdeResult HiFileResult)
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)


type CompileMod m = m (IdeResult ModGuts)

-- | HscEnv should have deps included already
compileToObjCodeIfNeeded :: MonadIO m => HscEnv -> Maybe LinkableType -> CompileMod m -> TcModuleResult -> m (IdeResult HiFileResult)
compileToObjCodeIfNeeded :: HscEnv
-> Maybe LinkableType
-> CompileMod m
-> TcModuleResult
-> m (IdeResult HiFileResult)
compileToObjCodeIfNeeded HscEnv
hsc Maybe LinkableType
Nothing CompileMod m
_ TcModuleResult
tmr = IO (IdeResult HiFileResult) -> m (IdeResult HiFileResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult HiFileResult) -> m (IdeResult HiFileResult))
-> IO (IdeResult HiFileResult) -> m (IdeResult HiFileResult)
forall a b. (a -> b) -> a -> b
$ do
  HiFileResult
res <- HscEnv -> TcModuleResult -> IO HiFileResult
mkHiFileResultNoCompile HscEnv
hsc TcModuleResult
tmr
  IdeResult HiFileResult -> IO (IdeResult HiFileResult)
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)
compileToObjCodeIfNeeded HscEnv
hsc (Just LinkableType
linkableType) CompileMod m
getGuts TcModuleResult
tmr = do
  ([FileDiagnostic]
diags, Maybe ModGuts
mguts) <- CompileMod m
getGuts
  case Maybe ModGuts
mguts of
    Maybe ModGuts
Nothing -> IdeResult HiFileResult -> m (IdeResult HiFileResult)
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) -> m (IdeResult HiFileResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult HiFileResult) -> m (IdeResult HiFileResult))
-> IO (IdeResult HiFileResult) -> m (IdeResult HiFileResult)
forall a b. (a -> b) -> a -> b
$ HscEnv
-> TcModuleResult
-> ModGuts
-> LinkableType
-> IO (IdeResult HiFileResult)
mkHiFileResultCompile HscEnv
hsc TcModuleResult
tmr ModGuts
guts LinkableType
linkableType
      IdeResult HiFileResult -> m (IdeResult HiFileResult)
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 :: Rules ()
getClientSettingsRule :: Rules ()
getClientSettingsRule = (GetClientSettings -> Action (ByteString, Hashed (Maybe Value)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((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 (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Key -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Key -> ByteString) -> Key -> ByteString
forall a b. (a -> b) -> a -> b
$ Hashed (Maybe Value) -> Key
forall a. Hashable a => a -> Key
hash Hashed (Maybe Value)
settings, Hashed (Maybe Value)
settings)

-- | Returns the client configurarion stored in the IdeState.
-- You can use this function to access it from shake Rules
getClientConfigAction :: Config -- ^ default value
                      -> Action Config
getClientConfigAction :: Config -> Action Config
getClientConfigAction Config
defValue = do
  Maybe Value
mbVal <- Hashed (Maybe Value) -> Maybe Value
forall a. Hashed a -> a
unhashed (Hashed (Maybe Value) -> Maybe Value)
-> Action (Hashed (Maybe Value)) -> Action (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetClientSettings -> Action (Hashed (Maybe Value))
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetClientSettings
GetClientSettings
  case (Value -> Parser Config) -> Value -> Result Config
forall a b. (a -> Parser b) -> a -> Result b
A.parse (Config -> Value -> Parser Config
parseConfig Config
defValue) (Value -> Result Config) -> Maybe Value -> Maybe (Result Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
mbVal of
    Just (Success Config
c) -> Config -> Action Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
c
    Maybe (Result Config)
_                -> Config -> Action Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defValue

usePropertyAction ::
  (HasProperty s k t r) =>
  KeyNameProxy s ->
  PluginId ->
  Properties r ->
  Action (ToHsType t)
usePropertyAction :: KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction KeyNameProxy s
kn PluginId
plId Properties r
p = do
  Config
config <- Config -> Action Config
getClientConfigAction Config
forall a. Default a => a
def
  let pluginConfig :: PluginConfig
pluginConfig = Config -> PluginId -> PluginConfig
configForPlugin Config
config PluginId
plId
  ToHsType t -> Action (ToHsType t)
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

-- ---------------------------------------------------------------------

-- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH
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 :: Rules ()
needsCompilationRule :: NormalizedFilePath  -> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
needsCompilationRule :: NormalizedFilePath
-> Action (IdeResultNoDiagnosticsEarlyCutoff (Maybe LinkableType))
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
    -- Treat as False if some reverse dependency header fails to parse
    Maybe DependencyInformation
Nothing -> Maybe LinkableType -> Action (Maybe LinkableType)
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
      -- If we fail to get immediate reverse dependencies, fail with an error message
      Maybe [NormalizedFilePath]
Nothing -> FilePath -> Action (Maybe LinkableType)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action (Maybe LinkableType))
-> FilePath -> Action (Maybe LinkableType)
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to get the immediate reverse dependencies of " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> FilePath
forall a. Show a => a -> FilePath
show NormalizedFilePath
file
      Just [NormalizedFilePath]
revdeps -> do
        -- It's important to use stale data here to avoid wasted work.
        -- if NeedsCompilation fails for a module M its result will be  under-approximated
        -- to False in its dependencies. However, if M actually used TH, this will
        -- cause a re-evaluation of GetModIface for all dependencies
        -- (since we don't need to generate object code anymore).
        -- Once M is fixed we will discover that we actually needed all the object code
        -- that we just threw away, and thus have to recompile all dependencies once
        -- again, this time keeping the object code.
        -- A file needs to be compiled if any file that depends on it uses TemplateHaskell or needs to be compiled
        ModSummary
ms <- 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 ((ModSummaryResult, PositionMapping) -> ModSummary)
-> Action (ModSummaryResult, PositionMapping) -> Action ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action (ModSummaryResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
        ([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 (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 (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 k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe (v, PositionMapping)]
usesWithStale GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps [NormalizedFilePath]
revdeps)
                (NeedsCompilation
-> [NormalizedFilePath] -> Action [Maybe (Maybe LinkableType)]
forall k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe v]
uses NeedsCompilation
NeedsCompilation [NormalizedFilePath]
revdeps)
        Maybe LinkableType -> Action (Maybe LinkableType)
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
$ ModSummary
-> [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
computeLinkableType ModSummary
ms [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 (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 :: ModSummary -> [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
    computeLinkableType :: ModSummary
-> [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
computeLinkableType ModSummary
this [Maybe ModSummary]
deps [Maybe LinkableType]
xs
      | LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
ObjectLinkable Maybe LinkableType -> [Maybe LinkableType] -> 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 -- If any dependent needs object code, so do we
      | LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
BCOLinkable    Maybe LinkableType -> [Maybe LinkableType] -> 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
this_type      -- If any dependent needs bytecode, then we need to be compiled
      | (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
this_type      -- If any dependent needs TH, then we need to be compiled
      | Bool
otherwise                         = Maybe LinkableType
forall a. Maybe a
Nothing             -- If none of these conditions are satisfied, we don't need to compile
      where
        this_type :: LinkableType
this_type = DynFlags -> LinkableType
computeLinkableTypeForDynFlags (ModSummary -> DynFlags
ms_hspp_opts ModSummary
this)

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

-- | How should we compile this module?
-- (assuming we do in fact need to compile it).
-- Depends on whether it uses unboxed tuples or sums
computeLinkableTypeForDynFlags :: DynFlags -> LinkableType
computeLinkableTypeForDynFlags :: DynFlags -> LinkableType
computeLinkableTypeForDynFlags DynFlags
d
#if defined(GHC_PATCHED_UNBOXED_BYTECODE)
          = BCOLinkable
#else
          | Bool
unboxed_tuples_or_sums = LinkableType
ObjectLinkable
          | Bool
otherwise              = LinkableType
BCOLinkable
#endif
  where
        unboxed_tuples_or_sums :: Bool
unboxed_tuples_or_sums =
            Extension -> DynFlags -> Bool
xopt Extension
LangExt.UnboxedTuples DynFlags
d Bool -> Bool -> Bool
|| Extension -> DynFlags -> Bool
xopt Extension
LangExt.UnboxedSums DynFlags
d

-- | Tracks which linkables are current, so we don't need to unload them
newtype CompiledLinkables = CompiledLinkables { CompiledLinkables -> Var (ModuleEnv UTCTime)
getCompiledLinkables :: Var (ModuleEnv UTCTime) }
instance IsIdeGlobal CompiledLinkables

writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic]
writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic]
writeHiFileAction HscEnv
hsc HiFileResult
hiFile = do
    ShakeExtras
extras <- Action ShakeExtras
getShakeExtras
    let targetPath :: FilePath
targetPath = ModLocation -> FilePath
Compat.ml_hi_file (ModLocation -> FilePath) -> ModLocation -> FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location (ModSummary -> ModLocation) -> ModSummary -> ModLocation
forall a b. (a -> b) -> a -> b
$ HiFileResult -> ModSummary
hirModSummary HiFileResult
hiFile
    IO [FileDiagnostic] -> Action [FileDiagnostic]
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
$ do
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> NormalizedFilePath -> STM ()
resetInterfaceStore ShakeExtras
extras (NormalizedFilePath -> STM ()) -> NormalizedFilePath -> STM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
targetPath
        HscEnv -> HiFileResult -> IO [FileDiagnostic]
writeHiFile HscEnv
hsc HiFileResult
hiFile

data RulesConfig = RulesConfig
    { -- | Disable import cycle checking for improved performance in large codebases
      RulesConfig -> Bool
checkForImportCycles :: Bool
    -- | Disable TH for improved performance in large codebases
    , RulesConfig -> Bool
enableTemplateHaskell :: Bool
    }

instance Default RulesConfig where def :: RulesConfig
def = Bool -> Bool -> RulesConfig
RulesConfig Bool
True Bool
True

-- | A rule that wires per-file rules together
mainRule :: RulesConfig -> Rules ()
mainRule :: RulesConfig -> Rules ()
mainRule RulesConfig{Bool
enableTemplateHaskell :: Bool
checkForImportCycles :: Bool
$sel:enableTemplateHaskell:RulesConfig :: RulesConfig -> Bool
$sel:checkForImportCycles:RulesConfig :: RulesConfig -> Bool
..} = do
    Var (ModuleEnv UTCTime)
linkables <- IO (Var (ModuleEnv UTCTime)) -> Rules (Var (ModuleEnv UTCTime))
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
    Rules ()
getParsedModuleRule
    Rules ()
getParsedModuleWithCommentsRule
    Rules ()
getLocatedImportsRule
    Rules ()
getDependencyInformationRule
    Rules ()
reportImportCyclesRule
    Rules ()
typeCheckRule
    Rules ()
getDocMapRule
    GhcSessionDepsConfig -> Rules ()
loadGhcSession GhcSessionDepsConfig
forall a. Default a => a
def{Bool
checkForImportCycles :: Bool
$sel:checkForImportCycles:GhcSessionDepsConfig :: Bool
checkForImportCycles}
    Rules ()
getModIfaceFromDiskRule
    Rules ()
getModIfaceFromDiskAndIndexRule
    Rules ()
getModIfaceRule
    Rules ()
getModSummaryRule
    Rules ()
isHiFileStableRule
    Rules ()
getModuleGraphRule
    Rules ()
knownFilesRule
    Rules ()
getClientSettingsRule
    Rules ()
getHieAstsRule
    Rules ()
getBindingsRule
    -- This rule uses a custom newness check that relies on the encoding
    --  produced by 'encodeLinkable'. This works as follows:
    --   * <previous> -> <new>
    --   * ObjectLinkable -> BCOLinkable : the prev linkable can be reused,  signal "no change"
    --   * Object/BCO -> NoLinkable      : the prev linkable can be ignored, signal "no change"
    --   * otherwise                     : the prev linkable cannot be reused, signal "value has changed"
    if Bool
enableTemplateHaskell
      then RuleBody NeedsCompilation (Maybe LinkableType) -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (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 (NeedsCompilation
 -> NormalizedFilePath -> Action (Maybe (Maybe LinkableType)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((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 (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
    Rules ()
generateCoreRule
    Rules ()
getImportMapRule
    Rules ()
getAnnotatedParsedSourceRule
    Rules ()
persistentHieFileRule
    Rules ()
persistentDocMapRule
    Rules ()
persistentImportMapRule

-- | Given the path to a module src file, this rule returns True if the
-- corresponding `.hi` file is stable, that is, if it is newer
--   than the src file, and all its dependencies are stable too.
data IsHiFileStable = IsHiFileStable
    deriving (IsHiFileStable -> IsHiFileStable -> Bool
(IsHiFileStable -> IsHiFileStable -> Bool)
-> (IsHiFileStable -> IsHiFileStable -> Bool) -> Eq IsHiFileStable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsHiFileStable -> IsHiFileStable -> Bool
$c/= :: IsHiFileStable -> IsHiFileStable -> Bool
== :: IsHiFileStable -> IsHiFileStable -> Bool
$c== :: IsHiFileStable -> IsHiFileStable -> Bool
Eq, Key -> IsHiFileStable -> FilePath -> FilePath
[IsHiFileStable] -> FilePath -> FilePath
IsHiFileStable -> FilePath
(Key -> IsHiFileStable -> FilePath -> FilePath)
-> (IsHiFileStable -> FilePath)
-> ([IsHiFileStable] -> FilePath -> FilePath)
-> Show IsHiFileStable
forall a.
(Key -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [IsHiFileStable] -> FilePath -> FilePath
$cshowList :: [IsHiFileStable] -> FilePath -> FilePath
show :: IsHiFileStable -> FilePath
$cshow :: IsHiFileStable -> FilePath
showsPrec :: Key -> IsHiFileStable -> FilePath -> FilePath
$cshowsPrec :: Key -> IsHiFileStable -> FilePath -> FilePath
Show, Typeable, (forall x. IsHiFileStable -> Rep IsHiFileStable x)
-> (forall x. Rep IsHiFileStable x -> IsHiFileStable)
-> Generic IsHiFileStable
forall x. Rep IsHiFileStable x -> IsHiFileStable
forall x. IsHiFileStable -> Rep IsHiFileStable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsHiFileStable x -> IsHiFileStable
$cfrom :: forall x. IsHiFileStable -> Rep IsHiFileStable x
Generic)
instance Hashable IsHiFileStable
instance NFData   IsHiFileStable

type instance RuleResult IsHiFileStable = SourceModified