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

{-# LANGUAGE CPP                   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE DuplicateRecordFields #-}
#include "ghc-api-version.h"

-- | A Shake implementation of the compiler service, built
--   using the "Shaker" abstraction layer for in-memory use.
--
module Development.IDE.Core.Rules(
    IdeState, GetDependencies(..), GetParsedModule(..), TransitiveDependencies(..),
    Priority(..), GhcSessionIO(..), GetClientSettings(..),
    priorityTypeCheck,
    priorityGenerateCore,
    priorityFilesOfInterest,
    runAction, useE, useNoFileE, usesE,
    toIdeResult,
    defineNoFile,
    defineEarlyCutOffNoFile,
    mainRule,
    getAtPoint,
    getDefinition,
    getTypeDefinition,
    highlightAtPoint,
    getDependencies,
    getParsedModule,
    ) where

import Fingerprint

import Data.Binary hiding (get, put)
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Development.IDE.Core.Compile
import Development.IDE.Core.OfInterest
import Development.IDE.Types.Options
import Development.IDE.Spans.Documentation
import Development.IDE.Spans.LocalBindings
import Development.IDE.Import.DependencyInformation
import Development.IDE.Import.FindImports
import           Development.IDE.Core.FileExists
import           Development.IDE.Core.FileStore        (modificationTime, getFileContents)
import           Development.IDE.Types.Diagnostics as Diag
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule, writeHieFile, TargetModule, TargetFile)
import Development.IDE.GHC.Util
import Data.Either.Extra
import qualified Development.IDE.Types.Logger as L
import Data.Maybe
import           Data.Foldable
import qualified Data.IntMap.Strict as IntMap
import Data.IntMap.Strict (IntMap)
import Data.List
import qualified Data.Set                                 as Set
import qualified Data.Map as M
import qualified Data.Text                                as T
import qualified Data.Text.Encoding                       as T
import           Development.IDE.GHC.Error
import           Development.Shake                        hiding (Diagnostic)
import Development.IDE.Core.RuleTypes
import qualified Data.ByteString.Char8 as BS
import Development.IDE.Core.PositionMapping
import           Language.Haskell.LSP.Types (DocumentHighlight (..))

import qualified GHC.LanguageExtensions as LangExt
import HscTypes hiding (TargetModule, TargetFile)
import GHC.Generics(Generic)

import qualified Development.IDE.Spans.AtPoint as AtPoint
import Development.IDE.Core.IdeConfiguration
import Development.IDE.Core.Service
import Development.IDE.Core.Shake
import Development.Shake.Classes hiding (get, put)
import Control.Monad.Trans.Except (runExceptT)
import Data.ByteString (ByteString)
import Control.Concurrent.Async (concurrently)
import System.Time.Extra
import Control.Monad.Reader
import System.Directory ( getModificationTime )
import Control.Exception

import Control.Monad.State
import FastString (FastString(uniq))
import qualified HeaderInfo as Hdr
import Data.Time (UTCTime(..))
import Data.Hashable
import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict as HM
import TcRnMonad (tcg_dependent_files)
import Data.IORef
import Control.Concurrent.Extra
import Module

-- | 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)

-- | useE is useful to implement functions that aren’t rules but need shortcircuiting
-- e.g. getDefinition.
useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE :: k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE k
k = IdeAction (Maybe (v, PositionMapping))
-> MaybeT IdeAction (v, PositionMapping)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe (v, PositionMapping))
 -> MaybeT IdeAction (v, PositionMapping))
-> (NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping)))
-> NormalizedFilePath
-> MaybeT IdeAction (v, PositionMapping)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast k
k

useNoFileE :: IdeRule k v => IdeState -> k -> MaybeT IdeAction v
useNoFileE :: IdeState -> k -> MaybeT IdeAction v
useNoFileE IdeState
_ide k
k = (v, PositionMapping) -> v
forall a b. (a, b) -> a
fst ((v, PositionMapping) -> v)
-> MaybeT IdeAction (v, PositionMapping) -> MaybeT IdeAction v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE k
k NormalizedFilePath
emptyFilePath

usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT IdeAction [(v,PositionMapping)]
usesE :: k
-> [NormalizedFilePath] -> MaybeT IdeAction [(v, PositionMapping)]
usesE k
k = IdeAction (Maybe [(v, PositionMapping)])
-> MaybeT IdeAction [(v, PositionMapping)]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe [(v, PositionMapping)])
 -> MaybeT IdeAction [(v, PositionMapping)])
-> ([NormalizedFilePath]
    -> IdeAction (Maybe [(v, PositionMapping)]))
-> [NormalizedFilePath]
-> MaybeT IdeAction [(v, PositionMapping)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe (v, PositionMapping)] -> Maybe [(v, PositionMapping)])
-> IdeAction [Maybe (v, PositionMapping)]
-> IdeAction (Maybe [(v, PositionMapping)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (v, PositionMapping)] -> Maybe [(v, PositionMapping)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (IdeAction [Maybe (v, PositionMapping)]
 -> IdeAction (Maybe [(v, PositionMapping)]))
-> ([NormalizedFilePath] -> IdeAction [Maybe (v, PositionMapping)])
-> [NormalizedFilePath]
-> IdeAction (Maybe [(v, PositionMapping)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping)))
-> [NormalizedFilePath] -> IdeAction [Maybe (v, PositionMapping)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast k
k)

defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
defineNoFile :: (k -> Action v) -> Rules ()
defineNoFile k -> Action v
f = (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ())
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \k
k NormalizedFilePath
file -> do
    if NormalizedFilePath
file NormalizedFilePath -> NormalizedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedFilePath
emptyFilePath then do v
res <- k -> Action v
f k
k; IdeResult v -> Action (IdeResult v)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], v -> Maybe v
forall a. a -> Maybe a
Just v
res) else
        String -> Action (IdeResult v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action (IdeResult v)) -> String -> Action (IdeResult v)
forall a b. (a -> b) -> a -> b
$ String
"Rule " String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Show a => a -> String
show k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" should always be called with the empty string for a file"

defineEarlyCutOffNoFile :: IdeRule k v => (k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile :: (k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile k -> Action (ByteString, v)
f = (k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((k
  -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
 -> Rules ())
-> (k
    -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \k
k NormalizedFilePath
file -> do
    if NormalizedFilePath
file NormalizedFilePath -> NormalizedFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedFilePath
emptyFilePath then do (ByteString
hash, v
res) <- k -> Action (ByteString, v)
f k
k; (Maybe ByteString, IdeResult v)
-> Action (Maybe ByteString, IdeResult v)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
hash, ([], v -> Maybe v
forall a. a -> Maybe a
Just v
res)) else
        String -> Action (Maybe ByteString, IdeResult v)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action (Maybe ByteString, IdeResult v))
-> String -> Action (Maybe ByteString, IdeResult v)
forall a b. (a -> b) -> a -> b
$ String
"Rule " String -> String -> String
forall a. [a] -> [a] -> [a]
++ k -> String
forall a. Show a => a -> String
show k
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" should always be called with the empty string for a file"


------------------------------------------------------------
-- 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])
-> Action (Maybe TransitiveDependencies)
-> Action (Maybe [NormalizedFilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetDependencies
-> NormalizedFilePath -> Action (Maybe TransitiveDependencies)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetDependencies
GetDependencies NormalizedFilePath
file

-- | Try to get hover text for the name under point.
getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [T.Text]))
getAtPoint :: NormalizedFilePath
-> Position -> IdeAction (Maybe (Maybe Range, [Text]))
getAtPoint NormalizedFilePath
file Position
pos = (Maybe (Maybe (Maybe Range, [Text]))
 -> Maybe (Maybe Range, [Text]))
-> IdeAction (Maybe (Maybe (Maybe Range, [Text])))
-> IdeAction (Maybe (Maybe Range, [Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe (Maybe Range, [Text])) -> Maybe (Maybe Range, [Text])
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IdeAction (Maybe (Maybe (Maybe Range, [Text])))
 -> IdeAction (Maybe (Maybe Range, [Text])))
-> IdeAction (Maybe (Maybe (Maybe Range, [Text])))
-> IdeAction (Maybe (Maybe Range, [Text]))
forall a b. (a -> b) -> a -> b
$ MaybeT IdeAction (Maybe (Maybe Range, [Text]))
-> IdeAction (Maybe (Maybe (Maybe Range, [Text])))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IdeAction (Maybe (Maybe Range, [Text]))
 -> IdeAction (Maybe (Maybe (Maybe Range, [Text]))))
-> MaybeT IdeAction (Maybe (Maybe Range, [Text]))
-> IdeAction (Maybe (Maybe (Maybe Range, [Text])))
forall a b. (a -> b) -> a -> b
$ do
  ShakeExtras
ide <- MaybeT IdeAction ShakeExtras
forall r (m :: * -> *). MonadReader r m => m r
ask
  IdeOptions
opts <- IO IdeOptions -> MaybeT IdeAction IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> MaybeT IdeAction IdeOptions)
-> IO IdeOptions -> MaybeT IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
ide

  (HieAstResult -> HieASTs Type
hieAst -> HieASTs Type
hf, PositionMapping
mapping) <- GetHieAst
-> NormalizedFilePath
-> MaybeT IdeAction (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetHieAst
GetHieAst NormalizedFilePath
file
  DocAndKindMap
dkMap <- IdeAction DocAndKindMap -> MaybeT IdeAction DocAndKindMap
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IdeAction DocAndKindMap -> MaybeT IdeAction DocAndKindMap)
-> IdeAction DocAndKindMap -> MaybeT IdeAction DocAndKindMap
forall a b. (a -> b) -> a -> b
$ DocAndKindMap
-> ((DocAndKindMap, PositionMapping) -> DocAndKindMap)
-> Maybe (DocAndKindMap, PositionMapping)
-> DocAndKindMap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DocMap -> KindMap -> DocAndKindMap
DKMap DocMap
forall a. Monoid a => a
mempty KindMap
forall a. Monoid a => a
mempty) (DocAndKindMap, PositionMapping) -> DocAndKindMap
forall a b. (a, b) -> a
fst (Maybe (DocAndKindMap, PositionMapping) -> DocAndKindMap)
-> IdeAction (Maybe (DocAndKindMap, PositionMapping))
-> IdeAction DocAndKindMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MaybeT IdeAction (DocAndKindMap, PositionMapping)
-> IdeAction (Maybe (DocAndKindMap, PositionMapping))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IdeAction (DocAndKindMap, PositionMapping)
 -> IdeAction (Maybe (DocAndKindMap, PositionMapping)))
-> MaybeT IdeAction (DocAndKindMap, PositionMapping)
-> IdeAction (Maybe (DocAndKindMap, PositionMapping))
forall a b. (a -> b) -> a -> b
$ GetDocMap
-> NormalizedFilePath
-> MaybeT IdeAction (DocAndKindMap, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetDocMap
GetDocMap NormalizedFilePath
file)

  !Position
pos' <- IdeAction (Maybe Position) -> MaybeT IdeAction Position
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe Position -> IdeAction (Maybe Position)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Position -> IdeAction (Maybe Position))
-> Maybe Position -> IdeAction (Maybe Position)
forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
  Maybe (Maybe Range, [Text])
-> MaybeT IdeAction (Maybe (Maybe Range, [Text]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe Range, [Text])
 -> MaybeT IdeAction (Maybe (Maybe Range, [Text])))
-> Maybe (Maybe Range, [Text])
-> MaybeT IdeAction (Maybe (Maybe Range, [Text]))
forall a b. (a -> b) -> a -> b
$ IdeOptions
-> HieASTs Type
-> DocAndKindMap
-> Position
-> Maybe (Maybe Range, [Text])
AtPoint.atPoint IdeOptions
opts HieASTs Type
hf DocAndKindMap
dkMap Position
pos'

-- | Goto Definition.
getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe Location)
getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe Location)
getDefinition NormalizedFilePath
file Position
pos = MaybeT IdeAction Location -> IdeAction (Maybe Location)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IdeAction Location -> IdeAction (Maybe Location))
-> MaybeT IdeAction Location -> IdeAction (Maybe Location)
forall a b. (a -> b) -> a -> b
$ do
    ShakeExtras
ide <- MaybeT IdeAction ShakeExtras
forall r (m :: * -> *). MonadReader r m => m r
ask
    IdeOptions
opts <- IO IdeOptions -> MaybeT IdeAction IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> MaybeT IdeAction IdeOptions)
-> IO IdeOptions -> MaybeT IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
ide
    (HAR Module
_ HieASTs Type
hf RefMap
_ , PositionMapping
mapping) <- GetHieAst
-> NormalizedFilePath
-> MaybeT IdeAction (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetHieAst
GetHieAst NormalizedFilePath
file
    (ImportMap Map ModuleName NormalizedFilePath
imports, PositionMapping
_) <- GetImportMap
-> NormalizedFilePath
-> MaybeT IdeAction (ImportMap, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetImportMap
GetImportMap NormalizedFilePath
file
    !Position
pos' <- IdeAction (Maybe Position) -> MaybeT IdeAction Position
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe Position -> IdeAction (Maybe Position)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Position -> IdeAction (Maybe Position))
-> Maybe Position -> IdeAction (Maybe Position)
forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
    (Module -> MaybeT IdeAction (HieFile, String))
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> HieASTs Type
-> Position
-> MaybeT IdeAction Location
forall (m :: * -> *).
MonadIO m =>
(Module -> MaybeT m (HieFile, String))
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> HieASTs Type
-> Position
-> MaybeT m Location
AtPoint.gotoDefinition (ShakeExtras
-> NormalizedFilePath
-> Module
-> MaybeT IdeAction (HieFile, String)
getHieFile ShakeExtras
ide NormalizedFilePath
file) IdeOptions
opts Map ModuleName NormalizedFilePath
imports HieASTs Type
hf Position
pos'

getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getTypeDefinition NormalizedFilePath
file Position
pos = MaybeT IdeAction [Location] -> IdeAction (Maybe [Location])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IdeAction [Location] -> IdeAction (Maybe [Location]))
-> MaybeT IdeAction [Location] -> IdeAction (Maybe [Location])
forall a b. (a -> b) -> a -> b
$ do
    ShakeExtras
ide <- MaybeT IdeAction ShakeExtras
forall r (m :: * -> *). MonadReader r m => m r
ask
    IdeOptions
opts <- IO IdeOptions -> MaybeT IdeAction IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> MaybeT IdeAction IdeOptions)
-> IO IdeOptions -> MaybeT IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
ide
    (HieAstResult -> HieASTs Type
hieAst -> HieASTs Type
hf, PositionMapping
mapping) <- GetHieAst
-> NormalizedFilePath
-> MaybeT IdeAction (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetHieAst
GetHieAst NormalizedFilePath
file
    !Position
pos' <- IdeAction (Maybe Position) -> MaybeT IdeAction Position
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe Position -> IdeAction (Maybe Position)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Position -> IdeAction (Maybe Position))
-> Maybe Position -> IdeAction (Maybe Position)
forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
    (Module -> MaybeT IdeAction (HieFile, String))
-> IdeOptions
-> HieASTs Type
-> Position
-> MaybeT IdeAction [Location]
forall (m :: * -> *).
MonadIO m =>
(Module -> MaybeT m (HieFile, String))
-> IdeOptions -> HieASTs Type -> Position -> MaybeT m [Location]
AtPoint.gotoTypeDefinition (ShakeExtras
-> NormalizedFilePath
-> Module
-> MaybeT IdeAction (HieFile, String)
getHieFile ShakeExtras
ide NormalizedFilePath
file) IdeOptions
opts HieASTs Type
hf Position
pos'

highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])
highlightAtPoint :: NormalizedFilePath
-> Position -> IdeAction (Maybe [DocumentHighlight])
highlightAtPoint NormalizedFilePath
file Position
pos = MaybeT IdeAction [DocumentHighlight]
-> IdeAction (Maybe [DocumentHighlight])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IdeAction [DocumentHighlight]
 -> IdeAction (Maybe [DocumentHighlight]))
-> MaybeT IdeAction [DocumentHighlight]
-> IdeAction (Maybe [DocumentHighlight])
forall a b. (a -> b) -> a -> b
$ do
    (HAR Module
_ HieASTs Type
hf RefMap
rf,PositionMapping
mapping) <- GetHieAst
-> NormalizedFilePath
-> MaybeT IdeAction (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetHieAst
GetHieAst NormalizedFilePath
file
    !Position
pos' <- IdeAction (Maybe Position) -> MaybeT IdeAction Position
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe Position -> IdeAction (Maybe Position)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Position -> IdeAction (Maybe Position))
-> Maybe Position -> IdeAction (Maybe Position)
forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
    HieASTs Type
-> RefMap -> Position -> MaybeT IdeAction [DocumentHighlight]
forall (m :: * -> *).
Monad m =>
HieASTs Type -> RefMap -> Position -> MaybeT m [DocumentHighlight]
AtPoint.documentHighlight HieASTs Type
hf RefMap
rf Position
pos'

getHieFile
  :: ShakeExtras
  -> NormalizedFilePath -- ^ file we're editing
  -> Module -- ^ module dep we want info for
  -> MaybeT IdeAction (HieFile, FilePath) -- ^ hie stuff for the module
getHieFile :: ShakeExtras
-> NormalizedFilePath
-> Module
-> MaybeT IdeAction (HieFile, String)
getHieFile ShakeExtras
ide NormalizedFilePath
file Module
mod = do
  TransitiveDependencies {[NamedModuleDep]
transitiveNamedModuleDeps :: TransitiveDependencies -> [NamedModuleDep]
transitiveNamedModuleDeps :: [NamedModuleDep]
transitiveNamedModuleDeps} <- (TransitiveDependencies, PositionMapping) -> TransitiveDependencies
forall a b. (a, b) -> a
fst ((TransitiveDependencies, PositionMapping)
 -> TransitiveDependencies)
-> MaybeT IdeAction (TransitiveDependencies, PositionMapping)
-> MaybeT IdeAction TransitiveDependencies
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetDependencies
-> NormalizedFilePath
-> MaybeT IdeAction (TransitiveDependencies, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetDependencies
GetDependencies NormalizedFilePath
file
  case (NamedModuleDep -> Bool)
-> [NamedModuleDep] -> Maybe NamedModuleDep
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\NamedModuleDep
x -> NamedModuleDep -> ModuleName
nmdModuleName NamedModuleDep
x ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> ModuleName
moduleName Module
mod) [NamedModuleDep]
transitiveNamedModuleDeps of
    Just NamedModuleDep{nmdFilePath :: NamedModuleDep -> NormalizedFilePath
nmdFilePath=NormalizedFilePath
nfp} -> do
        let modPath :: String
modPath = NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
nfp
        HieFile
hieFile <- NormalizedFilePath -> MaybeT IdeAction HieFile
getHomeHieFile NormalizedFilePath
nfp
        (HieFile, String) -> MaybeT IdeAction (HieFile, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (HieFile
hieFile, String
modPath)
    Maybe NamedModuleDep
_ -> ShakeExtras
-> Module
-> NormalizedFilePath
-> MaybeT IdeAction (HieFile, String)
getPackageHieFile ShakeExtras
ide Module
mod NormalizedFilePath
file

getHomeHieFile :: NormalizedFilePath -> MaybeT IdeAction HieFile
getHomeHieFile :: NormalizedFilePath -> MaybeT IdeAction HieFile
getHomeHieFile NormalizedFilePath
f = do
  ModSummary
ms <- (ModSummary, [LImportDecl GhcPs]) -> ModSummary
forall a b. (a, b) -> a
fst ((ModSummary, [LImportDecl GhcPs]) -> ModSummary)
-> (((ModSummary, [LImportDecl GhcPs]), PositionMapping)
    -> (ModSummary, [LImportDecl GhcPs]))
-> ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
-> ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
-> (ModSummary, [LImportDecl GhcPs])
forall a b. (a, b) -> a
fst (((ModSummary, [LImportDecl GhcPs]), PositionMapping)
 -> ModSummary)
-> MaybeT
     IdeAction ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
-> MaybeT IdeAction ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> MaybeT
     IdeAction ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
f
  let normal_hie_f :: NormalizedFilePath
normal_hie_f = String -> NormalizedFilePath
toNormalizedFilePath' String
hie_f
      hie_f :: String
hie_f = ModLocation -> String
ml_hie_file (ModLocation -> String) -> ModLocation -> String
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms

  Maybe UTCTime
mbHieTimestamp <- (IOException -> Maybe UTCTime)
-> (UTCTime -> Maybe UTCTime)
-> Either IOException UTCTime
-> Maybe UTCTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(IOException
_ :: IOException) -> Maybe UTCTime
forall a. Maybe a
Nothing) UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (Either IOException UTCTime -> Maybe UTCTime)
-> MaybeT IdeAction (Either IOException UTCTime)
-> MaybeT IdeAction (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Either IOException UTCTime)
-> MaybeT IdeAction (Either IOException UTCTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException UTCTime)
 -> MaybeT IdeAction (Either IOException UTCTime))
-> IO (Either IOException UTCTime)
-> MaybeT IdeAction (Either IOException UTCTime)
forall a b. (a -> b) -> a -> b
$ IO UTCTime -> IO (Either IOException UTCTime)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO UTCTime -> IO (Either IOException UTCTime))
-> IO UTCTime -> IO (Either IOException UTCTime)
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getModificationTime String
hie_f)
  UTCTime
srcTimestamp   <- IdeAction (Maybe UTCTime) -> MaybeT IdeAction UTCTime
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ((IOException -> Maybe UTCTime)
-> (UTCTime -> Maybe UTCTime)
-> Either IOException UTCTime
-> Maybe UTCTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\(IOException
_ :: IOException) -> Maybe UTCTime
forall a. Maybe a
Nothing) UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (Either IOException UTCTime -> Maybe UTCTime)
-> IdeAction (Either IOException UTCTime)
-> IdeAction (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Either IOException UTCTime)
-> IdeAction (Either IOException UTCTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException UTCTime)
 -> IdeAction (Either IOException UTCTime))
-> IO (Either IOException UTCTime)
-> IdeAction (Either IOException UTCTime)
forall a b. (a -> b) -> a -> b
$ IO UTCTime -> IO (Either IOException UTCTime)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO UTCTime -> IO (Either IOException UTCTime))
-> IO UTCTime -> IO (Either IOException UTCTime)
forall a b. (a -> b) -> a -> b
$ String -> IO UTCTime
getModificationTime (String -> IO UTCTime) -> String -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f))
  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
$ (Maybe UTCTime, UTCTime, String, NormalizedFilePath) -> IO ()
forall a. Show a => a -> IO ()
print (Maybe UTCTime
mbHieTimestamp, UTCTime
srcTimestamp, String
hie_f, NormalizedFilePath
normal_hie_f)
  let isUpToDate :: Bool
isUpToDate
        | Just UTCTime
d <- Maybe UTCTime
mbHieTimestamp = UTCTime
d UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
srcTimestamp
        | Bool
otherwise = Bool
False

  if Bool
isUpToDate
    then do
      NameCacheUpdater
ncu <- MaybeT IdeAction NameCacheUpdater
mkUpdater
      Maybe HieFile
hf <- IO (Maybe HieFile) -> MaybeT IdeAction (Maybe HieFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe HieFile) -> MaybeT IdeAction (Maybe HieFile))
-> IO (Maybe HieFile) -> MaybeT IdeAction (Maybe HieFile)
forall a b. (a -> b) -> a -> b
$ Bool -> IO HieFile -> IO (Maybe HieFile)
forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe Bool
isUpToDate (NameCacheUpdater -> String -> IO HieFile
loadHieFile NameCacheUpdater
ncu String
hie_f)
      IdeAction (Maybe HieFile) -> MaybeT IdeAction HieFile
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe HieFile) -> MaybeT IdeAction HieFile)
-> IdeAction (Maybe HieFile) -> MaybeT IdeAction HieFile
forall a b. (a -> b) -> a -> b
$ Maybe HieFile -> IdeAction (Maybe HieFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HieFile
hf
    else do
      IO ()
wait <- IdeAction (IO ()) -> MaybeT IdeAction (IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IdeAction (IO ()) -> MaybeT IdeAction (IO ()))
-> IdeAction (IO ()) -> MaybeT IdeAction (IO ())
forall a b. (a -> b) -> a -> b
$ DelayedAction () -> IdeAction (IO ())
forall a. DelayedAction a -> IdeAction (IO a)
delayedAction (DelayedAction () -> IdeAction (IO ()))
-> DelayedAction () -> IdeAction (IO ())
forall a b. (a -> b) -> a -> b
$ String -> Priority -> Action () -> DelayedAction ()
forall a. String -> Priority -> Action a -> DelayedAction a
mkDelayedAction String
"OutOfDateHie" Priority
L.Info (Action () -> DelayedAction ()) -> Action () -> DelayedAction ()
forall a b. (a -> b) -> a -> b
$ do
        HscEnv
hsc <- 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
        ParsedModule
pm <- GetParsedModule -> NormalizedFilePath -> Action ParsedModule
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetParsedModule
GetParsedModule NormalizedFilePath
f
        ([FileDiagnostic]
_, Maybe TcModuleResult
mtm)<- HscEnv
-> ParsedModule -> Action ([FileDiagnostic], Maybe TcModuleResult)
typeCheckRuleDefinition HscEnv
hsc ParsedModule
pm
        (TcModuleResult -> Action (IdeResult HieAstResult))
-> Maybe TcModuleResult -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (NormalizedFilePath
-> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
getHieAstRuleDefinition NormalizedFilePath
f HscEnv
hsc) Maybe TcModuleResult
mtm -- Write the HiFile to disk
      ()
_ <- IdeAction (Maybe ()) -> MaybeT IdeAction ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe ()) -> MaybeT IdeAction ())
-> IdeAction (Maybe ()) -> MaybeT IdeAction ()
forall a b. (a -> b) -> a -> b
$ IO (Maybe ()) -> IdeAction (Maybe ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ()) -> IdeAction (Maybe ()))
-> IO (Maybe ()) -> IdeAction (Maybe ())
forall a b. (a -> b) -> a -> b
$ Seconds -> IO () -> IO (Maybe ())
forall a. Seconds -> IO a -> IO (Maybe a)
timeout Seconds
1 IO ()
wait
      NameCacheUpdater
ncu <- MaybeT IdeAction NameCacheUpdater
mkUpdater
      IO HieFile -> MaybeT IdeAction HieFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HieFile -> MaybeT IdeAction HieFile)
-> IO HieFile -> MaybeT IdeAction HieFile
forall a b. (a -> b) -> a -> b
$ NameCacheUpdater -> String -> IO HieFile
loadHieFile NameCacheUpdater
ncu String
hie_f

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
$ String -> IO ByteString
BS.readFile (NormalizedFilePath -> String
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

getPackageHieFile :: ShakeExtras
                  -> Module             -- ^ Package Module to load .hie file for
                  -> NormalizedFilePath -- ^ Path of home module importing the package module
                  -> MaybeT IdeAction (HieFile, FilePath)
getPackageHieFile :: ShakeExtras
-> Module
-> NormalizedFilePath
-> MaybeT IdeAction (HieFile, String)
getPackageHieFile ShakeExtras
ide Module
mod NormalizedFilePath
file = do
    HscEnv
pkgState  <- HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> HscEnv)
-> ((HscEnvEq, PositionMapping) -> HscEnvEq)
-> (HscEnvEq, PositionMapping)
-> HscEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HscEnvEq, PositionMapping) -> HscEnvEq
forall a b. (a, b) -> a
fst ((HscEnvEq, PositionMapping) -> HscEnv)
-> MaybeT IdeAction (HscEnvEq, PositionMapping)
-> MaybeT IdeAction HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GhcSession
-> NormalizedFilePath
-> MaybeT IdeAction (HscEnvEq, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GhcSession
GhcSession NormalizedFilePath
file
    IdeOptions {Bool
Int
String
[String]
[Text]
Maybe String
Action IdeGhcSession
IdePkgLocationOptions
IdeTesting
IdeDefer
IdeReportProgress
CheckParents
CheckProject
OptHaddockParse
ParsedSource -> IdePreprocessedSource
DynFlags -> DynFlags
optCustomDynFlags :: IdeOptions -> DynFlags -> DynFlags
optHaddockParse :: IdeOptions -> OptHaddockParse
optCheckParents :: IdeOptions -> CheckParents
optCheckProject :: IdeOptions -> CheckProject
optDefer :: IdeOptions -> IdeDefer
optKeywords :: IdeOptions -> [Text]
optNewColonConvention :: IdeOptions -> Bool
optLanguageSyntax :: IdeOptions -> String
optReportProgress :: IdeOptions -> IdeReportProgress
optTesting :: IdeOptions -> IdeTesting
optShakeProfiling :: IdeOptions -> Maybe String
optShakeFiles :: IdeOptions -> Maybe String
optThreads :: IdeOptions -> Int
optExtensions :: IdeOptions -> [String]
optPkgLocationOpts :: IdeOptions -> IdePkgLocationOptions
optGhcSession :: IdeOptions -> Action IdeGhcSession
optPreprocessor :: IdeOptions -> ParsedSource -> IdePreprocessedSource
optCustomDynFlags :: DynFlags -> DynFlags
optHaddockParse :: OptHaddockParse
optCheckParents :: CheckParents
optCheckProject :: CheckProject
optDefer :: IdeDefer
optKeywords :: [Text]
optNewColonConvention :: Bool
optLanguageSyntax :: String
optReportProgress :: IdeReportProgress
optTesting :: IdeTesting
optShakeProfiling :: Maybe String
optShakeFiles :: Maybe String
optThreads :: Int
optExtensions :: [String]
optPkgLocationOpts :: IdePkgLocationOptions
optGhcSession :: Action IdeGhcSession
optPreprocessor :: ParsedSource -> IdePreprocessedSource
..} <- IO IdeOptions -> MaybeT IdeAction IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> MaybeT IdeAction IdeOptions)
-> IO IdeOptions -> MaybeT IdeAction IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
ide
    let unitId :: UnitId
unitId = Module -> UnitId
moduleUnitId Module
mod
    case UnitId -> HscEnv -> Maybe PackageConfig
lookupPackageConfig UnitId
unitId HscEnv
pkgState of
        Just PackageConfig
pkgConfig -> do
            -- 'optLocateHieFile' returns Nothing if the file does not exist
            Maybe String
hieFile <- IO (Maybe String) -> MaybeT IdeAction (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> MaybeT IdeAction (Maybe String))
-> IO (Maybe String) -> MaybeT IdeAction (Maybe String)
forall a b. (a -> b) -> a -> b
$ IdePkgLocationOptions
-> PackageConfig -> Module -> IO (Maybe String)
optLocateHieFile IdePkgLocationOptions
optPkgLocationOpts PackageConfig
pkgConfig Module
mod
            Maybe String
path    <- IO (Maybe String) -> MaybeT IdeAction (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> MaybeT IdeAction (Maybe String))
-> IO (Maybe String) -> MaybeT IdeAction (Maybe String)
forall a b. (a -> b) -> a -> b
$ IdePkgLocationOptions
-> PackageConfig -> Module -> IO (Maybe String)
optLocateSrcFile IdePkgLocationOptions
optPkgLocationOpts PackageConfig
pkgConfig Module
mod
            case (Maybe String
hieFile, Maybe String
path) of
                (Just String
hiePath, Just String
modPath) -> do
                    -- deliberately loaded outside the Shake graph
                    -- to avoid dependencies on non-workspace files
                        NameCacheUpdater
ncu <- MaybeT IdeAction NameCacheUpdater
mkUpdater
                        IdeAction (Maybe (HieFile, String))
-> MaybeT IdeAction (HieFile, String)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe (HieFile, String))
 -> MaybeT IdeAction (HieFile, String))
-> IdeAction (Maybe (HieFile, String))
-> MaybeT IdeAction (HieFile, String)
forall a b. (a -> b) -> a -> b
$ IO (Maybe (HieFile, String)) -> IdeAction (Maybe (HieFile, String))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (HieFile, String))
 -> IdeAction (Maybe (HieFile, String)))
-> IO (Maybe (HieFile, String))
-> IdeAction (Maybe (HieFile, String))
forall a b. (a -> b) -> a -> b
$ (HieFile, String) -> Maybe (HieFile, String)
forall a. a -> Maybe a
Just ((HieFile, String) -> Maybe (HieFile, String))
-> (HieFile -> (HieFile, String))
-> HieFile
-> Maybe (HieFile, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, String
modPath) (HieFile -> Maybe (HieFile, String))
-> IO HieFile -> IO (Maybe (HieFile, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameCacheUpdater -> String -> IO HieFile
loadHieFile NameCacheUpdater
ncu String
hiePath
                (Maybe String, Maybe String)
_ -> IdeAction (Maybe (HieFile, String))
-> MaybeT IdeAction (HieFile, String)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe (HieFile, String))
 -> MaybeT IdeAction (HieFile, String))
-> IdeAction (Maybe (HieFile, String))
-> MaybeT IdeAction (HieFile, String)
forall a b. (a -> b) -> a -> b
$ Maybe (HieFile, String) -> IdeAction (Maybe (HieFile, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HieFile, String)
forall a. Maybe a
Nothing
        Maybe PackageConfig
_ -> IdeAction (Maybe (HieFile, String))
-> MaybeT IdeAction (HieFile, String)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe (HieFile, String))
 -> MaybeT IdeAction (HieFile, String))
-> IdeAction (Maybe (HieFile, String))
-> MaybeT IdeAction (HieFile, String)
forall a b. (a -> b) -> a -> b
$ Maybe (HieFile, String) -> IdeAction (Maybe (HieFile, String))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HieFile, String)
forall a. Maybe a
Nothing

-- | Parse the contents of a daml file.
getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
getParsedModule NormalizedFilePath
file = GetParsedModule
-> NormalizedFilePath -> Action (Maybe ParsedModule)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetParsedModule
GetParsedModule NormalizedFilePath
file

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

priorityTypeCheck :: Priority
priorityTypeCheck :: Priority
priorityTypeCheck = Seconds -> Priority
Priority Seconds
0

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

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

-- | IMPORTANT FOR HLINT INTEGRATION:
-- 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, and we might need to save the one without haddocks too.
-- See https://github.com/digital-asset/ghcide/pull/350#discussion_r370878197
-- and https://github.com/mpickering/ghcide/pull/22#issuecomment-625070490
getParsedModuleRule :: Rules ()
getParsedModuleRule :: Rules ()
getParsedModuleRule = (GetParsedModule
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult ParsedModule))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetParsedModule
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult ParsedModule))
 -> Rules ())
-> (GetParsedModule
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult ParsedModule))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetParsedModule
GetParsedModule NormalizedFilePath
file -> do
    (ModSummary
ms, [LImportDecl GhcPs]
_) <- GetModSummary
-> NormalizedFilePath -> Action (ModSummary, [LImportDecl GhcPs])
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

    let dflags :: DynFlags
dflags    = ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms
        mainParse :: IO (Maybe ByteString, IdeResult ParsedModule)
mainParse = HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (Maybe ByteString, IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
hsc IdeOptions
opt NormalizedFilePath
file ModSummary
ms

    -- Parse again (if necessary) to capture Haddock parse errors
    res :: (Maybe ByteString, IdeResult ParsedModule)
res@(Maybe ByteString
_, ([FileDiagnostic]
_,Maybe ParsedModule
pmod)) <- if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Haddock DynFlags
dflags
        then
            IO (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Maybe ByteString, IdeResult ParsedModule)
mainParse
        else do
            let haddockParse :: IO (Maybe ByteString, IdeResult ParsedModule)
haddockParse = HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (Maybe ByteString, 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
            --
            -- HLINT INTEGRATION: might need to save the other parsed module too
            ((Maybe ByteString
fp,([FileDiagnostic]
diags,Maybe ParsedModule
res)),(Maybe ByteString
fph,([FileDiagnostic]
diagsh,Maybe ParsedModule
resh))) <- IO
  ((Maybe ByteString, IdeResult ParsedModule),
   (Maybe ByteString, IdeResult ParsedModule))
-> Action
     ((Maybe ByteString, IdeResult ParsedModule),
      (Maybe ByteString, IdeResult ParsedModule))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   ((Maybe ByteString, IdeResult ParsedModule),
    (Maybe ByteString, IdeResult ParsedModule))
 -> Action
      ((Maybe ByteString, IdeResult ParsedModule),
       (Maybe ByteString, IdeResult ParsedModule)))
-> IO
     ((Maybe ByteString, IdeResult ParsedModule),
      (Maybe ByteString, IdeResult ParsedModule))
-> Action
     ((Maybe ByteString, IdeResult ParsedModule),
      (Maybe ByteString, IdeResult ParsedModule))
forall a b. (a -> b) -> a -> b
$ IO (Maybe ByteString, IdeResult ParsedModule)
-> IO (Maybe ByteString, IdeResult ParsedModule)
-> IO
     ((Maybe ByteString, IdeResult ParsedModule),
      (Maybe ByteString, IdeResult ParsedModule))
forall a b. IO a -> IO b -> IO (a, b)
concurrently IO (Maybe ByteString, IdeResult ParsedModule)
mainParse IO (Maybe ByteString, 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
                -> (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString
fph, ([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
_ -> (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString
fp, ([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
$ (String -> NormalizedFilePath) -> [String] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> NormalizedFilePath
toNormalizedFilePath' ([String]
-> (ParsedModule -> [String]) -> Maybe ParsedModule -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ParsedModule -> [String]
pm_extra_src_files Maybe ParsedModule
pmod)
    (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString, IdeResult ParsedModule)
res

withOptHaddock :: ModSummary -> ModSummary
withOptHaddock :: ModSummary -> ModSummary
withOptHaddock 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_Haddock}


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

getParsedModuleDefinition :: HscEnv -> IdeOptions -> NormalizedFilePath -> ModSummary -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule))
getParsedModuleDefinition :: HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (Maybe ByteString, IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
packageState IdeOptions
opt NormalizedFilePath
file ModSummary
ms = do
    let fp :: String
fp = NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file
    ([FileDiagnostic]
diag, Maybe ParsedModule
res) <- IdeOptions
-> HscEnv -> String -> ModSummary -> IO (IdeResult ParsedModule)
parseModule IdeOptions
opt HscEnv
packageState String
fp ModSummary
ms
    case Maybe ParsedModule
res of
        Maybe ParsedModule
Nothing -> (Maybe ByteString, IdeResult ParsedModule)
-> IO (Maybe ByteString, IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString
forall a. Maybe a
Nothing, ([FileDiagnostic]
diag, Maybe ParsedModule
forall a. Maybe a
Nothing))
        Just ParsedModule
modu -> do
            Maybe ByteString
mbFingerprint <- (StringBuffer -> IO ByteString)
-> Maybe StringBuffer -> IO (Maybe ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Fingerprint -> ByteString) -> IO Fingerprint -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fingerprint -> ByteString
fingerprintToBS (IO Fingerprint -> IO ByteString)
-> (StringBuffer -> IO Fingerprint)
-> StringBuffer
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringBuffer -> IO Fingerprint
fingerprintFromStringBuffer) (ModSummary -> Maybe StringBuffer
ms_hspp_buf ModSummary
ms)
            (Maybe ByteString, IdeResult ParsedModule)
-> IO (Maybe ByteString, IdeResult ParsedModule)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString
mbFingerprint, ([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)],
          Set InstalledUnitId)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((GetLocatedImports
  -> NormalizedFilePath
  -> Action
       (IdeResult
          ([(Located ModuleName, Maybe ArtifactsLocation)],
           Set InstalledUnitId)))
 -> Rules ())
-> (GetLocatedImports
    -> NormalizedFilePath
    -> Action
         (IdeResult
            ([(Located ModuleName, Maybe ArtifactsLocation)],
             Set InstalledUnitId)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetLocatedImports
GetLocatedImports NormalizedFilePath
file -> do
        (ModSummary
ms,[LImportDecl GhcPs]
_) <- GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action (ModSummary, [LImportDecl GhcPs])
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
        HashMap Target [NormalizedFilePath]
targets <- GetKnownTargets -> Action (HashMap Target [NormalizedFilePath])
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetKnownTargets
GetKnownTargets
        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 :: [(InstalledUnitId, DynFlags)]
import_dirs = HscEnvEq -> [(InstalledUnitId, DynFlags)]
deps HscEnvEq
env_eq
        let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
env
            isImplicitCradle :: Bool
isImplicitCradle = Maybe [String] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [String] -> Bool) -> Maybe [String] -> Bool
forall a b. (a -> b) -> a -> b
$ HscEnvEq -> Maybe [String]
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 getTargetExists :: ModuleName -> NormalizedFilePath -> Action Bool
getTargetExists ModuleName
modName NormalizedFilePath
nfp
                | Bool
isImplicitCradle = NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp
                | Target -> HashMap Target [NormalizedFilePath] -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member (ModuleName -> Target
TargetModule ModuleName
modName) HashMap Target [NormalizedFilePath]
targets
                Bool -> Bool -> Bool
|| Target -> HashMap Target [NormalizedFilePath] -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member (NormalizedFilePath -> Target
TargetFile NormalizedFilePath
nfp) HashMap Target [NormalizedFilePath]
targets
                = NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp
                | Bool
otherwise = Bool -> Action Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        ([[FileDiagnostic]]
diags, [Either
   (Located ModuleName, Maybe ArtifactsLocation)
   (Maybe [InstalledUnitId])]
imports') <- ([([FileDiagnostic],
   Either
     (Located ModuleName, Maybe ArtifactsLocation)
     (Maybe [InstalledUnitId]))]
 -> ([[FileDiagnostic]],
     [Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId])]))
-> Action
     [([FileDiagnostic],
       Either
         (Located ModuleName, Maybe ArtifactsLocation)
         (Maybe [InstalledUnitId]))]
-> Action
     ([[FileDiagnostic]],
      [Either
         (Located ModuleName, Maybe ArtifactsLocation)
         (Maybe [InstalledUnitId])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([FileDiagnostic],
  Either
    (Located ModuleName, Maybe ArtifactsLocation)
    (Maybe [InstalledUnitId]))]
-> ([[FileDiagnostic]],
    [Either
       (Located ModuleName, Maybe ArtifactsLocation)
       (Maybe [InstalledUnitId])])
forall a b. [(a, b)] -> ([a], [b])
unzip (Action
   [([FileDiagnostic],
     Either
       (Located ModuleName, Maybe ArtifactsLocation)
       (Maybe [InstalledUnitId]))]
 -> Action
      ([[FileDiagnostic]],
       [Either
          (Located ModuleName, Maybe ArtifactsLocation)
          (Maybe [InstalledUnitId])]))
-> Action
     [([FileDiagnostic],
       Either
         (Located ModuleName, Maybe ArtifactsLocation)
         (Maybe [InstalledUnitId]))]
-> Action
     ([[FileDiagnostic]],
      [Either
         (Located ModuleName, Maybe ArtifactsLocation)
         (Maybe [InstalledUnitId])])
forall a b. (a -> b) -> a -> b
$ [(Bool, (Maybe FastString, Located ModuleName))]
-> ((Bool, (Maybe FastString, Located ModuleName))
    -> Action
         ([FileDiagnostic],
          Either
            (Located ModuleName, Maybe ArtifactsLocation)
            (Maybe [InstalledUnitId])))
-> Action
     [([FileDiagnostic],
       Either
         (Located ModuleName, Maybe ArtifactsLocation)
         (Maybe [InstalledUnitId]))]
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],
        Either
          (Located ModuleName, Maybe ArtifactsLocation)
          (Maybe [InstalledUnitId])))
 -> Action
      [([FileDiagnostic],
        Either
          (Located ModuleName, Maybe ArtifactsLocation)
          (Maybe [InstalledUnitId]))])
-> ((Bool, (Maybe FastString, Located ModuleName))
    -> Action
         ([FileDiagnostic],
          Either
            (Located ModuleName, Maybe ArtifactsLocation)
            (Maybe [InstalledUnitId])))
-> Action
     [([FileDiagnostic],
       Either
         (Located ModuleName, Maybe ArtifactsLocation)
         (Maybe [InstalledUnitId]))]
forall a b. (a -> b) -> a -> b
$ \(Bool
isSource, (Maybe FastString
mbPkgName, Located ModuleName
modName)) -> do
            Either [FileDiagnostic] Import
diagOrImp <- DynFlags
-> [(InstalledUnitId, DynFlags)]
-> [String]
-> (ModuleName -> NormalizedFilePath -> Action Bool)
-> Located ModuleName
-> Maybe FastString
-> Bool
-> Action (Either [FileDiagnostic] Import)
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [(InstalledUnitId, DynFlags)]
-> [String]
-> (ModuleName -> NormalizedFilePath -> m Bool)
-> Located ModuleName
-> Maybe FastString
-> Bool
-> m (Either [FileDiagnostic] Import)
locateModule DynFlags
dflags [(InstalledUnitId, DynFlags)]
import_dirs (IdeOptions -> [String]
optExtensions IdeOptions
opt) ModuleName -> NormalizedFilePath -> Action Bool
getTargetExists Located ModuleName
modName Maybe FastString
mbPkgName Bool
isSource
            case Either [FileDiagnostic] Import
diagOrImp of
                Left [FileDiagnostic]
diags -> ([FileDiagnostic],
 Either
   (Located ModuleName, Maybe ArtifactsLocation)
   (Maybe [InstalledUnitId]))
-> Action
     ([FileDiagnostic],
      Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags, (Located ModuleName, Maybe ArtifactsLocation)
-> Either
     (Located ModuleName, Maybe ArtifactsLocation)
     (Maybe [InstalledUnitId])
forall a b. a -> Either a b
Left (Located ModuleName
modName, Maybe ArtifactsLocation
forall a. Maybe a
Nothing))
                Right (FileImport ArtifactsLocation
path) -> ([FileDiagnostic],
 Either
   (Located ModuleName, Maybe ArtifactsLocation)
   (Maybe [InstalledUnitId]))
-> Action
     ([FileDiagnostic],
      Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], (Located ModuleName, Maybe ArtifactsLocation)
-> Either
     (Located ModuleName, Maybe ArtifactsLocation)
     (Maybe [InstalledUnitId])
forall a b. a -> Either a b
Left (Located ModuleName
modName, ArtifactsLocation -> Maybe ArtifactsLocation
forall a. a -> Maybe a
Just ArtifactsLocation
path))
                Right (PackageImport InstalledUnitId
pkgId) -> IO
  ([FileDiagnostic],
   Either
     (Located ModuleName, Maybe ArtifactsLocation)
     (Maybe [InstalledUnitId]))
-> Action
     ([FileDiagnostic],
      Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   ([FileDiagnostic],
    Either
      (Located ModuleName, Maybe ArtifactsLocation)
      (Maybe [InstalledUnitId]))
 -> Action
      ([FileDiagnostic],
       Either
         (Located ModuleName, Maybe ArtifactsLocation)
         (Maybe [InstalledUnitId])))
-> IO
     ([FileDiagnostic],
      Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId]))
-> Action
     ([FileDiagnostic],
      Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId]))
forall a b. (a -> b) -> a -> b
$ do
                    Either [FileDiagnostic] [InstalledUnitId]
diagsOrPkgDeps <- HscEnv
-> InstalledUnitId
-> IO (Either [FileDiagnostic] [InstalledUnitId])
computePackageDeps HscEnv
env InstalledUnitId
pkgId
                    case Either [FileDiagnostic] [InstalledUnitId]
diagsOrPkgDeps of
                        Left [FileDiagnostic]
diags -> ([FileDiagnostic],
 Either
   (Located ModuleName, Maybe ArtifactsLocation)
   (Maybe [InstalledUnitId]))
-> IO
     ([FileDiagnostic],
      Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileDiagnostic]
diags, Maybe [InstalledUnitId]
-> Either
     (Located ModuleName, Maybe ArtifactsLocation)
     (Maybe [InstalledUnitId])
forall a b. b -> Either a b
Right Maybe [InstalledUnitId]
forall a. Maybe a
Nothing)
                        Right [InstalledUnitId]
pkgIds -> ([FileDiagnostic],
 Either
   (Located ModuleName, Maybe ArtifactsLocation)
   (Maybe [InstalledUnitId]))
-> IO
     ([FileDiagnostic],
      Either
        (Located ModuleName, Maybe ArtifactsLocation)
        (Maybe [InstalledUnitId]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Maybe [InstalledUnitId]
-> Either
     (Located ModuleName, Maybe ArtifactsLocation)
     (Maybe [InstalledUnitId])
forall a b. b -> Either a b
Right (Maybe [InstalledUnitId]
 -> Either
      (Located ModuleName, Maybe ArtifactsLocation)
      (Maybe [InstalledUnitId]))
-> Maybe [InstalledUnitId]
-> Either
     (Located ModuleName, Maybe ArtifactsLocation)
     (Maybe [InstalledUnitId])
forall a b. (a -> b) -> a -> b
$ [InstalledUnitId] -> Maybe [InstalledUnitId]
forall a. a -> Maybe a
Just ([InstalledUnitId] -> Maybe [InstalledUnitId])
-> [InstalledUnitId] -> Maybe [InstalledUnitId]
forall a b. (a -> b) -> a -> b
$ InstalledUnitId
pkgId InstalledUnitId -> [InstalledUnitId] -> [InstalledUnitId]
forall a. a -> [a] -> [a]
: [InstalledUnitId]
pkgIds)
        let ([(Located ModuleName, Maybe ArtifactsLocation)]
moduleImports, [Maybe [InstalledUnitId]]
pkgImports) = [Either
   (Located ModuleName, Maybe ArtifactsLocation)
   (Maybe [InstalledUnitId])]
-> ([(Located ModuleName, Maybe ArtifactsLocation)],
    [Maybe [InstalledUnitId]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (Located ModuleName, Maybe ArtifactsLocation)
   (Maybe [InstalledUnitId])]
imports'
        case [Maybe [InstalledUnitId]] -> Maybe [[InstalledUnitId]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe [InstalledUnitId]]
pkgImports of
            Maybe [[InstalledUnitId]]
Nothing -> IdeResult
  ([(Located ModuleName, Maybe ArtifactsLocation)],
   Set InstalledUnitId)
-> Action
     (IdeResult
        ([(Located ModuleName, Maybe ArtifactsLocation)],
         Set InstalledUnitId))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[FileDiagnostic]] -> [FileDiagnostic]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FileDiagnostic]]
diags, Maybe
  ([(Located ModuleName, Maybe ArtifactsLocation)],
   Set InstalledUnitId)
forall a. Maybe a
Nothing)
            Just [[InstalledUnitId]]
pkgImports -> IdeResult
  ([(Located ModuleName, Maybe ArtifactsLocation)],
   Set InstalledUnitId)
-> Action
     (IdeResult
        ([(Located ModuleName, Maybe ArtifactsLocation)],
         Set InstalledUnitId))
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)],
 Set InstalledUnitId)
-> Maybe
     ([(Located ModuleName, Maybe ArtifactsLocation)],
      Set InstalledUnitId)
forall a. a -> Maybe a
Just ([(Located ModuleName, Maybe ArtifactsLocation)]
moduleImports, [InstalledUnitId] -> Set InstalledUnitId
forall a. Ord a => [a] -> Set a
Set.fromList ([InstalledUnitId] -> Set InstalledUnitId)
-> [InstalledUnitId] -> Set InstalledUnitId
forall a b. (a -> b) -> a -> b
$ [[InstalledUnitId]] -> [InstalledUnitId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[InstalledUnitId]]
pkgImports))

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 ()
-> 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)
-> [NormalizedFilePath]
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ NormalizedFilePath
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
go [NormalizedFilePath]
fs)
    let bm :: BootIdMap
bm = (Int -> ArtifactsLocation -> BootIdMap -> BootIdMap)
-> BootIdMap -> IntMap ArtifactsLocation -> BootIdMap
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey (RawDependencyInformation
-> Int -> ArtifactsLocation -> BootIdMap -> BootIdMap
updateBootMap RawDependencyInformation
rdi) BootIdMap
forall a. IntMap a
IntMap.empty IntMap ArtifactsLocation
ss
    RawDependencyInformation -> Action RawDependencyInformation
forall (m :: * -> *) a. Monad m => a -> m a
return (RawDependencyInformation
rdi { rawBootMap :: BootIdMap
rawBootMap = BootIdMap
bm })
  where
    go :: NormalizedFilePath -- ^ Current module being processed
       -> StateT (RawDependencyInformation, IntMap ArtifactsLocation) Action FilePathId
    go :: NormalizedFilePath
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
go NormalizedFilePath
f = 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
          Maybe ModSummary
msum <- 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
$ ((ModSummary, [LImportDecl GhcPs]) -> ModSummary)
-> Maybe (ModSummary, [LImportDecl GhcPs]) -> Maybe ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModSummary, [LImportDecl GhcPs]) -> ModSummary
forall a b. (a, b) -> a
fst (Maybe (ModSummary, [LImportDecl GhcPs]) -> Maybe ModSummary)
-> Action (Maybe (ModSummary, [LImportDecl GhcPs]))
-> Action (Maybe ModSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action (Maybe (ModSummary, [LImportDecl GhcPs]))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
f
          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
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
addBootMap ArtifactsLocation
al FilePathId
fId
          -- Try to parse the imports of the file
          Maybe
  ([(Located ModuleName, Maybe ArtifactsLocation)],
   Set InstalledUnitId)
importsOrErr <- Action
  (Maybe
     ([(Located ModuleName, Maybe ArtifactsLocation)],
      Set InstalledUnitId))
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     (Maybe
        ([(Located ModuleName, Maybe ArtifactsLocation)],
         Set InstalledUnitId))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Action
   (Maybe
      ([(Located ModuleName, Maybe ArtifactsLocation)],
       Set InstalledUnitId))
 -> StateT
      (RawDependencyInformation, IntMap ArtifactsLocation)
      Action
      (Maybe
         ([(Located ModuleName, Maybe ArtifactsLocation)],
          Set InstalledUnitId)))
-> Action
     (Maybe
        ([(Located ModuleName, Maybe ArtifactsLocation)],
         Set InstalledUnitId))
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     (Maybe
        ([(Located ModuleName, Maybe ArtifactsLocation)],
         Set InstalledUnitId))
forall a b. (a -> b) -> a -> b
$ GetLocatedImports
-> NormalizedFilePath
-> Action
     (Maybe
        ([(Located ModuleName, Maybe ArtifactsLocation)],
         Set InstalledUnitId))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetLocatedImports
GetLocatedImports NormalizedFilePath
f
          case Maybe
  ([(Located ModuleName, Maybe ArtifactsLocation)],
   Set InstalledUnitId)
importsOrErr of
            Maybe
  ([(Located ModuleName, Maybe ArtifactsLocation)],
   Set InstalledUnitId)
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)
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
modifyRawDepInfo (FilePathId
-> Either ModuleParseError ModuleImports
-> RawDependencyInformation
-> RawDependencyInformation
insertImport FilePathId
fId (ModuleParseError -> Either ModuleParseError ModuleImports
forall a b. a -> Either a b
Left ModuleParseError
ModuleParseError))
              FilePathId
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
forall (m :: * -> *) a. Monad m => a -> m a
return FilePathId
fId
            Just ([(Located ModuleName, Maybe ArtifactsLocation)]
modImports, Set InstalledUnitId
pkgImports) -> 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 <- (ArtifactsLocation
 -> StateT
      (RawDependencyInformation, IntMap ArtifactsLocation)
      Action
      FilePathId)
-> [ArtifactsLocation]
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     [FilePathId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NormalizedFilePath
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
go (NormalizedFilePath
 -> StateT
      (RawDependencyInformation, IntMap ArtifactsLocation)
      Action
      FilePathId)
-> (ArtifactsLocation -> NormalizedFilePath)
-> ArtifactsLocation
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
modifyRawDepInfo ((RawDependencyInformation -> RawDependencyInformation)
 -> StateT
      (RawDependencyInformation, IntMap ArtifactsLocation) Action ())
-> (RawDependencyInformation -> RawDependencyInformation)
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall a b. (a -> b) -> a -> b
$ FilePathId
-> Either ModuleParseError ModuleImports
-> RawDependencyInformation
-> RawDependencyInformation
insertImport FilePathId
fId (ModuleImports -> Either ModuleParseError ModuleImports
forall a b. b -> Either a b
Right (ModuleImports -> Either ModuleParseError ModuleImports)
-> ModuleImports -> Either ModuleParseError ModuleImports
forall a b. (a -> b) -> a -> b
$ [(Located ModuleName, Maybe FilePathId)]
-> Set InstalledUnitId -> ModuleImports
ModuleImports [(Located ModuleName, Maybe FilePathId)]
moduleImports' Set InstalledUnitId
pkgImports)
              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)
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
modifyRawDepInfo RawDependencyInformation -> RawDependencyInformation
f = ((RawDependencyInformation, IntMap ArtifactsLocation)
 -> (RawDependencyInformation, IntMap ArtifactsLocation))
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RawDependencyInformation -> RawDependencyInformation)
-> (RawDependencyInformation, IntMap ArtifactsLocation)
-> (RawDependencyInformation, IntMap ArtifactsLocation)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first RawDependencyInformation -> RawDependencyInformation
f)

    addBootMap ::  ArtifactsLocation -> FilePathId -> RawDepM ()
    addBootMap :: ArtifactsLocation
-> FilePathId
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
addBootMap ArtifactsLocation
al FilePathId
fId =
      ((RawDependencyInformation, IntMap ArtifactsLocation)
 -> (RawDependencyInformation, IntMap ArtifactsLocation))
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\(RawDependencyInformation
rd, IntMap ArtifactsLocation
ss) -> (RawDependencyInformation
rd, if ArtifactsLocation -> Bool
isBootLocation ArtifactsLocation
al
                                  then Int
-> ArtifactsLocation
-> IntMap ArtifactsLocation
-> IntMap ArtifactsLocation
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (FilePathId -> Int
getFilePathId FilePathId
fId) ArtifactsLocation
al IntMap ArtifactsLocation
ss
                                  else IntMap ArtifactsLocation
ss))

    getFreshFid :: ArtifactsLocation -> RawDepM FilePathId
    getFreshFid :: ArtifactsLocation
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
getFreshFid ArtifactsLocation
al = do
      (RawDependencyInformation
rawDepInfo, IntMap ArtifactsLocation
ss) <- StateT
  (RawDependencyInformation, IntMap ArtifactsLocation)
  Action
  (RawDependencyInformation, IntMap ArtifactsLocation)
forall s (m :: * -> *). MonadState s m => m s
get
      let (FilePathId
fId, PathIdMap
path_map) = ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)
getPathId ArtifactsLocation
al (RawDependencyInformation -> PathIdMap
rawPathIdMap RawDependencyInformation
rawDepInfo)
      -- 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)
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation) Action ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RawDependencyInformation
rawDepInfo', IntMap ArtifactsLocation
ss)
      FilePathId
-> StateT
     (RawDependencyInformation, IntMap ArtifactsLocation)
     Action
     FilePathId
forall (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
-> Int -> ArtifactsLocation -> BootIdMap -> BootIdMap
updateBootMap RawDependencyInformation
pm Int
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) (String -> NormalizedFilePath
toNormalizedFilePath' (String -> NormalizedFilePath) -> String -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ String -> String
dropBootSuffix (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
artifactFilePath)
          in case Maybe FilePathId
msource_mod_id of
               Just FilePathId
source_mod_id -> FilePathId -> FilePathId -> BootIdMap -> BootIdMap
insertBootId FilePathId
source_mod_id (Int -> FilePathId
FilePathId Int
boot_mod_id) BootIdMap
bm
               Maybe FilePathId
Nothing -> BootIdMap
bm
        else BootIdMap
bm

    dropBootSuffix :: FilePath -> FilePath
    dropBootSuffix :: String -> String
dropBootSuffix String
hs_src = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length @[] String
"-boot") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
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 (Set InstalledUnitId)
FilePathIdMap ShowableModuleName
BootIdMap
PathIdMap
depBootMap :: DependencyInformation -> BootIdMap
depPathIdMap :: DependencyInformation -> PathIdMap
depPkgDeps :: DependencyInformation -> FilePathIdMap (Set InstalledUnitId)
depReverseModuleDeps :: DependencyInformation -> IntMap IntSet
depModuleDeps :: DependencyInformation -> IntMap IntSet
depModuleNames :: DependencyInformation -> FilePathIdMap ShowableModuleName
depErrorNodes :: DependencyInformation -> FilePathIdMap (NonEmpty NodeError)
depBootMap :: BootIdMap
depPathIdMap :: PathIdMap
depPkgDeps :: FilePathIdMap (Set InstalledUnitId)
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 Int
-> FilePathIdMap (NonEmpty NodeError) -> Maybe (NonEmpty NodeError)
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (FilePathId -> Int
getFilePathId FilePathId
fileId) FilePathIdMap (NonEmpty NodeError)
depErrorNodes of
            Maybe (NonEmpty NodeError)
Nothing -> [FileDiagnostic] -> Action [FileDiagnostic]
forall (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
                    [String]
modNames <- [FilePathId] -> (FilePathId -> Action String) -> Action [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePathId]
files ((FilePathId -> Action String) -> Action [String])
-> (FilePathId -> Action String) -> Action [String]
forall a b. (a -> b) -> a -> b
$ \FilePathId
fileId -> do
                        let file :: NormalizedFilePath
file = PathIdMap -> FilePathId -> NormalizedFilePath
idToPath PathIdMap
depPathIdMap FilePathId
fileId
                        NormalizedFilePath -> Action String
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 -> [String] -> FileDiagnostic
forall a. HasSrcSpan a => a -> [String] -> FileDiagnostic
toDiag Located ModuleName
imp ([String] -> FileDiagnostic) -> [String] -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
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 -> [String] -> FileDiagnostic
toDiag a
imp [String]
mods = (NormalizedFilePath
fp , ShowDiagnostic
ShowDiag , ) (Diagnostic -> FileDiagnostic) -> Diagnostic -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ Diagnostic :: Range
-> Maybe DiagnosticSeverity
-> Maybe NumberOrString
-> 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
<> [String] -> Text
showCycle [String]
mods
            , $sel:_code:Diagnostic :: Maybe NumberOrString
_code = Maybe NumberOrString
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 = String -> NormalizedFilePath
toNormalizedFilePath' (String -> NormalizedFilePath) -> String -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
noFilePath (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe String
srcSpanToFilename (a -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc a
imp)
          getModuleName :: NormalizedFilePath -> Action String
getModuleName NormalizedFilePath
file = do
           ModSummary
ms <- (ModSummary, [LImportDecl GhcPs]) -> ModSummary
forall a b. (a, b) -> a
fst ((ModSummary, [LImportDecl GhcPs]) -> ModSummary)
-> Action (ModSummary, [LImportDecl GhcPs]) -> Action ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action (ModSummary, [LImportDecl GhcPs])
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
           String -> Action String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName -> String
moduleNameString (ModuleName -> String)
-> (ModSummary -> ModuleName) -> ModSummary -> String
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 -> String) -> ModSummary -> String
forall a b. (a -> b) -> a -> b
$ ModSummary
ms)
          showCycle :: [String] -> Text
showCycle [String]
mods  = Text -> [Text] -> Text
T.intercalate Text
", " ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
mods)

-- returns all transitive dependencies in topological order.
-- NOTE: result does not include the argument file.
getDependenciesRule :: Rules ()
getDependenciesRule :: Rules ()
getDependenciesRule =
    (GetDependencies
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult TransitiveDependencies))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetDependencies
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult TransitiveDependencies))
 -> Rules ())
-> (GetDependencies
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult TransitiveDependencies))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetDependencies
GetDependencies NormalizedFilePath
file -> do
        DependencyInformation
depInfo <- GetDependencyInformation
-> NormalizedFilePath -> Action DependencyInformation
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetDependencyInformation
GetDependencyInformation NormalizedFilePath
file
        let allFiles :: [NormalizedFilePath]
allFiles = DependencyInformation -> [NormalizedFilePath]
reachableModules DependencyInformation
depInfo
        [()]
_ <- ReportImportCycles -> [NormalizedFilePath] -> Action [()]
forall k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ ReportImportCycles
ReportImportCycles [NormalizedFilePath]
allFiles
        IdeOptions
opts <- Action IdeOptions
getIdeOptions
        let mbFingerprints :: Maybe [Fingerprint]
mbFingerprints = (NormalizedFilePath -> Fingerprint)
-> [NormalizedFilePath] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Fingerprint
fingerprintString (String -> Fingerprint)
-> (NormalizedFilePath -> String)
-> NormalizedFilePath
-> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> String
fromNormalizedFilePath) [NormalizedFilePath]
allFiles [Fingerprint] -> Maybe String -> Maybe [Fingerprint]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IdeOptions -> Maybe String
optShakeFiles IdeOptions
opts
        (Maybe ByteString, IdeResult TransitiveDependencies)
-> Action (Maybe ByteString, IdeResult TransitiveDependencies)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fingerprint -> ByteString
fingerprintToBS (Fingerprint -> ByteString)
-> ([Fingerprint] -> Fingerprint) -> [Fingerprint] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Fingerprint] -> Fingerprint
fingerprintFingerprints ([Fingerprint] -> ByteString)
-> Maybe [Fingerprint] -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Fingerprint]
mbFingerprints, ([], DependencyInformation
-> NormalizedFilePath -> Maybe TransitiveDependencies
transitiveDeps DependencyInformation
depInfo NormalizedFilePath
file))

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
<$> GhcSession -> NormalizedFilePath -> Action HscEnvEq
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GhcSession
GhcSession NormalizedFilePath
f
      NormalizedFilePath
-> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult)
getHieAstRuleDefinition NormalizedFilePath
f HscEnv
hsc TcModuleResult
tmr

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

  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 FileOfInterestStatus
Modified -> [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
          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
-> ModSummary
-> [AvailInfo]
-> HieASTs Type
-> ByteString
-> IO [FileDiagnostic]
writeHieFile HscEnv
hsc (TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr) (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
    IsFileOfInterestResult
_ -> [FileDiagnostic] -> Action [FileDiagnostic]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  let refmap :: Maybe RefMap
refmap = Map FastString (HieAST Type) -> RefMap
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a) -> Map Identifier [(Span, IdentifierDetails a)]
generateReferencesMap (Map FastString (HieAST Type) -> RefMap)
-> (HieASTs Type -> Map FastString (HieAST Type))
-> HieASTs Type
-> RefMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieASTs Type -> Map FastString (HieAST Type)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts (HieASTs Type -> RefMap) -> Maybe (HieASTs Type) -> Maybe RefMap
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 -> RefMap -> HieAstResult
HAR (ModSummary -> Module
ms_mod  (ModSummary -> Module) -> ModSummary -> Module
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr) (HieASTs Type -> RefMap -> HieAstResult)
-> Maybe (HieASTs Type) -> Maybe (RefMap -> HieAstResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HieASTs Type)
masts Maybe (RefMap -> HieAstResult)
-> Maybe RefMap -> Maybe HieAstResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe RefMap
refmap)

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)],
   Set InstalledUnitId)
im <- GetLocatedImports
-> NormalizedFilePath
-> Action
     (Maybe
        ([(Located ModuleName, Maybe ArtifactsLocation)],
         Set InstalledUnitId))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetLocatedImports
GetLocatedImports NormalizedFilePath
f
  let mkImports :: ([(a, Maybe ArtifactsLocation)], b)
-> Map (SrcSpanLess a) NormalizedFilePath
mkImports ([(a, Maybe ArtifactsLocation)]
fileImports, b
_) = [(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)],
     Set InstalledUnitId)
    -> Map ModuleName NormalizedFilePath)
-> ([(Located ModuleName, Maybe ArtifactsLocation)],
    Set InstalledUnitId)
-> ImportMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Located ModuleName, Maybe ArtifactsLocation)],
 Set InstalledUnitId)
-> Map ModuleName NormalizedFilePath
forall a b.
(Ord (SrcSpanLess a), HasSrcSpan a) =>
([(a, Maybe ArtifactsLocation)], b)
-> Map (SrcSpanLess a) NormalizedFilePath
mkImports (([(Located ModuleName, Maybe ArtifactsLocation)],
  Set InstalledUnitId)
 -> ImportMap)
-> Maybe
     ([(Located ModuleName, Maybe ArtifactsLocation)],
      Set InstalledUnitId)
-> Maybe ImportMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  ([(Located ModuleName, Maybe ArtifactsLocation)],
   Set InstalledUnitId)
im)

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
    HieAstResult
har <- GetHieAst -> NormalizedFilePath -> Action HieAstResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetHieAst
GetHieAst NormalizedFilePath
f
    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
$ RefMap -> Bindings
bindings (RefMap -> Bindings) -> RefMap -> Bindings
forall a b. (a -> b) -> a -> b
$ HieAstResult -> RefMap
refMap HieAstResult
har)

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
      (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
      (HieAstResult -> RefMap
refMap -> RefMap
rf, PositionMapping
_) <- GetHieAst
-> NormalizedFilePath -> Action (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GetHieAst
GetHieAst NormalizedFilePath
file

-- When possible, rely on the haddocks embedded in our interface files
-- This creates problems on ghc-lib, see comment on 'getDocumentationTryGhc'
#if !defined(GHC_LIB)
      let parsedDeps :: [a]
parsedDeps = []
#else
      deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file
      let tdeps = transitiveModuleDeps deps
      parsedDeps <- uses_ GetParsedModule tdeps
#endif

      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 -> [ParsedModule] -> RefMap -> TcGblEnv -> IO DocAndKindMap
mkDocMap HscEnv
hsc [ParsedModule]
forall a. [a]
parsedDeps RefMap
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)

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

knownFilesRule :: Rules ()
knownFilesRule :: Rules ()
knownFilesRule = (GetKnownTargets
 -> Action (ByteString, HashMap Target [NormalizedFilePath]))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> Action (ByteString, v)) -> Rules ()
defineEarlyCutOffNoFile ((GetKnownTargets
  -> Action (ByteString, HashMap Target [NormalizedFilePath]))
 -> Rules ())
-> (GetKnownTargets
    -> Action (ByteString, HashMap Target [NormalizedFilePath]))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetKnownTargets
GetKnownTargets -> do
  Action ()
alwaysRerun
  Hashed (HashMap Target [NormalizedFilePath])
fs <- Action (Hashed (HashMap Target [NormalizedFilePath]))
knownTargets
  (ByteString, HashMap Target [NormalizedFilePath])
-> Action (ByteString, HashMap Target [NormalizedFilePath])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> ByteString
BS.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Hashed (HashMap Target [NormalizedFilePath]) -> Int
forall a. Hashable a => a -> Int
hash Hashed (HashMap Target [NormalizedFilePath])
fs), Hashed (HashMap Target [NormalizedFilePath])
-> HashMap Target [NormalizedFilePath]
forall a. Hashed a -> a
unhashed Hashed (HashMap Target [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 [NormalizedFilePath] -> HashSet NormalizedFilePath
toKnownFiles (HashMap Target [NormalizedFilePath] -> HashSet NormalizedFilePath)
-> Action (HashMap Target [NormalizedFilePath])
-> Action (HashSet NormalizedFilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetKnownTargets -> Action (HashMap Target [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 ([FileDiagnostic], Maybe 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 ([FileDiagnostic], Maybe TcModuleResult)
-> Action ([FileDiagnostic], Maybe TcModuleResult)
forall a.
Action (a, Maybe TcModuleResult)
-> Action (a, Maybe TcModuleResult)
addUsageDependencies (Action ([FileDiagnostic], Maybe TcModuleResult)
 -> Action ([FileDiagnostic], Maybe TcModuleResult))
-> Action ([FileDiagnostic], Maybe TcModuleResult)
-> Action ([FileDiagnostic], Maybe TcModuleResult)
forall a b. (a -> b) -> a -> b
$ IO ([FileDiagnostic], Maybe TcModuleResult)
-> Action ([FileDiagnostic], Maybe TcModuleResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([FileDiagnostic], Maybe TcModuleResult)
 -> Action ([FileDiagnostic], Maybe TcModuleResult))
-> IO ([FileDiagnostic], Maybe TcModuleResult)
-> Action ([FileDiagnostic], Maybe TcModuleResult)
forall a b. (a -> b) -> a -> b
$
    IdeDefer
-> HscEnv
-> [Linkable]
-> ParsedModule
-> IO ([FileDiagnostic], Maybe 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
        [String]
used_files <- IO [String] -> Action [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Action [String]) -> IO [String] -> Action [String]
forall a b. (a -> b) -> a -> b
$ IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef (IORef [String] -> IO [String]) -> IORef [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> IORef [String]
tcg_dependent_files (TcGblEnv -> IORef [String]) -> TcGblEnv -> IORef [String]
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 ((String -> NormalizedFilePath) -> [String] -> [NormalizedFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> NormalizedFilePath
toNormalizedFilePath' [String]
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 []

-- A local rule type to get caching. We want to use newCache, but it has
-- thread killed exception issues, so we lift it to a full rule.
-- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547
type instance RuleResult GhcSessionIO = IdeGhcSession

data GhcSessionIO = GhcSessionIO deriving (GhcSessionIO -> GhcSessionIO -> Bool
(GhcSessionIO -> GhcSessionIO -> Bool)
-> (GhcSessionIO -> GhcSessionIO -> Bool) -> Eq GhcSessionIO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GhcSessionIO -> GhcSessionIO -> Bool
$c/= :: GhcSessionIO -> GhcSessionIO -> Bool
== :: GhcSessionIO -> GhcSessionIO -> Bool
$c== :: GhcSessionIO -> GhcSessionIO -> Bool
Eq, Int -> GhcSessionIO -> String -> String
[GhcSessionIO] -> String -> String
GhcSessionIO -> String
(Int -> GhcSessionIO -> String -> String)
-> (GhcSessionIO -> String)
-> ([GhcSessionIO] -> String -> String)
-> Show GhcSessionIO
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GhcSessionIO] -> String -> String
$cshowList :: [GhcSessionIO] -> String -> String
show :: GhcSessionIO -> String
$cshow :: GhcSessionIO -> String
showsPrec :: Int -> GhcSessionIO -> String -> String
$cshowsPrec :: Int -> GhcSessionIO -> String -> String
Show, Typeable, (forall x. GhcSessionIO -> Rep GhcSessionIO x)
-> (forall x. Rep GhcSessionIO x -> GhcSessionIO)
-> Generic GhcSessionIO
forall x. Rep GhcSessionIO x -> GhcSessionIO
forall x. GhcSessionIO -> Rep GhcSessionIO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GhcSessionIO x -> GhcSessionIO
$cfrom :: forall x. GhcSessionIO -> Rep GhcSessionIO x
Generic)
instance Hashable GhcSessionIO
instance NFData   GhcSessionIO
instance Binary   GhcSessionIO

loadGhcSession :: Rules ()
loadGhcSession :: Rules ()
loadGhcSession = 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 :: Int
fingerprint = Int -> Int
forall a. Hashable a => a -> Int
hash (IdeGhcSession -> Int
sessionVersion IdeGhcSession
res)
        (ByteString, IdeGhcSession) -> Action (ByteString, IdeGhcSession)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ByteString
BS.pack (Int -> String
forall a. Show a => a -> String
show Int
fingerprint), IdeGhcSession
res)

    (GhcSession
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult HscEnvEq))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GhcSession
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult HscEnvEq))
 -> Rules ())
-> (GhcSession
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult HscEnvEq))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GhcSession
GhcSession NormalizedFilePath
file -> do
        IdeGhcSession{String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun :: IdeGhcSession -> String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun :: String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun} <- GhcSessionIO -> Action IdeGhcSession
forall k v. IdeRule k v => k -> Action v
useNoFile_ GhcSessionIO
GhcSessionIO
        (IdeResult HscEnvEq
val,[String]
deps) <- IO (IdeResult HscEnvEq, [String])
-> Action (IdeResult HscEnvEq, [String])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IdeResult HscEnvEq, [String])
 -> Action (IdeResult HscEnvEq, [String]))
-> IO (IdeResult HscEnvEq, [String])
-> Action (IdeResult HscEnvEq, [String])
forall a b. (a -> b) -> a -> b
$ String -> IO (IdeResult HscEnvEq, [String])
loadSessionFun (String -> IO (IdeResult HscEnvEq, [String]))
-> String -> IO (IdeResult HscEnvEq, [String])
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file

        -- add the deps to the Shake graph
        let addDependency :: String -> Action ()
addDependency String
fp = do
                let nfp :: NormalizedFilePath
nfp = String -> NormalizedFilePath
toNormalizedFilePath' String
fp
                Bool
itExists <- NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
nfp
                Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
itExists (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ Action FileVersion -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action FileVersion -> Action ())
-> Action FileVersion -> Action ()
forall a b. (a -> b) -> a -> b
$ GetModificationTime -> NormalizedFilePath -> Action FileVersion
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModificationTime
GetModificationTime NormalizedFilePath
nfp
        (String -> Action ()) -> [String] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Action ()
addDependency [String]
deps

        IdeOptions
opts <- Action IdeOptions
getIdeOptions
        let cutoffHash :: ByteString
cutoffHash =
              case IdeOptions -> Maybe String
optShakeFiles IdeOptions
opts of
                -- optShakeFiles is only set in the DAML case.
                -- https://github.com/digital-asset/ghcide/pull/522#discussion_r428622915
                Just {} -> ByteString
""
                -- Hash the HscEnvEq returned so cutoff if it didn't change
                -- from last time
                Maybe String
Nothing -> String -> ByteString
BS.pack (Int -> String
forall a. Show a => a -> String
show (Maybe HscEnvEq -> Int
forall a. Hashable a => a -> Int
hash (IdeResult HscEnvEq -> Maybe HscEnvEq
forall a b. (a, b) -> b
snd IdeResult HscEnvEq
val)))
        (Maybe ByteString, IdeResult HscEnvEq)
-> Action (Maybe ByteString, IdeResult HscEnvEq)
forall (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 (IdeResult HscEnvEq))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((GhcSessionDeps
  -> NormalizedFilePath -> Action (IdeResult HscEnvEq))
 -> Rules ())
-> (GhcSessionDeps
    -> NormalizedFilePath -> Action (IdeResult HscEnvEq))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GhcSessionDeps
GhcSessionDeps NormalizedFilePath
file -> NormalizedFilePath -> Action (IdeResult HscEnvEq)
ghcSessionDepsDefinition NormalizedFilePath
file

ghcSessionDepsDefinition :: NormalizedFilePath -> Action (IdeResult HscEnvEq)
ghcSessionDepsDefinition :: NormalizedFilePath -> Action (IdeResult HscEnvEq)
ghcSessionDepsDefinition NormalizedFilePath
file = do
        HscEnvEq
env <- 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
env
        ((ModSummary
ms,[LImportDecl GhcPs]
_),PositionMapping
_) <- GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
        (TransitiveDependencies
deps,PositionMapping
_) <- GetDependencies
-> NormalizedFilePath
-> Action (TransitiveDependencies, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GetDependencies
GetDependencies NormalizedFilePath
file
        let tdeps :: [NormalizedFilePath]
tdeps = TransitiveDependencies -> [NormalizedFilePath]
transitiveModuleDeps TransitiveDependencies
deps
            uses_th_qq :: Bool
uses_th_qq =
              Extension -> DynFlags -> Bool
xopt Extension
LangExt.TemplateHaskell DynFlags
dflags Bool -> Bool -> Bool
|| Extension -> DynFlags -> Bool
xopt Extension
LangExt.QuasiQuotes DynFlags
dflags
            dflags :: DynFlags
dflags = ModSummary -> DynFlags
ms_hspp_opts ModSummary
ms
        [HiFileResult]
ifaces <- if Bool
uses_th_qq
                  then GetModIface -> [NormalizedFilePath] -> Action [HiFileResult]
forall k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ GetModIface
GetModIface [NormalizedFilePath]
tdeps
                  else GetModIfaceWithoutLinkable
-> [NormalizedFilePath] -> Action [HiFileResult]
forall k v. IdeRule k v => k -> [NormalizedFilePath] -> Action [v]
uses_ GetModIfaceWithoutLinkable
GetModIfaceWithoutLinkable [NormalizedFilePath]
tdeps

        -- Currently GetDependencies returns things in topological order so A comes before B if A imports B.
        -- We need to reverse this as GHC gets very unhappy otherwise and complains about broken interfaces.
        -- Long-term we might just want to change the order returned by GetDependencies
        let inLoadOrder :: [HomeModInfo]
inLoadOrder = [HomeModInfo] -> [HomeModInfo]
forall a. [a] -> [a]
reverse ((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
$ [HomeModInfo] -> HscEnv -> HscEnv
loadModulesHome [HomeModInfo]
inLoadOrder (HscEnv -> HscEnv) -> IO HscEnv -> IO HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModSummary] -> HscEnv -> IO HscEnv
setupFinderCache ((HiFileResult -> ModSummary) -> [HiFileResult] -> [ModSummary]
forall a b. (a -> b) -> [a] -> [b]
map HiFileResult -> ModSummary
hirModSummary [HiFileResult]
ifaces) HscEnv
hsc

        HscEnvEq
res <- IO HscEnvEq -> Action HscEnvEq
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HscEnvEq -> Action HscEnvEq) -> IO HscEnvEq -> Action HscEnvEq
forall a b. (a -> b) -> a -> b
$ Maybe [String]
-> HscEnv -> [(InstalledUnitId, DynFlags)] -> IO HscEnvEq
newHscEnvEqWithImportPaths (HscEnvEq -> Maybe [String]
envImportPaths HscEnvEq
env) HscEnv
session' []
        IdeResult HscEnvEq -> Action (IdeResult HscEnvEq)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], HscEnvEq -> Maybe HscEnvEq
forall a. a -> Maybe a
Just HscEnvEq
res)

getModIfaceFromDiskRule :: Rules ()
getModIfaceFromDiskRule :: Rules ()
getModIfaceFromDiskRule = (GetModIfaceFromDisk
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult HiFileResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetModIfaceFromDisk
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult HiFileResult))
 -> Rules ())
-> (GetModIfaceFromDisk
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult HiFileResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetModIfaceFromDisk
GetModIfaceFromDisk NormalizedFilePath
f -> do
  (ModSummary
ms,[LImportDecl GhcPs]
_) <- GetModSummary
-> NormalizedFilePath -> Action (ModSummary, [LImportDecl GhcPs])
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummary
GetModSummary NormalizedFilePath
f
  ([FileDiagnostic]
diags_session, Maybe HscEnvEq
mb_session) <- NormalizedFilePath -> Action (IdeResult HscEnvEq)
ghcSessionDepsDefinition 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, ([FileDiagnostic]
diags_session, 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 =>
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, Just HiFileResult
x) -> do
                let fp :: Maybe ByteString
fp = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (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 [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
diags_session, HiFileResult -> Maybe HiFileResult
forall a. a -> Maybe a
Just HiFileResult
x))
            ([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 [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
forall a. [a] -> [a] -> [a]
++ [FileDiagnostic]
diags_session, Maybe HiFileResult
forall a. Maybe a
Nothing))

isHiFileStableRule :: Rules ()
isHiFileStableRule :: Rules ()
isHiFileStableRule = (IsHiFileStable
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult SourceModified))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((IsHiFileStable
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult SourceModified))
 -> Rules ())
-> (IsHiFileStable
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult SourceModified))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \IsHiFileStable
IsHiFileStable NormalizedFilePath
f -> do
    (ModSummary
ms,[LImportDecl GhcPs]
_) <- GetModSummaryWithoutTimestamps
-> NormalizedFilePath -> Action (ModSummary, [LImportDecl GhcPs])
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
f
    let hiFile :: NormalizedFilePath
hiFile = String -> NormalizedFilePath
toNormalizedFilePath'
                (String -> NormalizedFilePath) -> String -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ ModLocation -> String
ml_hi_file (ModLocation -> String) -> ModLocation -> String
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, Set InstalledUnitId
_) <- GetLocatedImports
-> NormalizedFilePath
-> Action
     ([(Located ModuleName, Maybe ArtifactsLocation)],
      Set InstalledUnitId)
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, IdeResult SourceModified)
-> Action (Maybe ByteString, IdeResult SourceModified)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ SourceModified -> String
forall a. Show a => a -> String
show SourceModified
sourceModified), ([], SourceModified -> Maybe SourceModified
forall a. a -> Maybe a
Just SourceModified
sourceModified))

getModSummaryRule :: Rules ()
getModSummaryRule :: Rules ()
getModSummaryRule = do
    (GetModSummary
 -> NormalizedFilePath
 -> Action
      (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs])))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetModSummary
  -> NormalizedFilePath
  -> Action
       (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs])))
 -> Rules ())
-> (GetModSummary
    -> NormalizedFilePath
    -> Action
         (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs])))
-> Rules ()
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
        let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
session
        (UTCTime
modTime, Maybe Text
mFileContent) <- NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
f
        let fp :: String
fp = NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f
        Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs])
modS <- IO (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs]))
-> Action
     (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs]))
 -> Action
      (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs])))
-> IO (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs]))
-> Action
     (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs]))
forall a b. (a -> b) -> a -> b
$ ExceptT [FileDiagnostic] IO (ModSummary, [LImportDecl GhcPs])
-> IO (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [FileDiagnostic] IO (ModSummary, [LImportDecl GhcPs])
 -> IO (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs])))
-> ExceptT [FileDiagnostic] IO (ModSummary, [LImportDecl GhcPs])
-> IO (Either [FileDiagnostic] (ModSummary, [LImportDecl GhcPs]))
forall a b. (a -> b) -> a -> b
$
                HscEnv
-> String
-> UTCTime
-> Maybe StringBuffer
-> ExceptT [FileDiagnostic] IO (ModSummary, [LImportDecl GhcPs])
getModSummaryFromImports HscEnv
session String
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] (ModSummary, [LImportDecl GhcPs])
modS of
            Right res :: (ModSummary, [LImportDecl GhcPs])
res@(ModSummary
ms,[LImportDecl GhcPs]
_) -> do
                let fingerPrint :: Int
fingerPrint = ((String, String, [String], Maybe String, [(Maybe Int, String)],
  [(Maybe Int, String)]),
 (Int, Int))
-> Int
forall a. Hashable a => a -> Int
hash (NormalizedFilePath
-> DynFlags
-> ModSummary
-> (String, String, [String], Maybe String, [(Maybe Int, String)],
    [(Maybe Int, String)])
computeFingerprint NormalizedFilePath
f DynFlags
dflags ModSummary
ms, UTCTime -> (Int, Int)
hashUTC UTCTime
modTime)
                (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
-> Action
     (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
fingerPrint) , ([], (ModSummary, [LImportDecl GhcPs])
-> Maybe (ModSummary, [LImportDecl GhcPs])
forall a. a -> Maybe a
Just (ModSummary, [LImportDecl GhcPs])
res))
            Left [FileDiagnostic]
diags -> (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
-> Action
     (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([FileDiagnostic]
diags, Maybe (ModSummary, [LImportDecl GhcPs])
forall a. Maybe a
Nothing))

    (GetModSummaryWithoutTimestamps
 -> NormalizedFilePath
 -> Action
      (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs])))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetModSummaryWithoutTimestamps
  -> NormalizedFilePath
  -> Action
       (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs])))
 -> Rules ())
-> (GetModSummaryWithoutTimestamps
    -> NormalizedFilePath
    -> Action
         (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs])))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
f -> do
        Maybe (ModSummary, [LImportDecl GhcPs])
ms <- GetModSummary
-> NormalizedFilePath
-> Action (Maybe (ModSummary, [LImportDecl GhcPs]))
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModSummary
GetModSummary NormalizedFilePath
f
        case Maybe (ModSummary, [LImportDecl GhcPs])
ms of
            Just res :: (ModSummary, [LImportDecl GhcPs])
res@(ModSummary
msWithTimestamps,[LImportDecl GhcPs]
_) -> do
                let ms :: ModSummary
ms = ModSummary
msWithTimestamps { ms_hs_date :: UTCTime
ms_hs_date = String -> UTCTime
forall a. HasCallStack => String -> a
error String
"use GetModSummary instead of GetModSummaryWithoutTimestamps" }
                DynFlags
dflags <- HscEnv -> DynFlags
hsc_dflags (HscEnv -> DynFlags)
-> (HscEnvEq -> HscEnv) -> HscEnvEq -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnvEq -> HscEnv
hscEnv (HscEnvEq -> DynFlags) -> Action HscEnvEq -> Action DynFlags
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
                -- include the mod time in the fingerprint
                let fp :: ByteString
fp = String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ (String, String, [String], Maybe String, [(Maybe Int, String)],
 [(Maybe Int, String)])
-> Int
forall a. Hashable a => a -> Int
hash (NormalizedFilePath
-> DynFlags
-> ModSummary
-> (String, String, [String], Maybe String, [(Maybe Int, String)],
    [(Maybe Int, String)])
computeFingerprint NormalizedFilePath
f DynFlags
dflags ModSummary
ms)
                (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
-> Action
     (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
fp, ([], (ModSummary, [LImportDecl GhcPs])
-> Maybe (ModSummary, [LImportDecl GhcPs])
forall a. a -> Maybe a
Just (ModSummary, [LImportDecl GhcPs])
res))
            Maybe (ModSummary, [LImportDecl GhcPs])
Nothing -> (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
-> Action
     (Maybe ByteString, IdeResult (ModSummary, [LImportDecl GhcPs]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([], Maybe (ModSummary, [LImportDecl GhcPs])
forall a. Maybe a
Nothing))
    where
        -- Compute a fingerprint from the contents of `ModSummary`,
        -- eliding the timestamps and other non relevant fields.
        computeFingerprint :: NormalizedFilePath
-> DynFlags
-> ModSummary
-> (String, String, [String], Maybe String, [(Maybe Int, String)],
    [(Maybe Int, String)])
computeFingerprint NormalizedFilePath
f DynFlags
dflags ModSummary{String
[(Maybe FastString, Located ModuleName)]
Maybe UTCTime
Maybe HsParsedModule
Maybe StringBuffer
UTCTime
HscSource
ModLocation
Module
DynFlags
ms_hsc_src :: ModSummary -> HscSource
ms_obj_date :: ModSummary -> Maybe UTCTime
ms_iface_date :: ModSummary -> Maybe UTCTime
ms_hie_date :: ModSummary -> Maybe UTCTime
ms_parsed_mod :: ModSummary -> Maybe HsParsedModule
ms_hspp_file :: ModSummary -> String
ms_hspp_buf :: Maybe StringBuffer
ms_hspp_opts :: DynFlags
ms_hspp_file :: String
ms_parsed_mod :: Maybe HsParsedModule
ms_textual_imps :: [(Maybe FastString, Located ModuleName)]
ms_srcimps :: [(Maybe FastString, Located ModuleName)]
ms_hie_date :: Maybe UTCTime
ms_iface_date :: Maybe UTCTime
ms_obj_date :: Maybe UTCTime
ms_hs_date :: UTCTime
ms_location :: ModLocation
ms_hsc_src :: HscSource
ms_mod :: Module
ms_hs_date :: ModSummary -> UTCTime
ms_mod :: ModSummary -> Module
ms_srcimps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_textual_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_hspp_buf :: ModSummary -> Maybe StringBuffer
ms_hspp_opts :: ModSummary -> DynFlags
ms_location :: ModSummary -> ModLocation
..} =
            let fingerPrint :: (String, String, [String], Maybe String, [(Maybe Int, String)],
 [(Maybe Int, String)])
fingerPrint =
                    ( ModuleName -> String
moduleNameString (Module -> ModuleName
moduleName Module
ms_mod)
                    , String
ms_hspp_file
                    , (Located String -> String) -> [Located String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Located String -> String
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located String]
opts
                    , ModLocation -> Maybe String
ml_hs_file ModLocation
ms_location
                    , [(Maybe FastString, Located ModuleName)] -> [(Maybe Int, String)]
fingerPrintImports [(Maybe FastString, Located ModuleName)]
ms_srcimps
                    , [(Maybe FastString, Located ModuleName)] -> [(Maybe Int, String)]
fingerPrintImports [(Maybe FastString, Located ModuleName)]
ms_textual_imps
                    )
                fingerPrintImports :: [(Maybe FastString, Located ModuleName)] -> [(Maybe Int, String)]
fingerPrintImports = ((Maybe FastString, Located ModuleName) -> (Maybe Int, String))
-> [(Maybe FastString, Located ModuleName)]
-> [(Maybe Int, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((FastString -> Int) -> Maybe FastString -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FastString -> Int
uniq (Maybe FastString -> Maybe Int)
-> (Located ModuleName -> String)
-> (Maybe FastString, Located ModuleName)
-> (Maybe Int, String)
forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** (ModuleName -> String
moduleNameString (ModuleName -> String)
-> (Located ModuleName -> ModuleName)
-> Located ModuleName
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc))
                opts :: [Located String]
opts = DynFlags -> StringBuffer -> String -> [Located String]
Hdr.getOptions DynFlags
dflags (Maybe StringBuffer -> StringBuffer
forall a. HasCallStack => Maybe a -> a
fromJust Maybe StringBuffer
ms_hspp_buf) (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f)
            in (String, String, [String], Maybe String, [(Maybe Int, String)],
 [(Maybe Int, String)])
fingerPrint

        hashUTC :: UTCTime -> (Int, Int)
hashUTC UTCTime{DiffTime
Day
utctDay :: UTCTime -> Day
utctDayTime :: UTCTime -> DiffTime
utctDayTime :: DiffTime
utctDay :: Day
..} = (Day -> Int
forall a. Enum a => a -> Int
fromEnum Day
utctDay, DiffTime -> Int
forall a. Enum a => a -> Int
fromEnum DiffTime
utctDayTime)


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 = (GetModIface
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult HiFileResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetModIface
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult HiFileResult))
 -> Rules ())
-> (GetModIface
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult HiFileResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetModIface
GetModIface NormalizedFilePath
f -> do
#if !defined(GHC_LIB)
  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) -> 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 -> HiFileResult -> IO [FileDiagnostic]
writeHiFile 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 <- GetModIfaceFromDisk
-> NormalizedFilePath -> Action (Maybe HiFileResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModIfaceFromDisk
GetModIfaceFromDisk 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
$ Var (ModuleEnv UTCTime)
-> (ModuleEnv UTCTime -> IO (ModuleEnv UTCTime)) -> IO ()
forall a. Var a -> (a -> IO a) -> IO ()
modifyVar_ Var (ModuleEnv UTCTime)
compiledLinkables ((ModuleEnv UTCTime -> IO (ModuleEnv UTCTime)) -> IO ())
-> (ModuleEnv UTCTime -> IO (ModuleEnv UTCTime)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ModuleEnv UTCTime
old -> ModuleEnv UTCTime -> IO (ModuleEnv UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleEnv UTCTime -> IO (ModuleEnv UTCTime))
-> ModuleEnv UTCTime -> IO (ModuleEnv UTCTime)
forall a b. (a -> b) -> a -> b
$ 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
#else
    tm <- use_ TypeCheck f
    hsc <- hscEnv <$> use_ GhcSessionDeps f
    (diags, !hiFile) <- liftIO $ compileToObjCodeIfNeeded hsc Nothing (error "can't compile with ghc-lib") tm
    let fp = hiFileFingerPrint <$> hiFile
    return (fp, (diags, hiFile))
#endif

getModIfaceWithoutLinkableRule :: Rules ()
getModIfaceWithoutLinkableRule :: Rules ()
getModIfaceWithoutLinkableRule = (GetModIfaceWithoutLinkable
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult HiFileResult))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetModIfaceWithoutLinkable
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult HiFileResult))
 -> Rules ())
-> (GetModIfaceWithoutLinkable
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult HiFileResult))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetModIfaceWithoutLinkable
GetModIfaceWithoutLinkable NormalizedFilePath
f -> do
  Maybe HiFileResult
mhfr <- GetModIface -> NormalizedFilePath -> Action (Maybe HiFileResult)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetModIface
GetModIface NormalizedFilePath
f
  let mhfr' :: Maybe HiFileResult
mhfr' = (HiFileResult -> HiFileResult)
-> Maybe HiFileResult -> Maybe HiFileResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HiFileResult
x -> HiFileResult
x{ hirHomeMod :: HomeModInfo
hirHomeMod = (HiFileResult -> HomeModInfo
hirHomeMod HiFileResult
x){ hm_linkable :: Maybe Linkable
hm_linkable = Linkable -> Maybe Linkable
forall a. a -> Maybe a
Just (String -> Linkable
forall a. HasCallStack => String -> a
error String
msg) } }) Maybe HiFileResult
mhfr
      msg :: String
msg = String
"tried to look at linkable for GetModIfaceWithoutLinkable for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> String
forall a. Show a => a -> String
show NormalizedFilePath
f
  (Maybe ByteString, IdeResult HiFileResult)
-> Action (Maybe ByteString, IdeResult HiFileResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fingerprint -> ByteString
fingerprintToBS (Fingerprint -> ByteString)
-> (HiFileResult -> Fingerprint) -> HiFileResult -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Fingerprint
getModuleHash (ModIface -> Fingerprint)
-> (HiFileResult -> ModIface) -> HiFileResult -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HiFileResult -> ModIface
hirModIface (HiFileResult -> ByteString)
-> Maybe HiFileResult -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HiFileResult
mhfr', ([],Maybe HiFileResult
mhfr'))

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
    (Maybe ByteString
_, ([FileDiagnostic]
diags, Maybe ParsedModule
mb_pm)) <- IO (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, IdeResult ParsedModule)
 -> Action (Maybe ByteString, IdeResult ParsedModule))
-> IO (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall a b. (a -> b) -> a -> b
$ HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (Maybe ByteString, IdeResult ParsedModule)
getParsedModuleDefinition HscEnv
hsc IdeOptions
opt NormalizedFilePath
f (ModSummary -> ModSummary
withOptHaddock ModSummary
ms)
    ([FileDiagnostic]
diags, Maybe ParsedModule
mb_pm) <- case Maybe ParsedModule
mb_pm of
        Just ParsedModule
_ -> IdeResult ParsedModule -> Action (IdeResult ParsedModule)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileDiagnostic]
diags, Maybe ParsedModule
mb_pm)
        Maybe ParsedModule
Nothing -> do
            -- if parsing fails, try parsing again with Haddock turned off
            (Maybe ByteString
_, ([FileDiagnostic]
diagsNoHaddock, Maybe ParsedModule
mb_pm)) <- IO (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, IdeResult ParsedModule)
 -> Action (Maybe ByteString, IdeResult ParsedModule))
-> IO (Maybe ByteString, IdeResult ParsedModule)
-> Action (Maybe ByteString, IdeResult ParsedModule)
forall a b. (a -> b) -> a -> b
$ HscEnv
-> IdeOptions
-> NormalizedFilePath
-> ModSummary
-> IO (Maybe ByteString, 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 ([FileDiagnostic], Maybe 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
                    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TcModuleResult -> Bool
tmrDeferedError 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 -> HiFileResult -> IO [FileDiagnostic]
writeHiFile HscEnv
hsc HiFileResult
hiFile
                  Maybe HiFileResult
_ -> [FileDiagnostic] -> Action [FileDiagnostic]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

                -- Write hie file
                ([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
-> ModSummary
-> [AvailInfo]
-> HieASTs Type
-> ByteString
-> IO [FileDiagnostic]
writeHieFile HscEnv
hsc (TcModuleResult -> ModSummary
tmrModSummary TcModuleResult
tmr) (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

                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 [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
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 (String -> ByteString
BS.pack (String -> ByteString)
-> (Hashed (Maybe Value) -> String)
-> Hashed (Maybe Value)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> (Hashed (Maybe Value) -> Int) -> Hashed (Maybe Value) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hashed (Maybe Value) -> Int
forall a. Hashable a => a -> Int
hash (Hashed (Maybe Value) -> ByteString)
-> Hashed (Maybe Value) -> ByteString
forall a b. (a -> b) -> a -> b
$ Hashed (Maybe Value)
settings, Hashed (Maybe Value)
settings)

-- | For now we always use bytecode
getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
getLinkableType NormalizedFilePath
f = do
  Bool
needsComp <- NeedsCompilation -> NormalizedFilePath -> Action Bool
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ NeedsCompilation
NeedsCompilation NormalizedFilePath
f
  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
$ if Bool
needsComp then LinkableType -> Maybe LinkableType
forall a. a -> Maybe a
Just LinkableType
BCOLinkable else Maybe LinkableType
forall a. Maybe a
Nothing

needsCompilationRule :: Rules ()
needsCompilationRule :: Rules ()
needsCompilationRule = (NeedsCompilation
 -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult Bool))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((NeedsCompilation
  -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult Bool))
 -> Rules ())
-> (NeedsCompilation
    -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult Bool))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \NeedsCompilation
NeedsCompilation NormalizedFilePath
file -> do
  ((ModSummary
ms,[LImportDecl GhcPs]
_),PositionMapping
_) <- GetModSummaryWithoutTimestamps
-> NormalizedFilePath
-> Action ((ModSummary, [LImportDecl GhcPs]), PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (v, PositionMapping)
useWithStale_ GetModSummaryWithoutTimestamps
GetModSummaryWithoutTimestamps NormalizedFilePath
file
  -- A file needs object code if it uses TH or any file that depends on it uses TH
  Bool
res <-
    if ModSummary -> Bool
uses_th_qq ModSummary
ms
    then Bool -> Action Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    -- Treat as False if some reverse dependency header fails to parse
    else (NormalizedFilePath -> Action Bool)
-> [NormalizedFilePath] -> Action Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM ((Maybe Bool -> Bool) -> Action (Maybe Bool) -> Action Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False) (Action (Maybe Bool) -> Action Bool)
-> (NormalizedFilePath -> Action (Maybe Bool))
-> NormalizedFilePath
-> Action Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NeedsCompilation -> NormalizedFilePath -> Action (Maybe Bool)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use NeedsCompilation
NeedsCompilation) ([NormalizedFilePath] -> Action Bool)
-> (Maybe DependencyInformation -> [NormalizedFilePath])
-> Maybe DependencyInformation
-> Action Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NormalizedFilePath]
-> (DependencyInformation -> [NormalizedFilePath])
-> Maybe DependencyInformation
-> [NormalizedFilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (NormalizedFilePath -> DependencyInformation -> [NormalizedFilePath]
immediateReverseDependencies NormalizedFilePath
file)
           (Maybe DependencyInformation -> Action Bool)
-> Action (Maybe DependencyInformation) -> Action Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GetModuleGraph -> Action (Maybe DependencyInformation)
forall k v. IdeRule k v => k -> Action (Maybe v)
useNoFile GetModuleGraph
GetModuleGraph
  (Maybe ByteString, IdeResult Bool)
-> Action (Maybe ByteString, IdeResult Bool)
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
$ String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Bool -> Int
forall a. Hashable a => a -> Int
hash Bool
res, ([], Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
res))
  where
    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

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

-- | A rule that wires per-file rules together
mainRule :: Rules ()
mainRule :: Rules ()
mainRule = 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 ()
getLocatedImportsRule
    Rules ()
getDependencyInformationRule
    Rules ()
reportImportCyclesRule
    Rules ()
getDependenciesRule
    Rules ()
typeCheckRule
    Rules ()
getDocMapRule
    Rules ()
loadGhcSession
    Rules ()
getModIfaceFromDiskRule
    Rules ()
getModIfaceRule
    Rules ()
getModIfaceWithoutLinkableRule
    Rules ()
getModSummaryRule
    Rules ()
isHiFileStableRule
    Rules ()
getModuleGraphRule
    Rules ()
knownFilesRule
    Rules ()
getClientSettingsRule
    Rules ()
getHieAstsRule
    Rules ()
getBindingsRule
    Rules ()
needsCompilationRule
    Rules ()
generateCoreRule
    Rules ()
getImportMapRule

-- | 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, Int -> IsHiFileStable -> String -> String
[IsHiFileStable] -> String -> String
IsHiFileStable -> String
(Int -> IsHiFileStable -> String -> String)
-> (IsHiFileStable -> String)
-> ([IsHiFileStable] -> String -> String)
-> Show IsHiFileStable
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [IsHiFileStable] -> String -> String
$cshowList :: [IsHiFileStable] -> String -> String
show :: IsHiFileStable -> String
$cshow :: IsHiFileStable -> String
showsPrec :: Int -> IsHiFileStable -> String -> String
$cshowsPrec :: Int -> IsHiFileStable -> String -> String
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
instance Binary   IsHiFileStable

type instance RuleResult IsHiFileStable = SourceModified