{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Core.OfInterest(
ofInterestRules,
getFilesOfInterestUntracked,
addFileOfInterest,
deleteFileOfInterest,
setFilesOfInterest,
kick, FileOfInterestStatus(..),
OfInterestVar(..)
) where
import Control.Concurrent.Strict
import Control.Monad
import Control.Monad.IO.Class
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import Development.IDE.Graph
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import qualified Data.ByteString as BS
import Data.List.Extra (nubOrd)
import Data.Maybe (catMaybes)
import Development.IDE.Core.ProgressReporting
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Development.IDE.Import.DependencyInformation
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Types.Options
newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
instance IsIdeGlobal OfInterestVar
ofInterestRules :: Rules ()
ofInterestRules :: Rules ()
ofInterestRules = do
OfInterestVar -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (OfInterestVar -> Rules ())
-> (Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> OfInterestVar)
-> Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> Rules ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> OfInterestVar
OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus) -> Rules ())
-> Rules (Var (HashMap NormalizedFilePath FileOfInterestStatus))
-> Rules ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Var (HashMap NormalizedFilePath FileOfInterestStatus))
-> Rules (Var (HashMap NormalizedFilePath FileOfInterestStatus))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HashMap NormalizedFilePath FileOfInterestStatus
-> IO (Var (HashMap NormalizedFilePath FileOfInterestStatus))
forall a. a -> IO (Var a)
newVar HashMap NormalizedFilePath FileOfInterestStatus
forall k v. HashMap k v
HashMap.empty)
RuleBody IsFileOfInterest IsFileOfInterestResult -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (RuleBody IsFileOfInterest IsFileOfInterestResult -> Rules ())
-> RuleBody IsFileOfInterest IsFileOfInterestResult -> Rules ()
forall a b. (a -> b) -> a -> b
$ (IsFileOfInterest
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult))
-> RuleBody IsFileOfInterest IsFileOfInterestResult
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleNoDiagnostics ((IsFileOfInterest
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult))
-> RuleBody IsFileOfInterest IsFileOfInterestResult)
-> (IsFileOfInterest
-> NormalizedFilePath
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult))
-> RuleBody IsFileOfInterest IsFileOfInterestResult
forall a b. (a -> b) -> a -> b
$ \IsFileOfInterest
IsFileOfInterest NormalizedFilePath
f -> do
Action ()
alwaysRerun
HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest <- Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked
let foi :: IsFileOfInterestResult
foi = IsFileOfInterestResult
-> (FileOfInterestStatus -> IsFileOfInterestResult)
-> Maybe FileOfInterestStatus
-> IsFileOfInterestResult
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IsFileOfInterestResult
NotFOI FileOfInterestStatus -> IsFileOfInterestResult
IsFOI (Maybe FileOfInterestStatus -> IsFileOfInterestResult)
-> Maybe FileOfInterestStatus -> IsFileOfInterestResult
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
f NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus
-> Maybe FileOfInterestStatus
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest
fp :: ByteString
fp = IsFileOfInterestResult -> ByteString
summarize IsFileOfInterestResult
foi
res :: (Maybe ByteString, Maybe IsFileOfInterestResult)
res = (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
fp, IsFileOfInterestResult -> Maybe IsFileOfInterestResult
forall a. a -> Maybe a
Just IsFileOfInterestResult
foi)
return (Maybe ByteString, Maybe IsFileOfInterestResult)
res
where
summarize :: IsFileOfInterestResult -> ByteString
summarize IsFileOfInterestResult
NotFOI = Word8 -> ByteString
BS.singleton Word8
0
summarize (IsFOI FileOfInterestStatus
OnDisk) = Word8 -> ByteString
BS.singleton Word8
1
summarize (IsFOI (Modified Bool
False)) = Word8 -> ByteString
BS.singleton Word8
2
summarize (IsFOI (Modified Bool
True)) = Word8 -> ByteString
BS.singleton Word8
3
setFilesOfInterest :: IdeState -> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
setFilesOfInterest :: IdeState
-> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
setFilesOfInterest IdeState
state HashMap NormalizedFilePath FileOfInterestStatus
files = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- IdeState -> IO OfInterestVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
forall a. Var a -> a -> IO ()
writeVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var HashMap NormalizedFilePath FileOfInterestStatus
files
getFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- Action OfInterestVar
forall a. IsIdeGlobal a => Action a
getIdeGlobalAction
IO (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action (HashMap NormalizedFilePath FileOfInterestStatus)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action (HashMap NormalizedFilePath FileOfInterestStatus))
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action (HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. (a -> b) -> a -> b
$ Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. Var a -> IO a
readVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var
addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest IdeState
state NormalizedFilePath
f FileOfInterestStatus
v = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- IdeState -> IO OfInterestVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
(Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
files) <- Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)))
-> IO
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. Var a -> (a -> IO (a, b)) -> IO b
modifyVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var ((HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)))
-> IO
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)))
-> IO
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. (a -> b) -> a -> b
$ \HashMap NormalizedFilePath FileOfInterestStatus
dict -> do
let (Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
new) = (Maybe FileOfInterestStatus
-> (Maybe FileOfInterestStatus, Maybe FileOfInterestStatus))
-> NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus
-> (Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF (, FileOfInterestStatus -> Maybe FileOfInterestStatus
forall a. a -> Maybe a
Just FileOfInterestStatus
v) NormalizedFilePath
f HashMap NormalizedFilePath FileOfInterestStatus
dict
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
(Maybe FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap NormalizedFilePath FileOfInterestStatus
new, (Maybe FileOfInterestStatus
prev, HashMap NormalizedFilePath FileOfInterestStatus
dict))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FileOfInterestStatus
prev Maybe FileOfInterestStatus -> Maybe FileOfInterestStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= FileOfInterestStatus -> Maybe FileOfInterestStatus
forall a. a -> Maybe a
Just FileOfInterestStatus
v) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ShakeExtras -> IsFileOfInterest -> [NormalizedFilePath] -> IO ()
forall k.
ShakeValue k =>
ShakeExtras -> k -> [NormalizedFilePath] -> IO ()
recordDirtyKeys (IdeState -> ShakeExtras
shakeExtras IdeState
state) IsFileOfInterest
IsFileOfInterest [NormalizedFilePath
f]
Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
state) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Set files of interest to: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (HashMap NormalizedFilePath FileOfInterestStatus -> String
forall a. Show a => a -> String
show HashMap NormalizedFilePath FileOfInterestStatus
files)
deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO ()
deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO ()
deleteFileOfInterest IdeState
state NormalizedFilePath
f = do
OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
var <- IdeState -> IO OfInterestVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
HashMap NormalizedFilePath FileOfInterestStatus
files <- Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. Var a -> (a -> a) -> IO a
modifyVar' Var (HashMap NormalizedFilePath FileOfInterestStatus)
var ((HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus))
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete NormalizedFilePath
f
ShakeExtras -> IsFileOfInterest -> [NormalizedFilePath] -> IO ()
forall k.
ShakeValue k =>
ShakeExtras -> k -> [NormalizedFilePath] -> IO ()
recordDirtyKeys (IdeState -> ShakeExtras
shakeExtras IdeState
state) IsFileOfInterest
IsFileOfInterest [NormalizedFilePath
f]
Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
state) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Set files of interest to: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (HashMap NormalizedFilePath FileOfInterestStatus -> String
forall a. Show a => a -> String
show HashMap NormalizedFilePath FileOfInterestStatus
files)
kick :: Action ()
kick :: Action ()
kick = do
[NormalizedFilePath]
files <- HashMap NormalizedFilePath FileOfInterestStatus
-> [NormalizedFilePath]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap NormalizedFilePath FileOfInterestStatus
-> [NormalizedFilePath])
-> Action (HashMap NormalizedFilePath FileOfInterestStatus)
-> Action [NormalizedFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked
ShakeExtras{ProgressReporting
$sel:progress:ShakeExtras :: ShakeExtras -> ProgressReporting
progress :: ProgressReporting
progress} <- Action ShakeExtras
getShakeExtras
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ ProgressReporting -> ProgressEvent -> IO ()
progressUpdate ProgressReporting
progress ProgressEvent
KickStarted
[Maybe ModGuts]
results <- GenerateCore -> [NormalizedFilePath] -> Action [Maybe ModGuts]
forall k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe v]
uses GenerateCore
GenerateCore [NormalizedFilePath]
files Action [Maybe ModGuts]
-> Action [Maybe HieAstResult] -> Action [Maybe ModGuts]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* GetHieAst -> [NormalizedFilePath] -> Action [Maybe HieAstResult]
forall k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe v]
uses GetHieAst
GetHieAst [NormalizedFilePath]
files
IdeOptions{ optCheckProject :: IdeOptions -> IO Bool
optCheckProject = IO Bool
doCheckProject } <- Action IdeOptions
getIdeOptions
Bool
checkProject <- IO Bool -> Action Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
doCheckProject
Maybe [ModIface]
ifaces <- if Bool
checkProject then Maybe [ModIface] -> Action (Maybe [ModIface])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ModIface]
forall a. Maybe a
Nothing else MaybeT Action [ModIface] -> Action (Maybe [ModIface])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Action [ModIface] -> Action (Maybe [ModIface]))
-> MaybeT Action [ModIface] -> Action (Maybe [ModIface])
forall a b. (a -> b) -> a -> b
$ do
[TransitiveDependencies]
deps <- Action (Maybe [TransitiveDependencies])
-> MaybeT Action [TransitiveDependencies]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Action (Maybe [TransitiveDependencies])
-> MaybeT Action [TransitiveDependencies])
-> Action (Maybe [TransitiveDependencies])
-> MaybeT Action [TransitiveDependencies]
forall a b. (a -> b) -> a -> b
$ [Maybe TransitiveDependencies] -> Maybe [TransitiveDependencies]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe TransitiveDependencies] -> Maybe [TransitiveDependencies])
-> Action [Maybe TransitiveDependencies]
-> Action (Maybe [TransitiveDependencies])
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]
uses GetDependencies
GetDependencies [NormalizedFilePath]
files
[Maybe HiFileResult]
hiResults <- Action [Maybe HiFileResult] -> MaybeT Action [Maybe HiFileResult]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Action [Maybe HiFileResult] -> MaybeT Action [Maybe HiFileResult])
-> Action [Maybe HiFileResult]
-> MaybeT Action [Maybe HiFileResult]
forall a b. (a -> b) -> a -> b
$ GetModIface -> [NormalizedFilePath] -> Action [Maybe HiFileResult]
forall k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe v]
uses GetModIface
GetModIface ([NormalizedFilePath] -> [NormalizedFilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([NormalizedFilePath] -> [NormalizedFilePath])
-> [NormalizedFilePath] -> [NormalizedFilePath]
forall a b. (a -> b) -> a -> b
$ (TransitiveDependencies -> [NormalizedFilePath])
-> [TransitiveDependencies] -> [NormalizedFilePath]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TransitiveDependencies -> [NormalizedFilePath]
transitiveModuleDeps [TransitiveDependencies]
deps)
return $ (HiFileResult -> ModIface) -> [HiFileResult] -> [ModIface]
forall a b. (a -> b) -> [a] -> [b]
map HiFileResult -> ModIface
hirModIface ([HiFileResult] -> [ModIface]) -> [HiFileResult] -> [ModIface]
forall a b. (a -> b) -> a -> b
$ [Maybe HiFileResult] -> [HiFileResult]
forall a. [Maybe a] -> [a]
catMaybes [Maybe HiFileResult]
hiResults
ShakeExtras{Var ExportsMap
$sel:exportsMap:ShakeExtras :: ShakeExtras -> Var ExportsMap
exportsMap :: Var ExportsMap
exportsMap} <- Action ShakeExtras
getShakeExtras
let mguts :: [ModGuts]
mguts = [Maybe ModGuts] -> [ModGuts]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ModGuts]
results
!exportsMap' :: ExportsMap
exportsMap' = [ModGuts] -> ExportsMap
createExportsMapMg [ModGuts]
mguts
!exportsMap'' :: ExportsMap
exportsMap'' = ExportsMap
-> ([ModIface] -> ExportsMap) -> Maybe [ModIface] -> ExportsMap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExportsMap
forall a. Monoid a => a
mempty [ModIface] -> ExportsMap
createExportsMap Maybe [ModIface]
ifaces
Action ExportsMap -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action ExportsMap -> Action ()) -> Action ExportsMap -> Action ()
forall a b. (a -> b) -> a -> b
$ IO ExportsMap -> Action ExportsMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExportsMap -> Action ExportsMap)
-> IO ExportsMap -> Action ExportsMap
forall a b. (a -> b) -> a -> b
$ Var ExportsMap -> (ExportsMap -> ExportsMap) -> IO ExportsMap
forall a. Var a -> (a -> a) -> IO a
modifyVar' Var ExportsMap
exportsMap ((ExportsMap -> ExportsMap) -> IO ExportsMap)
-> (ExportsMap -> ExportsMap) -> IO ExportsMap
forall a b. (a -> b) -> a -> b
$ (ExportsMap
exportsMap'' ExportsMap -> ExportsMap -> ExportsMap
forall a. Semigroup a => a -> a -> a
<>) (ExportsMap -> ExportsMap)
-> (ExportsMap -> ExportsMap) -> ExportsMap -> ExportsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExportsMap
exportsMap' ExportsMap -> ExportsMap -> ExportsMap
forall a. Semigroup a => a -> a -> a
<>)
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ ProgressReporting -> ProgressEvent -> IO ()
progressUpdate ProgressReporting
progress ProgressEvent
KickCompleted