{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module Development.IDE.Core.OfInterest(
ofInterestRules,
getFilesOfInterest, setFilesOfInterest, modifyFilesOfInterest,
kick, FileOfInterestStatus(..)
) where
import Control.Concurrent.Extra
import Data.Binary
import Data.Hashable
import Control.DeepSeq
import GHC.Generics
import Data.Typeable
import qualified Data.ByteString.UTF8 as BS
import Control.Exception
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import Data.Tuple.Extra
import Development.Shake
import Control.Monad
import Development.IDE.Types.Exports
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Data.Maybe (catMaybes)
import Data.List.Extra (nubOrd)
import Development.IDE.Import.DependencyInformation
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class
import Development.IDE.Types.Options
newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
instance IsIdeGlobal OfInterestVar
type instance RuleResult GetFilesOfInterest = HashMap NormalizedFilePath FileOfInterestStatus
data GetFilesOfInterest = GetFilesOfInterest
deriving (GetFilesOfInterest -> GetFilesOfInterest -> Bool
(GetFilesOfInterest -> GetFilesOfInterest -> Bool)
-> (GetFilesOfInterest -> GetFilesOfInterest -> Bool)
-> Eq GetFilesOfInterest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFilesOfInterest -> GetFilesOfInterest -> Bool
$c/= :: GetFilesOfInterest -> GetFilesOfInterest -> Bool
== :: GetFilesOfInterest -> GetFilesOfInterest -> Bool
$c== :: GetFilesOfInterest -> GetFilesOfInterest -> Bool
Eq, Int -> GetFilesOfInterest -> ShowS
[GetFilesOfInterest] -> ShowS
GetFilesOfInterest -> String
(Int -> GetFilesOfInterest -> ShowS)
-> (GetFilesOfInterest -> String)
-> ([GetFilesOfInterest] -> ShowS)
-> Show GetFilesOfInterest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFilesOfInterest] -> ShowS
$cshowList :: [GetFilesOfInterest] -> ShowS
show :: GetFilesOfInterest -> String
$cshow :: GetFilesOfInterest -> String
showsPrec :: Int -> GetFilesOfInterest -> ShowS
$cshowsPrec :: Int -> GetFilesOfInterest -> ShowS
Show, Typeable, (forall x. GetFilesOfInterest -> Rep GetFilesOfInterest x)
-> (forall x. Rep GetFilesOfInterest x -> GetFilesOfInterest)
-> Generic GetFilesOfInterest
forall x. Rep GetFilesOfInterest x -> GetFilesOfInterest
forall x. GetFilesOfInterest -> Rep GetFilesOfInterest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFilesOfInterest x -> GetFilesOfInterest
$cfrom :: forall x. GetFilesOfInterest -> Rep GetFilesOfInterest x
Generic)
instance Hashable GetFilesOfInterest
instance NFData GetFilesOfInterest
instance Binary GetFilesOfInterest
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)
(GetFilesOfInterest
-> NormalizedFilePath
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> Rules ()
defineEarlyCutoff ((GetFilesOfInterest
-> NormalizedFilePath
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus)))
-> Rules ())
-> (GetFilesOfInterest
-> NormalizedFilePath
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetFilesOfInterest
GetFilesOfInterest NormalizedFilePath
_file -> Bool
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus))
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
_file) (Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus))
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus)))
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus))
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus))
forall a b. (a -> b) -> a -> b
$ do
Action ()
alwaysRerun
HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest <- Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus))
-> Action
(Maybe ByteString,
IdeResult (HashMap NormalizedFilePath FileOfInterestStatus))
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.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ HashMap NormalizedFilePath FileOfInterestStatus -> String
forall a. Show a => a -> String
show HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest, ([], HashMap NormalizedFilePath FileOfInterestStatus
-> Maybe (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. a -> Maybe a
Just HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest))
getFilesOfInterest :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterest :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterest = GetFilesOfInterest
-> Action (HashMap NormalizedFilePath FileOfInterestStatus)
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetFilesOfInterest
GetFilesOfInterest
setFilesOfInterest :: IdeState -> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
setFilesOfInterest :: IdeState
-> HashMap NormalizedFilePath FileOfInterestStatus -> IO ()
setFilesOfInterest IdeState
state HashMap NormalizedFilePath FileOfInterestStatus
files = IdeState
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO ()
modifyFilesOfInterest IdeState
state (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
forall a b. a -> b -> a
const 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
modifyFilesOfInterest
:: IdeState
-> (HashMap NormalizedFilePath FileOfInterestStatus -> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO ()
modifyFilesOfInterest :: IdeState
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO ()
modifyFilesOfInterest IdeState
state HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
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
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> IO (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,
HashMap NormalizedFilePath FileOfInterestStatus))
-> IO (HashMap NormalizedFilePath FileOfInterestStatus))
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a b. (a -> b) -> a -> b
$ (HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> (HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> HashMap NormalizedFilePath FileOfInterestStatus
-> IO
(HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap NormalizedFilePath FileOfInterestStatus
-> (HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall a. a -> (a, a)
dupe (HashMap NormalizedFilePath FileOfInterestStatus
-> (HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus))
-> (HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus)
-> HashMap NormalizedFilePath FileOfInterestStatus
-> (HashMap NormalizedFilePath FileOfInterestStatus,
HashMap NormalizedFilePath FileOfInterestStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
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 ([(NormalizedFilePath, FileOfInterestStatus)] -> String
forall a. Show a => a -> String
show ([(NormalizedFilePath, FileOfInterestStatus)] -> String)
-> [(NormalizedFilePath, FileOfInterestStatus)] -> String
forall a b. (a -> b) -> a -> b
$ HashMap NormalizedFilePath FileOfInterestStatus
-> [(NormalizedFilePath, FileOfInterestStatus)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList 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)
getFilesOfInterest
ShakeExtras{ProgressEvent -> IO ()
progressUpdate :: ShakeExtras -> ProgressEvent -> IO ()
progressUpdate :: ProgressEvent -> IO ()
progressUpdate} <- 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
$ ProgressEvent -> IO ()
progressUpdate ProgressEvent
KickStarted
([Maybe ModGuts]
results, ()) <- Action [Maybe ModGuts] -> Action () -> Action ([Maybe ModGuts], ())
forall a b. Action a -> Action b -> Action (a, b)
par (GenerateCore -> [NormalizedFilePath] -> Action [Maybe ModGuts]
forall k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe v]
uses GenerateCore
GenerateCore [NormalizedFilePath]
files) (Action [Maybe HieAstResult] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [Maybe HieAstResult] -> Action ())
-> Action [Maybe HieAstResult] -> Action ()
forall a b. (a -> b) -> a -> b
$ 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)
[ModIface] -> MaybeT Action [ModIface]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ModIface] -> MaybeT Action [ModIface])
-> [ModIface] -> MaybeT Action [ModIface]
forall a b. (a -> b) -> a -> b
$ (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
exportsMap :: 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
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Var ExportsMap -> (ExportsMap -> IO ExportsMap) -> IO ()
forall a. Var a -> (a -> IO a) -> IO ()
modifyVar_ Var ExportsMap
exportsMap ((ExportsMap -> IO ExportsMap) -> IO ())
-> (ExportsMap -> IO ExportsMap) -> IO ()
forall a b. (a -> b) -> a -> b
$ ExportsMap -> IO ExportsMap
forall a. a -> IO a
evaluate (ExportsMap -> IO ExportsMap)
-> (ExportsMap -> ExportsMap) -> ExportsMap -> IO ExportsMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
$ ProgressEvent -> IO ()
progressUpdate ProgressEvent
KickCompleted