{-# LANGUAGE OverloadedLists      #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
module Development.IDE.Core.FileExists
  ( fileExistsRules
  , modifyFileExists
  , getFileExists
  , watchedGlobs
  , GetFileExists(..)
  , Log(..)
  )
where

import           Control.Concurrent.STM.Stats          (atomically,
                                                        atomicallyNamed)
import           Control.Exception
import           Control.Monad.Extra
import           Control.Monad.IO.Class
import qualified Data.ByteString                       as BS
import           Data.List                             (partition)
import           Data.Maybe
import           Development.IDE.Core.FileStore        hiding (Log, LogShake)
import qualified Development.IDE.Core.FileStore        as FileStore
import           Development.IDE.Core.IdeConfiguration
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Shake            hiding (Log)
import qualified Development.IDE.Core.Shake            as Shake
import           Development.IDE.Graph
import           Development.IDE.Types.Location
import           Development.IDE.Types.Options
import           Development.IDE.Types.Shake           (toKey)
import qualified Focus
import           Ide.Logger                            (Pretty (pretty),
                                                        Recorder, WithPriority,
                                                        cmapWithPrio)
import           Ide.Plugin.Config                     (Config)
import           Language.LSP.Protocol.Types
import           Language.LSP.Server                   hiding (getVirtualFile)
import qualified StmContainers.Map                     as STM
import qualified System.Directory                      as Dir
import qualified System.FilePath.Glob                  as Glob

{- Note [File existence cache and LSP file watchers]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Some LSP servers provide the ability to register file watches with the client, which will then notify
us of file changes. Some clients can do this more efficiently than us, or generally it's a tricky
problem

Here we use this to maintain a quick lookup cache of file existence. How this works is:
- On startup, if the client supports it we ask it to watch some files (see below).
- When those files are created or deleted (we can also see change events, but we don't
care since we're only caching existence here) we get a notification from the client.
- The notification handler calls 'modifyFileExists' to update our cache.

This means that the cache will only ever work for the files we have set up a watcher for.
So we pick the set that we mostly care about and which are likely to change existence
most often: the source files of the project (as determined by the source extensions
we're configured to care about).

For all other files we fall back to the slow path.

There are a few failure modes to think about:

1. The client doesn't send us the notifications we asked for.

There's not much we can do in this case: the whole point is to rely on the client so
we don't do the checking ourselves. If the client lets us down, we will just be wrong.

2. Races between registering watchers, getting notifications, and file changes.

If a file changes status between us asking for notifications and the client actually
setting up the notifications, we might not get told about it. But this is a relatively
small race window around startup, so we just don't worry about it.

3. Using the fast path for files that we aren't watching.

In this case we will fall back to the slow path, but cache that result forever (since
it won't get invalidated by a client notification). To prevent this we guard the
fast path by a check that the path also matches our watching patterns.
-}

-- See Note [File existence cache and LSP file watchers]
-- | A map for tracking the file existence.
-- If a path maps to 'True' then it exists; if it maps to 'False' then it doesn't exist'; and
-- if it's not in the map then we don't know.
type FileExistsMap = STM.Map NormalizedFilePath Bool

-- | A wrapper around a mutable 'FileExistsState'
newtype FileExistsMapVar = FileExistsMapVar FileExistsMap

instance IsIdeGlobal FileExistsMapVar

data Log
  = LogFileStore FileStore.Log
  | LogShake Shake.Log
  deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogFileStore Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
    LogShake Log
msg     -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg

-- | Grab the current global value of 'FileExistsMap' without acquiring a dependency
getFileExistsMapUntracked :: Action FileExistsMap
getFileExistsMapUntracked :: Action FileExistsMap
getFileExistsMapUntracked = do
  FileExistsMapVar FileExistsMap
v <- Action FileExistsMapVar
forall a. (HasCallStack, IsIdeGlobal a) => Action a
getIdeGlobalAction
  FileExistsMap -> Action FileExistsMap
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return FileExistsMap
v

-- | Modify the global store of file exists and return the keys that need to be marked as dirty
modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Key]
modifyFileExists :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO [Key]
modifyFileExists IdeState
state [(NormalizedFilePath, FileChangeType)]
changes = do
  FileExistsMapVar FileExistsMap
var <- IdeState -> IO FileExistsMapVar
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
  -- Masked to ensure that the previous values are flushed together with the map update
  IO [Key] -> IO [Key]
forall a. IO a -> IO a
mask_ (IO [Key] -> IO [Key]) -> IO [Key] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ String -> STM [Key] -> IO [Key]
forall a. String -> STM a -> IO a
atomicallyNamed String
"modifyFileExists" (STM [Key] -> IO [Key]) -> STM [Key] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ do
    [(NormalizedFilePath, FileChangeType)]
-> ((NormalizedFilePath, FileChangeType) -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(NormalizedFilePath, FileChangeType)]
changes (((NormalizedFilePath, FileChangeType) -> STM ()) -> STM ())
-> ((NormalizedFilePath, FileChangeType) -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \(NormalizedFilePath
f,FileChangeType
c) ->
        case FileChangeType -> Maybe Bool
fromChange FileChangeType
c of
            Just Bool
c' -> Focus Bool STM () -> NormalizedFilePath -> FileExistsMap -> STM ()
forall key value result.
Hashable key =>
Focus value STM result -> key -> Map key value -> STM result
STM.focus (Bool -> Focus Bool STM ()
forall (m :: * -> *) a. Monad m => a -> Focus a m ()
Focus.insert Bool
c') NormalizedFilePath
f FileExistsMap
var
            Maybe Bool
Nothing -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    -- See Note [Invalidating file existence results]
    -- flush previous values
    let ([(NormalizedFilePath, FileChangeType)]
fileModifChanges, [(NormalizedFilePath, FileChangeType)]
fileExistChanges) =
            ((NormalizedFilePath, FileChangeType) -> Bool)
-> [(NormalizedFilePath, FileChangeType)]
-> ([(NormalizedFilePath, FileChangeType)],
    [(NormalizedFilePath, FileChangeType)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((FileChangeType -> FileChangeType -> Bool
forall a. Eq a => a -> a -> Bool
== FileChangeType
FileChangeType_Changed) (FileChangeType -> Bool)
-> ((NormalizedFilePath, FileChangeType) -> FileChangeType)
-> (NormalizedFilePath, FileChangeType)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedFilePath, FileChangeType) -> FileChangeType
forall a b. (a, b) -> b
snd) [(NormalizedFilePath, FileChangeType)]
changes
    [Key]
keys0 <- [[Key]] -> [Key]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Key]] -> [Key]) -> STM [[Key]] -> STM [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((NormalizedFilePath, FileChangeType) -> STM [Key])
-> [(NormalizedFilePath, FileChangeType)] -> STM [[Key]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ShakeExtras -> GetFileExists -> NormalizedFilePath -> STM [Key]
forall k.
ShakeValue k =>
ShakeExtras -> k -> NormalizedFilePath -> STM [Key]
deleteValue (IdeState -> ShakeExtras
shakeExtras IdeState
state) GetFileExists
GetFileExists (NormalizedFilePath -> STM [Key])
-> ((NormalizedFilePath, FileChangeType) -> NormalizedFilePath)
-> (NormalizedFilePath, FileChangeType)
-> STM [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedFilePath, FileChangeType) -> NormalizedFilePath
forall a b. (a, b) -> a
fst) [(NormalizedFilePath, FileChangeType)]
fileExistChanges
    let keys1 :: [Key]
keys1 = ((NormalizedFilePath, FileChangeType) -> Key)
-> [(NormalizedFilePath, FileChangeType)] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map (GetFileExists -> NormalizedFilePath -> Key
forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey GetFileExists
GetFileExists (NormalizedFilePath -> Key)
-> ((NormalizedFilePath, FileChangeType) -> NormalizedFilePath)
-> (NormalizedFilePath, FileChangeType)
-> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedFilePath, FileChangeType) -> NormalizedFilePath
forall a b. (a, b) -> a
fst) [(NormalizedFilePath, FileChangeType)]
fileExistChanges
    let keys2 :: [Key]
keys2 = ((NormalizedFilePath, FileChangeType) -> Key)
-> [(NormalizedFilePath, FileChangeType)] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map (GetModificationTime -> NormalizedFilePath -> Key
forall k. ShakeValue k => k -> NormalizedFilePath -> Key
toKey GetModificationTime
GetModificationTime (NormalizedFilePath -> Key)
-> ((NormalizedFilePath, FileChangeType) -> NormalizedFilePath)
-> (NormalizedFilePath, FileChangeType)
-> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NormalizedFilePath, FileChangeType) -> NormalizedFilePath
forall a b. (a, b) -> a
fst) [(NormalizedFilePath, FileChangeType)]
fileModifChanges
    [Key] -> STM [Key]
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Key]
keys0 [Key] -> [Key] -> [Key]
forall a. Semigroup a => a -> a -> a
<> [Key]
keys1 [Key] -> [Key] -> [Key]
forall a. Semigroup a => a -> a -> a
<> [Key]
keys2)

fromChange :: FileChangeType -> Maybe Bool
fromChange :: FileChangeType -> Maybe Bool
fromChange FileChangeType
FileChangeType_Created = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
fromChange FileChangeType
FileChangeType_Deleted = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
fromChange FileChangeType
FileChangeType_Changed = Maybe Bool
forall a. Maybe a
Nothing

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

-- | Returns True if the file exists
getFileExists :: NormalizedFilePath -> Action Bool
getFileExists :: NormalizedFilePath -> Action Bool
getFileExists NormalizedFilePath
fp = GetFileExists -> NormalizedFilePath -> Action Bool
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetFileExists
GetFileExists NormalizedFilePath
fp

{- Note [Which files should we watch?]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The watcher system gives us a lot of flexibility: we can set multiple watchers, and they can all watch on glob
patterns.

We used to have a quite precise system, where we would register a watcher for a single file path only (and always)
when we actually looked to see if it existed. The downside of this is that it sends a *lot* of notifications
to the client (thousands on a large project), and this could lock up some clients like emacs
(https://github.com/emacs-lsp/lsp-mode/issues/2165).

Now we take the opposite approach: we register a single, quite general watcher that looks for all files
with a predefined set of extensions. The consequences are:
- The client will have to watch more files. This is usually not too bad, since the pattern is a single glob,
and the clients typically call out to an optimized implementation of file watching that understands globs.
- The client will send us a lot more notifications. This isn't too bad in practice, since although
we're watching a lot of files in principle, they don't get created or destroyed that often.
- We won't ever hit the fast lookup path for files which aren't in our watch pattern, since the only way
files get into our map is when the client sends us a notification about them because we're watching them.
This is fine so long as we're watching the files we check most often, i.e. source files.
-}

-- | The list of file globs that we ask the client to watch.
watchedGlobs :: IdeOptions -> [String]
watchedGlobs :: IdeOptions -> [String]
watchedGlobs IdeOptions
opts = [ String
"**/*." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ext | String
ext <- IdeOptions -> [String]
allExtensions IdeOptions
opts]

allExtensions :: IdeOptions -> [String]
allExtensions :: IdeOptions -> [String]
allExtensions IdeOptions
opts = [String
extIncBoot | String
ext <- IdeOptions -> [String]
optExtensions IdeOptions
opts, String
extIncBoot <- [String
Item [String]
ext, String
ext String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-boot"]]

-- | Installs the 'getFileExists' rules.
--   Provides a fast implementation if client supports dynamic watched files.
--   Creates a global state as a side effect in that case.
fileExistsRules :: Recorder (WithPriority Log) -> Maybe (LanguageContextEnv Config) -> Rules ()
fileExistsRules :: Recorder (WithPriority Log)
-> Maybe (LanguageContextEnv Config) -> Rules ()
fileExistsRules Recorder (WithPriority Log)
recorder Maybe (LanguageContextEnv Config)
lspEnv = do
  Bool
supportsWatchedFiles <- case Maybe (LanguageContextEnv Config)
lspEnv of
    Maybe (LanguageContextEnv Config)
Nothing      -> Bool -> Rules Bool
forall a. a -> Rules a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Just LanguageContextEnv Config
lspEnv' -> IO Bool -> Rules Bool
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Rules Bool) -> IO Bool -> Rules Bool
forall a b. (a -> b) -> a -> b
$  LanguageContextEnv Config -> LspT Config IO Bool -> IO Bool
forall config (m :: * -> *) a.
LanguageContextEnv config -> LspT config m a -> m a
runLspT LanguageContextEnv Config
lspEnv' LspT Config IO Bool
isWatchSupported
  -- Create the global always, although it should only be used if we have fast rules.
  -- But there's a chance someone will send unexpected notifications anyway,
  -- e.g. https://github.com/haskell/ghcide/issues/599
  FileExistsMapVar -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal (FileExistsMapVar -> Rules ())
-> (FileExistsMap -> FileExistsMapVar) -> FileExistsMap -> Rules ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileExistsMap -> FileExistsMapVar
FileExistsMapVar (FileExistsMap -> Rules ()) -> Rules FileExistsMap -> Rules ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FileExistsMap -> Rules FileExistsMap
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FileExistsMap
forall key value. IO (Map key value)
STM.newIO

  ShakeExtras
extras <- Rules ShakeExtras
getShakeExtrasRules
  IdeOptions
opts <- IO IdeOptions -> Rules IdeOptions
forall a. IO a -> Rules a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> Rules IdeOptions)
-> IO IdeOptions -> Rules IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
extras
  let globs :: [String]
globs = IdeOptions -> [String]
watchedGlobs IdeOptions
opts
      patterns :: [Pattern]
patterns = (String -> Pattern) -> [String] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Pattern
Glob.compile [String]
globs
      fpMatches :: String -> Bool
fpMatches String
fp = (Pattern -> Bool) -> [Pattern] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern -> String -> Bool
`Glob.match`String
fp) [Pattern]
patterns
      isWatched :: NormalizedFilePath -> Action Bool
isWatched = if Bool
supportsWatchedFiles
        then \NormalizedFilePath
f -> do
            Bool
isWF <- NormalizedFilePath -> Action Bool
isWorkspaceFile NormalizedFilePath
f
            Bool -> Action Bool
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Action Bool) -> Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ Bool
isWF Bool -> Bool -> Bool
&& String -> Bool
fpMatches (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
f)
        else Action Bool -> NormalizedFilePath -> Action Bool
forall a b. a -> b -> a
const (Action Bool -> NormalizedFilePath -> Action Bool)
-> Action Bool -> NormalizedFilePath -> Action Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Action Bool
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

  if Bool
supportsWatchedFiles
    then Recorder (WithPriority Log)
-> (NormalizedFilePath -> Action Bool) -> Rules ()
fileExistsRulesFast Recorder (WithPriority Log)
recorder NormalizedFilePath -> Action Bool
isWatched
    else Recorder (WithPriority Log) -> Rules ()
fileExistsRulesSlow Recorder (WithPriority Log)
recorder

  Recorder (WithPriority Log)
-> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogFileStore Recorder (WithPriority Log)
recorder) NormalizedFilePath -> Action Bool
isWatched

-- Requires an lsp client that provides WatchedFiles notifications, but assumes that this has already been checked.
fileExistsRulesFast :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileExistsRulesFast :: Recorder (WithPriority Log)
-> (NormalizedFilePath -> Action Bool) -> Rules ()
fileExistsRulesFast Recorder (WithPriority Log)
recorder NormalizedFilePath -> Action Bool
isWatched =
    Recorder (WithPriority Log)
-> RuleBody GetFileExists Bool -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GetFileExists Bool -> Rules ())
-> RuleBody GetFileExists Bool -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetFileExists
 -> NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool))
-> RuleBody GetFileExists Bool
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleNoDiagnostics ((GetFileExists
  -> NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool))
 -> RuleBody GetFileExists Bool)
-> (GetFileExists
    -> NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool))
-> RuleBody GetFileExists Bool
forall a b. (a -> b) -> a -> b
$ \GetFileExists
GetFileExists NormalizedFilePath
file -> do
        Bool
isWF <- NormalizedFilePath -> Action Bool
isWatched NormalizedFilePath
file
        if Bool
isWF
            then NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool)
fileExistsFast NormalizedFilePath
file
            else NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool)
fileExistsSlow NormalizedFilePath
file

{- Note [Invalidating file existence results]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We have two mechanisms for getting file existence information:
- The file existence cache
- The VFS lookup

Both of these affect the results of the 'GetFileExists' rule, so we need to make sure it
is invalidated properly when things change.

For the file existence cache, we manually flush the results of 'GetFileExists' when we
modify it (i.e. when a notification comes from the client). This is faster than using
'alwaysRerun' in the 'fileExistsFast', and we need it to be as fast as possible.

For the VFS lookup, however, we won't get prompted to flush the result, so instead
we use 'alwaysRerun'.
-}

fileExistsFast :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
fileExistsFast :: NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool)
fileExistsFast NormalizedFilePath
file = do
    -- Could in principle use 'alwaysRerun' here, but it's too slwo, See Note [Invalidating file existence results]
    FileExistsMap
mp <- Action FileExistsMap
getFileExistsMapUntracked

    Maybe Bool
mbFilesWatched <- IO (Maybe Bool) -> Action (Maybe Bool)
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> Action (Maybe Bool))
-> IO (Maybe Bool) -> Action (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ STM (Maybe Bool) -> IO (Maybe Bool)
forall a. STM a -> IO a
atomically (STM (Maybe Bool) -> IO (Maybe Bool))
-> STM (Maybe Bool) -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FileExistsMap -> STM (Maybe Bool)
forall key value.
Hashable key =>
key -> Map key value -> STM (Maybe value)
STM.lookup NormalizedFilePath
file FileExistsMap
mp
    Bool
exist <- case Maybe Bool
mbFilesWatched of
      Just Bool
exist -> Bool -> Action Bool
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
exist
      -- We don't know about it: use the slow route.
      -- Note that we do *not* call 'fileExistsSlow', as that would trigger 'alwaysRerun'.
      Maybe Bool
Nothing    -> NormalizedFilePath -> Action Bool
getFileExistsVFS NormalizedFilePath
file
    (Maybe ByteString, Maybe Bool)
-> Action (Maybe ByteString, Maybe Bool)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe ByteString
summarizeExists Bool
exist, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
exist)

summarizeExists :: Bool -> Maybe BS.ByteString
summarizeExists :: Bool -> Maybe ByteString
summarizeExists Bool
x = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ if Bool
x then Word8 -> ByteString
BS.singleton Word8
1 else ByteString
BS.empty

fileExistsRulesSlow :: Recorder (WithPriority Log) -> Rules ()
fileExistsRulesSlow :: Recorder (WithPriority Log) -> Rules ()
fileExistsRulesSlow Recorder (WithPriority Log)
recorder =
  Recorder (WithPriority Log)
-> RuleBody GetFileExists Bool -> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log) -> RuleBody k v -> Rules ()
defineEarlyCutoff ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) (RuleBody GetFileExists Bool -> Rules ())
-> RuleBody GetFileExists Bool -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetFileExists
 -> NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool))
-> RuleBody GetFileExists Bool
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, Maybe v))
-> RuleBody k v
RuleNoDiagnostics ((GetFileExists
  -> NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool))
 -> RuleBody GetFileExists Bool)
-> (GetFileExists
    -> NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool))
-> RuleBody GetFileExists Bool
forall a b. (a -> b) -> a -> b
$ \GetFileExists
GetFileExists NormalizedFilePath
file -> NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool)
fileExistsSlow NormalizedFilePath
file

fileExistsSlow :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
fileExistsSlow :: NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool)
fileExistsSlow NormalizedFilePath
file = do
    -- See Note [Invalidating file existence results]
    Action ()
alwaysRerun
    Bool
exist <- NormalizedFilePath -> Action Bool
getFileExistsVFS NormalizedFilePath
file
    (Maybe ByteString, Maybe Bool)
-> Action (Maybe ByteString, Maybe Bool)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe ByteString
summarizeExists Bool
exist, Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
exist)

getFileExistsVFS :: NormalizedFilePath -> Action Bool
getFileExistsVFS :: NormalizedFilePath -> Action Bool
getFileExistsVFS NormalizedFilePath
file = do
  Maybe VirtualFile
vf <- NormalizedFilePath -> Action (Maybe VirtualFile)
getVirtualFile NormalizedFilePath
file
  if Maybe VirtualFile -> Bool
forall a. Maybe a -> Bool
isJust Maybe VirtualFile
vf
  then Bool -> Action Bool
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  else IO Bool -> Action Bool
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Action Bool) -> IO Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ (IOException -> IO Bool) -> IO Bool -> IO Bool
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(IOException
_ :: IOException) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
         String -> IO Bool
Dir.doesFileExist (NormalizedFilePath -> String
fromNormalizedFilePath NormalizedFilePath
file)