{-# 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
type FileExistsMap = STM.Map NormalizedFilePath Bool
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
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
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
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 ()
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
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
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"]]
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
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
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
fileExistsFast :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
fileExistsFast :: NormalizedFilePath -> Action (Maybe ByteString, Maybe Bool)
fileExistsFast NormalizedFilePath
file = do
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
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
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)