{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module Development.IDE.Core.OfInterest(
ofInterestRules,
getFilesOfInterest, setFilesOfInterest, modifyFilesOfInterest,
kick
) 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.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import qualified Data.Text as T
import Data.Tuple.Extra
import Development.Shake
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.Shake
import Control.Monad
newtype OfInterestVar = OfInterestVar (Var (HashSet NormalizedFilePath))
instance IsIdeGlobal OfInterestVar
type instance RuleResult GetFilesOfInterest = HashSet NormalizedFilePath
data GetFilesOfInterest = GetFilesOfInterest
deriving (Eq, Show, Typeable, Generic)
instance Hashable GetFilesOfInterest
instance NFData GetFilesOfInterest
instance Binary GetFilesOfInterest
ofInterestRules :: Rules ()
ofInterestRules = do
addIdeGlobal . OfInterestVar =<< liftIO (newVar HashSet.empty)
defineEarlyCutoff $ \GetFilesOfInterest _file -> assert (null $ fromNormalizedFilePath _file) $ do
alwaysRerun
filesOfInterest <- getFilesOfInterestUntracked
pure (Just $ BS.fromString $ show filesOfInterest, ([], Just filesOfInterest))
getFilesOfInterest :: Action (HashSet NormalizedFilePath)
getFilesOfInterest = useNoFile_ GetFilesOfInterest
setFilesOfInterest :: IdeState -> HashSet NormalizedFilePath -> IO ()
setFilesOfInterest state files = modifyFilesOfInterest state (const files)
getFilesOfInterestUntracked :: Action (HashSet NormalizedFilePath)
getFilesOfInterestUntracked = do
OfInterestVar var <- getIdeGlobalAction
liftIO $ readVar var
modifyFilesOfInterest :: IdeState -> (HashSet NormalizedFilePath -> HashSet NormalizedFilePath) -> IO ()
modifyFilesOfInterest state f = do
OfInterestVar var <- getIdeGlobalState state
files <- modifyVar var $ pure . dupe . f
logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show $ HashSet.toList files)
let das = map (\nfp -> mkDelayedAction "OfInterest" Debug (use GetSpanInfo nfp)) (HashSet.toList files)
shakeRestart state das
kick :: DelayedAction ()
kick = mkDelayedAction "kick" Debug $ do
files <- getFilesOfInterest
ShakeExtras{progressUpdate} <- getShakeExtras
liftIO $ progressUpdate KickStarted
void $ uses TypeCheck $ HashSet.toList files
liftIO $ progressUpdate KickCompleted