-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP          #-}
{-# LANGUAGE TypeFamilies #-}

module Development.IDE.Core.FileStore(
    getFileContents,
    getVirtualFile,
    setFileModified,
    setSomethingModified,
    fileStoreRules,
    modificationTime,
    typecheckParents,
    VFSHandle,
    makeVFSHandle,
    makeLSPVFSHandle,
    isFileOfInterestRule,
    resetFileStore,
    resetInterfaceStore,
    getModificationTimeImpl,
    addIdeGlobal,
    getFileContentsImpl
    ) where

import           Control.Concurrent.STM                       (atomically)
import           Control.Concurrent.STM.TQueue                (writeTQueue)
import           Control.Concurrent.Strict
import           Control.Exception
import           Control.Monad.Extra
import qualified Data.ByteString                              as BS
import           Data.Either.Extra
import qualified Data.HashMap.Strict                          as HM
import           Data.Int                                     (Int64)
import qualified Data.Map.Strict                              as Map
import           Data.Maybe
import qualified Data.Rope.UTF16                              as Rope
import qualified Data.Text                                    as T
import           Data.Time
import           Development.IDE.Core.OfInterest              (OfInterestVar (..),
                                                               getFilesOfInterest)
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Orphans                  ()
import           Development.IDE.Import.DependencyInformation
import           Development.IDE.Types.Diagnostics
import           Development.IDE.Types.Location
import           Development.IDE.Types.Options
import           Development.Shake
import           HieDb.Create                                 (deleteMissingRealFiles)
import           Ide.Plugin.Config                            (CheckParents (..))
import           System.IO.Error

#ifdef mingw32_HOST_OS
import qualified System.Directory                             as Dir
#else
import           Data.Time.Clock.System                       (SystemTime (MkSystemTime),
                                                               systemToUTCTime)
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Marshal                              (alloca)
import           Foreign.Ptr
import           Foreign.Storable
import qualified System.Posix.Error                           as Posix
#endif

import qualified Development.IDE.Types.Logger                 as L

import qualified Data.Binary                                  as B
import qualified Data.ByteString.Lazy                         as LBS
import           Language.LSP.Server                          hiding
                                                              (getVirtualFile)
import qualified Language.LSP.Server                          as LSP
import           Language.LSP.Types                           (FileChangeType (FcChanged),
                                                               FileEvent (FileEvent),
                                                               toNormalizedFilePath,
                                                               uriToFilePath)
import           Language.LSP.VFS
import           System.FilePath

makeVFSHandle :: IO VFSHandle
makeVFSHandle :: IO VFSHandle
makeVFSHandle = do
    Var (Int, Map NormalizedUri VirtualFile)
vfsVar <- (Int, Map NormalizedUri VirtualFile)
-> IO (Var (Int, Map NormalizedUri VirtualFile))
forall a. a -> IO (Var a)
newVar (Int
1, Map NormalizedUri VirtualFile
forall k a. Map k a
Map.empty)
    VFSHandle -> IO VFSHandle
forall (f :: * -> *) a. Applicative f => a -> f a
pure VFSHandle :: (NormalizedUri -> IO (Maybe VirtualFile))
-> Maybe (NormalizedUri -> Maybe Text -> IO ()) -> VFSHandle
VFSHandle
        { getVirtualFile :: NormalizedUri -> IO (Maybe VirtualFile)
getVirtualFile = \NormalizedUri
uri -> do
              (Int
_nextVersion, Map NormalizedUri VirtualFile
vfs) <- Var (Int, Map NormalizedUri VirtualFile)
-> IO (Int, Map NormalizedUri VirtualFile)
forall a. Var a -> IO a
readVar Var (Int, Map NormalizedUri VirtualFile)
vfsVar
              Maybe VirtualFile -> IO (Maybe VirtualFile)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe VirtualFile -> IO (Maybe VirtualFile))
-> Maybe VirtualFile -> IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Map NormalizedUri VirtualFile -> Maybe VirtualFile
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NormalizedUri
uri Map NormalizedUri VirtualFile
vfs
        , setVirtualFileContents :: Maybe (NormalizedUri -> Maybe Text -> IO ())
setVirtualFileContents = (NormalizedUri -> Maybe Text -> IO ())
-> Maybe (NormalizedUri -> Maybe Text -> IO ())
forall a. a -> Maybe a
Just ((NormalizedUri -> Maybe Text -> IO ())
 -> Maybe (NormalizedUri -> Maybe Text -> IO ()))
-> (NormalizedUri -> Maybe Text -> IO ())
-> Maybe (NormalizedUri -> Maybe Text -> IO ())
forall a b. (a -> b) -> a -> b
$ \NormalizedUri
uri Maybe Text
content ->
              IO (Int, Map NormalizedUri VirtualFile) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Int, Map NormalizedUri VirtualFile) -> IO ())
-> IO (Int, Map NormalizedUri VirtualFile) -> IO ()
forall a b. (a -> b) -> a -> b
$ Var (Int, Map NormalizedUri VirtualFile)
-> ((Int, Map NormalizedUri VirtualFile)
    -> (Int, Map NormalizedUri VirtualFile))
-> IO (Int, Map NormalizedUri VirtualFile)
forall a. Var a -> (a -> a) -> IO a
modifyVar' Var (Int, Map NormalizedUri VirtualFile)
vfsVar (((Int, Map NormalizedUri VirtualFile)
  -> (Int, Map NormalizedUri VirtualFile))
 -> IO (Int, Map NormalizedUri VirtualFile))
-> ((Int, Map NormalizedUri VirtualFile)
    -> (Int, Map NormalizedUri VirtualFile))
-> IO (Int, Map NormalizedUri VirtualFile)
forall a b. (a -> b) -> a -> b
$ \(Int
nextVersion, Map NormalizedUri VirtualFile
vfs) -> (Int
nextVersion Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, ) (Map NormalizedUri VirtualFile
 -> (Int, Map NormalizedUri VirtualFile))
-> Map NormalizedUri VirtualFile
-> (Int, Map NormalizedUri VirtualFile)
forall a b. (a -> b) -> a -> b
$
                  case Maybe Text
content of
                    Maybe Text
Nothing -> NormalizedUri
-> Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NormalizedUri
uri Map NormalizedUri VirtualFile
vfs
                    -- The second version number is only used in persistFileVFS which we do not use so we set it to 0.
                    Just Text
content -> NormalizedUri
-> VirtualFile
-> Map NormalizedUri VirtualFile
-> Map NormalizedUri VirtualFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NormalizedUri
uri (Int -> Int -> Rope -> VirtualFile
VirtualFile Int
nextVersion Int
0 (Text -> Rope
Rope.fromText Text
content)) Map NormalizedUri VirtualFile
vfs
        }

makeLSPVFSHandle :: LanguageContextEnv c -> VFSHandle
makeLSPVFSHandle :: LanguageContextEnv c -> VFSHandle
makeLSPVFSHandle LanguageContextEnv c
lspEnv = VFSHandle :: (NormalizedUri -> IO (Maybe VirtualFile))
-> Maybe (NormalizedUri -> Maybe Text -> IO ()) -> VFSHandle
VFSHandle
    { getVirtualFile :: NormalizedUri -> IO (Maybe VirtualFile)
getVirtualFile = LanguageContextEnv c
-> LspT c IO (Maybe VirtualFile) -> IO (Maybe VirtualFile)
forall config (m :: * -> *) a.
LanguageContextEnv config -> LspT config m a -> m a
runLspT LanguageContextEnv c
lspEnv (LspT c IO (Maybe VirtualFile) -> IO (Maybe VirtualFile))
-> (NormalizedUri -> LspT c IO (Maybe VirtualFile))
-> NormalizedUri
-> IO (Maybe VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri -> LspT c IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
LSP.getVirtualFile
    , setVirtualFileContents :: Maybe (NormalizedUri -> Maybe Text -> IO ())
setVirtualFileContents = Maybe (NormalizedUri -> Maybe Text -> IO ())
forall a. Maybe a
Nothing
   }


isFileOfInterestRule :: Rules ()
isFileOfInterestRule :: Rules ()
isFileOfInterestRule = 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
    HashMap NormalizedFilePath FileOfInterestStatus
filesOfInterest <- Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterest
    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
`HM.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)
    (Maybe ByteString, Maybe IsFileOfInterestResult)
-> Action (Maybe ByteString, Maybe IsFileOfInterestResult)
forall (m :: * -> *) a. Monad m => a -> m a
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


getModificationTimeRule :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
getModificationTimeRule :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
getModificationTimeRule VFSHandle
vfs NormalizedFilePath -> Action Bool
isWatched = RuleBody GetModificationTime FileVersion -> Rules ()
forall k v. IdeRule k v => RuleBody k v -> Rules ()
defineEarlyCutoff (RuleBody GetModificationTime FileVersion -> Rules ())
-> RuleBody GetModificationTime FileVersion -> Rules ()
forall a b. (a -> b) -> a -> b
$ (GetModificationTime
 -> NormalizedFilePath
 -> Action (Maybe ByteString, IdeResult FileVersion))
-> RuleBody GetModificationTime FileVersion
forall k v.
(k -> NormalizedFilePath -> Action (Maybe ByteString, IdeResult v))
-> RuleBody k v
Rule ((GetModificationTime
  -> NormalizedFilePath
  -> Action (Maybe ByteString, IdeResult FileVersion))
 -> RuleBody GetModificationTime FileVersion)
-> (GetModificationTime
    -> NormalizedFilePath
    -> Action (Maybe ByteString, IdeResult FileVersion))
-> RuleBody GetModificationTime FileVersion
forall a b. (a -> b) -> a -> b
$ \(GetModificationTime_ Bool
missingFileDiags) NormalizedFilePath
file ->
    VFSHandle
-> (NormalizedFilePath -> Action Bool)
-> Bool
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult FileVersion)
getModificationTimeImpl VFSHandle
vfs NormalizedFilePath -> Action Bool
isWatched Bool
missingFileDiags NormalizedFilePath
file

getModificationTimeImpl :: VFSHandle
    -> (NormalizedFilePath -> Action Bool)
    -> Bool
    -> NormalizedFilePath
    -> Action
        (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
getModificationTimeImpl :: VFSHandle
-> (NormalizedFilePath -> Action Bool)
-> Bool
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult FileVersion)
getModificationTimeImpl VFSHandle
vfs NormalizedFilePath -> Action Bool
isWatched Bool
missingFileDiags NormalizedFilePath
file = do
        let file' :: FilePath
file' = NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
file
        let wrap :: (Int64, Int64) -> (Maybe ByteString, ([a], Maybe FileVersion))
wrap time :: (Int64, Int64)
time@(Int64
l,Int64
s) = (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int64, Int64) -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Int64, Int64)
time, ([], FileVersion -> Maybe FileVersion
forall a. a -> Maybe a
Just (FileVersion -> Maybe FileVersion)
-> FileVersion -> Maybe FileVersion
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> FileVersion
ModificationTime Int64
l Int64
s))
        Maybe VirtualFile
mbVirtual <- IO (Maybe VirtualFile) -> Action (Maybe VirtualFile)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VirtualFile) -> Action (Maybe VirtualFile))
-> IO (Maybe VirtualFile) -> Action (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ VFSHandle -> NormalizedUri -> IO (Maybe VirtualFile)
getVirtualFile VFSHandle
vfs (NormalizedUri -> IO (Maybe VirtualFile))
-> NormalizedUri -> IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
filePathToUri' NormalizedFilePath
file
        -- we use 'getVirtualFile' to discriminate FOIs so make that
        -- dependency explicit by using the IsFileOfInterest rule
        IsFileOfInterestResult
_ <- IsFileOfInterest
-> NormalizedFilePath -> Action IsFileOfInterestResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ IsFileOfInterest
IsFileOfInterest NormalizedFilePath
file
        case Maybe VirtualFile
mbVirtual of
            Just (VirtualFile -> Int
virtualFileVersion -> Int
ver) -> do
                Action ()
alwaysRerun
                (Maybe ByteString, IdeResult FileVersion)
-> Action (Maybe ByteString, IdeResult FileVersion)
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
$ ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
forall a. Binary a => a -> ByteString
B.encode Int
ver, ([], FileVersion -> Maybe FileVersion
forall a. a -> Maybe a
Just (FileVersion -> Maybe FileVersion)
-> FileVersion -> Maybe FileVersion
forall a b. (a -> b) -> a -> b
$ Int -> FileVersion
VFSVersion Int
ver))
            Maybe VirtualFile
Nothing -> do
                Bool
isWF <- NormalizedFilePath -> Action Bool
isWatched NormalizedFilePath
file
                Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isWF Bool -> Bool -> Bool
|| NormalizedFilePath -> Bool
isInterface NormalizedFilePath
file) Action ()
alwaysRerun
                IO (Maybe ByteString, IdeResult FileVersion)
-> Action (Maybe ByteString, IdeResult FileVersion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString, IdeResult FileVersion)
 -> Action (Maybe ByteString, IdeResult FileVersion))
-> IO (Maybe ByteString, IdeResult FileVersion)
-> Action (Maybe ByteString, IdeResult FileVersion)
forall a b. (a -> b) -> a -> b
$ ((Int64, Int64) -> (Maybe ByteString, IdeResult FileVersion))
-> IO (Int64, Int64)
-> IO (Maybe ByteString, IdeResult FileVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int64, Int64) -> (Maybe ByteString, IdeResult FileVersion)
forall a.
(Int64, Int64) -> (Maybe ByteString, ([a], Maybe FileVersion))
wrap (FilePath -> IO (Int64, Int64)
getModTime FilePath
file')
                    IO (Maybe ByteString, IdeResult FileVersion)
-> (IOException -> IO (Maybe ByteString, IdeResult FileVersion))
-> IO (Maybe ByteString, IdeResult FileVersion)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) -> do
                        let err :: FilePath
err | IOException -> Bool
isDoesNotExistError IOException
e = FilePath
"File does not exist: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file'
                                | Bool
otherwise = FilePath
"IO error while reading " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall e. Exception e => e -> FilePath
displayException IOException
e
                            diag :: FileDiagnostic
diag = NormalizedFilePath -> Text -> FileDiagnostic
ideErrorText NormalizedFilePath
file (FilePath -> Text
T.pack FilePath
err)
                        if IOException -> Bool
isDoesNotExistError IOException
e Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
missingFileDiags
                            then (Maybe ByteString, IdeResult FileVersion)
-> IO (Maybe ByteString, IdeResult FileVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([], Maybe FileVersion
forall a. Maybe a
Nothing))
                            else (Maybe ByteString, IdeResult FileVersion)
-> IO (Maybe ByteString, IdeResult FileVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ([FileDiagnostic
diag], Maybe FileVersion
forall a. Maybe a
Nothing))

-- | Interface files cannot be watched, since they live outside the workspace.
--   But interface files are private, in that only HLS writes them.
--   So we implement watching ourselves, and bypass the need for alwaysRerun.
isInterface :: NormalizedFilePath -> Bool
isInterface :: NormalizedFilePath -> Bool
isInterface NormalizedFilePath
f = FilePath -> FilePath
takeExtension (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".hi", FilePath
".hi-boot"]

-- | Reset the GetModificationTime state of interface files
resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> IO ()
resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> IO ()
resetInterfaceStore ShakeExtras
state NormalizedFilePath
f = do
    ShakeExtras -> GetModificationTime -> NormalizedFilePath -> IO ()
forall k.
(Typeable k, Hashable k, Eq k, Show k) =>
ShakeExtras -> k -> NormalizedFilePath -> IO ()
deleteValue ShakeExtras
state (Bool -> GetModificationTime
GetModificationTime_ Bool
True) NormalizedFilePath
f
    ShakeExtras -> GetModificationTime -> NormalizedFilePath -> IO ()
forall k.
(Typeable k, Hashable k, Eq k, Show k) =>
ShakeExtras -> k -> NormalizedFilePath -> IO ()
deleteValue ShakeExtras
state (Bool -> GetModificationTime
GetModificationTime_ Bool
False) NormalizedFilePath
f

-- | Reset the GetModificationTime state of watched files
resetFileStore :: IdeState -> [FileEvent] -> IO ()
resetFileStore :: IdeState -> [FileEvent] -> IO ()
resetFileStore IdeState
ideState [FileEvent]
changes = ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_ ->
    [FileEvent] -> (FileEvent -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileEvent]
changes ((FileEvent -> IO ()) -> IO ()) -> (FileEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FileEvent Uri
uri FileChangeType
c) ->
        case FileChangeType
c of
            FileChangeType
FcChanged
              | Just FilePath
f <- Uri -> Maybe FilePath
uriToFilePath Uri
uri
              -> do
                  -- we record FOIs document versions in all the stored values
                  -- so NEVER reset FOIs to avoid losing their versions
                  OfInterestVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
foisVar <- ShakeExtras -> IO OfInterestVar
forall a. IsIdeGlobal a => ShakeExtras -> IO a
getIdeGlobalExtras (IdeState -> ShakeExtras
shakeExtras IdeState
ideState)
                  HashMap NormalizedFilePath FileOfInterestStatus
fois <- Var (HashMap NormalizedFilePath FileOfInterestStatus)
-> IO (HashMap NormalizedFilePath FileOfInterestStatus)
forall a. Var a -> IO a
readVar Var (HashMap NormalizedFilePath FileOfInterestStatus)
foisVar
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member (FilePath -> NormalizedFilePath
toNormalizedFilePath FilePath
f) HashMap NormalizedFilePath FileOfInterestStatus
fois) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    ShakeExtras -> GetModificationTime -> NormalizedFilePath -> IO ()
forall k.
(Typeable k, Hashable k, Eq k, Show k) =>
ShakeExtras -> k -> NormalizedFilePath -> IO ()
deleteValue (IdeState -> ShakeExtras
shakeExtras IdeState
ideState) (Bool -> GetModificationTime
GetModificationTime_ Bool
True) (FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
f)
                    ShakeExtras -> GetModificationTime -> NormalizedFilePath -> IO ()
forall k.
(Typeable k, Hashable k, Eq k, Show k) =>
ShakeExtras -> k -> NormalizedFilePath -> IO ()
deleteValue (IdeState -> ShakeExtras
shakeExtras IdeState
ideState) (Bool -> GetModificationTime
GetModificationTime_ Bool
False) (FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
f)
            FileChangeType
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Dir.getModificationTime is surprisingly slow since it performs
-- a ton of conversions. Since we do not actually care about
-- the format of the time, we can get away with something cheaper.
-- For now, we only try to do this on Unix systems where it seems to get the
-- time spent checking file modifications (which happens on every change)
-- from > 0.5s to ~0.15s.
-- We might also want to try speeding this up on Windows at some point.
-- TODO leverage DidChangeWatchedFile lsp notifications on clients that
-- support them, as done for GetFileExists
getModTime :: FilePath -> IO (Int64, Int64)
getModTime :: FilePath -> IO (Int64, Int64)
getModTime FilePath
f =
#ifdef mingw32_HOST_OS
    do time <- Dir.getModificationTime f
       let !day = fromInteger $ toModifiedJulianDay $ utctDay time
           !dayTime = fromInteger $ diffTimeToPicoseconds $ utctDayTime time
       pure (day, dayTime)
#else
    FilePath -> (CString -> IO (Int64, Int64)) -> IO (Int64, Int64)
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
f ((CString -> IO (Int64, Int64)) -> IO (Int64, Int64))
-> (CString -> IO (Int64, Int64)) -> IO (Int64, Int64)
forall a b. (a -> b) -> a -> b
$ \CString
f' ->
    (Ptr CTime -> IO (Int64, Int64)) -> IO (Int64, Int64)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CTime -> IO (Int64, Int64)) -> IO (Int64, Int64))
-> (Ptr CTime -> IO (Int64, Int64)) -> IO (Int64, Int64)
forall a b. (a -> b) -> a -> b
$ \Ptr CTime
secPtr ->
    (Ptr CLong -> IO (Int64, Int64)) -> IO (Int64, Int64)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CLong -> IO (Int64, Int64)) -> IO (Int64, Int64))
-> (Ptr CLong -> IO (Int64, Int64)) -> IO (Int64, Int64)
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
nsecPtr -> do
        FilePath -> FilePath -> IO Int -> IO ()
forall a. (Eq a, Num a) => FilePath -> FilePath -> IO a -> IO ()
Posix.throwErrnoPathIfMinus1Retry_ FilePath
"getmodtime" FilePath
f (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ CString -> Ptr CTime -> Ptr CLong -> IO Int
c_getModTime CString
f' Ptr CTime
secPtr Ptr CLong
nsecPtr
        CTime Int64
sec <- Ptr CTime -> IO CTime
forall a. Storable a => Ptr a -> IO a
peek Ptr CTime
secPtr
        CLong Int64
nsec <- Ptr CLong -> IO CLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CLong
nsecPtr
        (Int64, Int64) -> IO (Int64, Int64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
sec, Int64
nsec)

-- Sadly even unix’s getFileStatus + modificationTimeHiRes is still about twice as slow
-- as doing the FFI call ourselves :(.
foreign import ccall "getmodtime" c_getModTime :: CString -> Ptr CTime -> Ptr CLong -> IO Int
#endif

modificationTime :: FileVersion -> Maybe UTCTime
modificationTime :: FileVersion -> Maybe UTCTime
modificationTime VFSVersion{} = Maybe UTCTime
forall a. Maybe a
Nothing
modificationTime (ModificationTime Int64
large Int64
small) = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> UTCTime
internalTimeToUTCTime Int64
large Int64
small

internalTimeToUTCTime :: Int64 -> Int64 -> UTCTime
internalTimeToUTCTime :: Int64 -> Int64 -> UTCTime
internalTimeToUTCTime Int64
large Int64
small =
#ifdef mingw32_HOST_OS
    UTCTime (ModifiedJulianDay $ fromIntegral large) (picosecondsToDiffTime $ fromIntegral small)
#else
    SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime) -> SystemTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32 -> SystemTime
MkSystemTime Int64
large (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
small)
#endif

getFileContentsRule :: VFSHandle -> Rules ()
getFileContentsRule :: VFSHandle -> Rules ()
getFileContentsRule VFSHandle
vfs = (GetFileContents
 -> NormalizedFilePath
 -> Action (IdeResult (FileVersion, Maybe Text)))
-> Rules ()
forall k v.
IdeRule k v =>
(k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((GetFileContents
  -> NormalizedFilePath
  -> Action (IdeResult (FileVersion, Maybe Text)))
 -> Rules ())
-> (GetFileContents
    -> NormalizedFilePath
    -> Action (IdeResult (FileVersion, Maybe Text)))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \GetFileContents
GetFileContents NormalizedFilePath
file -> VFSHandle
-> NormalizedFilePath
-> Action (IdeResult (FileVersion, Maybe Text))
getFileContentsImpl VFSHandle
vfs NormalizedFilePath
file

getFileContentsImpl
    :: VFSHandle
    -> NormalizedFilePath
    -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
getFileContentsImpl :: VFSHandle
-> NormalizedFilePath
-> Action (IdeResult (FileVersion, Maybe Text))
getFileContentsImpl VFSHandle
vfs NormalizedFilePath
file = do
    -- need to depend on modification time to introduce a dependency with Cutoff
    FileVersion
time <- GetModificationTime -> NormalizedFilePath -> Action FileVersion
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetModificationTime
GetModificationTime NormalizedFilePath
file
    Either FileDiagnostic (Maybe Text)
res <- IO (Either FileDiagnostic (Maybe Text))
-> Action (Either FileDiagnostic (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FileDiagnostic (Maybe Text))
 -> Action (Either FileDiagnostic (Maybe Text)))
-> IO (Either FileDiagnostic (Maybe Text))
-> Action (Either FileDiagnostic (Maybe Text))
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath
-> IO (Maybe Text) -> IO (Either FileDiagnostic (Maybe Text))
forall a.
NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
ideTryIOException NormalizedFilePath
file (IO (Maybe Text) -> IO (Either FileDiagnostic (Maybe Text)))
-> IO (Maybe Text) -> IO (Either FileDiagnostic (Maybe Text))
forall a b. (a -> b) -> a -> b
$ do
        Maybe VirtualFile
mbVirtual <- VFSHandle -> NormalizedUri -> IO (Maybe VirtualFile)
getVirtualFile VFSHandle
vfs (NormalizedUri -> IO (Maybe VirtualFile))
-> NormalizedUri -> IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
filePathToUri' NormalizedFilePath
file
        Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText (Rope -> Text) -> (VirtualFile -> Rope) -> VirtualFile -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VirtualFile -> Rope
_text (VirtualFile -> Text) -> Maybe VirtualFile -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VirtualFile
mbVirtual
    case Either FileDiagnostic (Maybe Text)
res of
        Left FileDiagnostic
err       -> IdeResult (FileVersion, Maybe Text)
-> Action (IdeResult (FileVersion, Maybe Text))
forall (m :: * -> *) a. Monad m => a -> m a
return ([FileDiagnostic
err], Maybe (FileVersion, Maybe Text)
forall a. Maybe a
Nothing)
        Right Maybe Text
contents -> IdeResult (FileVersion, Maybe Text)
-> Action (IdeResult (FileVersion, Maybe Text))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (FileVersion, Maybe Text) -> Maybe (FileVersion, Maybe Text)
forall a. a -> Maybe a
Just (FileVersion
time, Maybe Text
contents))

ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
ideTryIOException NormalizedFilePath
fp IO a
act =
  (IOException -> FileDiagnostic)
-> Either IOException a -> Either FileDiagnostic a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft
      (\(IOException
e :: IOException) -> NormalizedFilePath -> Text -> FileDiagnostic
ideErrorText NormalizedFilePath
fp (Text -> FileDiagnostic) -> Text -> FileDiagnostic
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
e)
      (Either IOException a -> Either FileDiagnostic a)
-> IO (Either IOException a) -> IO (Either FileDiagnostic a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
act

-- | Returns the modification time and the contents.
--   For VFS paths, the modification time is the current time.
getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe T.Text)
getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe Text)
getFileContents NormalizedFilePath
f = do
    (FileVersion
fv, Maybe Text
txt) <- GetFileContents
-> NormalizedFilePath -> Action (FileVersion, Maybe Text)
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ GetFileContents
GetFileContents NormalizedFilePath
f
    UTCTime
modTime <- case FileVersion -> Maybe UTCTime
modificationTime FileVersion
fv of
      Just UTCTime
t -> UTCTime -> Action UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
t
      Maybe UTCTime
Nothing -> do
        IsFileOfInterestResult
foi <- IsFileOfInterest
-> NormalizedFilePath -> Action IsFileOfInterestResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ IsFileOfInterest
IsFileOfInterest NormalizedFilePath
f
        IO UTCTime -> Action UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> Action UTCTime) -> IO UTCTime -> Action UTCTime
forall a b. (a -> b) -> a -> b
$ case IsFileOfInterestResult
foi of
          IsFOI Modified{} -> IO UTCTime
getCurrentTime
          IsFileOfInterestResult
_ -> do
            (Int64
large,Int64
small) <- FilePath -> IO (Int64, Int64)
getModTime (FilePath -> IO (Int64, Int64)) -> FilePath -> IO (Int64, Int64)
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f
            UTCTime -> IO UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> IO UTCTime) -> UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> UTCTime
internalTimeToUTCTime Int64
large Int64
small
    (UTCTime, Maybe Text) -> Action (UTCTime, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
modTime, Maybe Text
txt)

fileStoreRules :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules VFSHandle
vfs NormalizedFilePath -> Action Bool
isWatched = do
    VFSHandle -> Rules ()
forall a. IsIdeGlobal a => a -> Rules ()
addIdeGlobal VFSHandle
vfs
    VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
getModificationTimeRule VFSHandle
vfs NormalizedFilePath -> Action Bool
isWatched
    VFSHandle -> Rules ()
getFileContentsRule VFSHandle
vfs
    Rules ()
isFileOfInterestRule

-- | Note that some buffer for a specific file has been modified but not
-- with what changes.
setFileModified :: IdeState
                -> Bool -- ^ Was the file saved?
                -> NormalizedFilePath
                -> IO ()
setFileModified :: IdeState -> Bool -> NormalizedFilePath -> IO ()
setFileModified IdeState
state Bool
saved NormalizedFilePath
nfp = do
    IdeOptions
ideOptions <- ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state
    CheckParents
doCheckParents <- IdeOptions -> IO CheckParents
optCheckParents IdeOptions
ideOptions
    let checkParents :: Bool
checkParents = case CheckParents
doCheckParents of
          CheckParents
AlwaysCheck         -> Bool
True
          CheckParents
CheckOnSaveAndClose -> Bool
saved
          CheckParents
_                   -> Bool
False
    VFSHandle{Maybe (NormalizedUri -> Maybe Text -> IO ())
NormalizedUri -> IO (Maybe VirtualFile)
setVirtualFileContents :: Maybe (NormalizedUri -> Maybe Text -> IO ())
getVirtualFile :: NormalizedUri -> IO (Maybe VirtualFile)
setVirtualFileContents :: VFSHandle -> Maybe (NormalizedUri -> Maybe Text -> IO ())
getVirtualFile :: VFSHandle -> NormalizedUri -> IO (Maybe VirtualFile)
..} <- IdeState -> IO VFSHandle
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (NormalizedUri -> Maybe Text -> IO ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NormalizedUri -> Maybe Text -> IO ())
setVirtualFileContents) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"setFileModified can't be called on this type of VFSHandle"
    IdeState -> [DelayedAction ()] -> IO ()
shakeRestart IdeState
state []
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkParents (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IdeState -> NormalizedFilePath -> IO ()
typecheckParents IdeState
state NormalizedFilePath
nfp

typecheckParents :: IdeState -> NormalizedFilePath -> IO ()
typecheckParents :: IdeState -> NormalizedFilePath -> IO ()
typecheckParents IdeState
state NormalizedFilePath
nfp = IO (IO ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> DelayedAction () -> IO (IO ())
forall a. ShakeExtras -> DelayedAction a -> IO (IO a)
shakeEnqueue (IdeState -> ShakeExtras
shakeExtras IdeState
state) DelayedAction ()
parents
  where parents :: DelayedAction ()
parents = FilePath -> Priority -> Action () -> DelayedAction ()
forall a. FilePath -> Priority -> Action a -> DelayedAction a
mkDelayedAction FilePath
"ParentTC" Priority
L.Debug (NormalizedFilePath -> Action ()
typecheckParentsAction NormalizedFilePath
nfp)

typecheckParentsAction :: NormalizedFilePath -> Action ()
typecheckParentsAction :: NormalizedFilePath -> Action ()
typecheckParentsAction NormalizedFilePath
nfp = do
    Maybe [NormalizedFilePath]
revs <- NormalizedFilePath
-> DependencyInformation -> Maybe [NormalizedFilePath]
transitiveReverseDependencies NormalizedFilePath
nfp (DependencyInformation -> Maybe [NormalizedFilePath])
-> Action DependencyInformation
-> Action (Maybe [NormalizedFilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetModuleGraph -> Action DependencyInformation
forall k v. IdeRule k v => k -> Action v
useNoFile_ GetModuleGraph
GetModuleGraph
    Logger
logger <- ShakeExtras -> Logger
logger (ShakeExtras -> Logger) -> Action ShakeExtras -> Action Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action ShakeExtras
getShakeExtras
    let log :: FilePath -> IO ()
log = Logger -> Text -> IO ()
L.logInfo Logger
logger (Text -> IO ()) -> (FilePath -> Text) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
    case Maybe [NormalizedFilePath]
revs of
      Maybe [NormalizedFilePath]
Nothing -> IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
log (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not identify reverse dependencies for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> FilePath
forall a. Show a => a -> FilePath
show NormalizedFilePath
nfp
      Just [NormalizedFilePath]
rs -> do
        IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO ()
log (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Typechecking reverse dependencies for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ NormalizedFilePath -> FilePath
forall a. Show a => a -> FilePath
show NormalizedFilePath
nfp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Maybe [NormalizedFilePath] -> FilePath
forall a. Show a => a -> FilePath
show Maybe [NormalizedFilePath]
revs)
          IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
e :: SomeException) -> FilePath -> IO ()
log (SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
e)
        () () -> Action [Maybe HiFileResult] -> Action ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ GetModIface -> [NormalizedFilePath] -> Action [Maybe HiFileResult]
forall k v.
IdeRule k v =>
k -> [NormalizedFilePath] -> Action [Maybe v]
uses GetModIface
GetModIface [NormalizedFilePath]
rs

-- | Note that some buffer somewhere has been modified, but don't say what.
--   Only valid if the virtual file system was initialised by LSP, as that
--   independently tracks which files are modified.
setSomethingModified :: IdeState -> IO ()
setSomethingModified :: IdeState -> IO ()
setSomethingModified IdeState
state = do
    VFSHandle{Maybe (NormalizedUri -> Maybe Text -> IO ())
NormalizedUri -> IO (Maybe VirtualFile)
setVirtualFileContents :: Maybe (NormalizedUri -> Maybe Text -> IO ())
getVirtualFile :: NormalizedUri -> IO (Maybe VirtualFile)
setVirtualFileContents :: VFSHandle -> Maybe (NormalizedUri -> Maybe Text -> IO ())
getVirtualFile :: VFSHandle -> NormalizedUri -> IO (Maybe VirtualFile)
..} <- IdeState -> IO VFSHandle
forall a. IsIdeGlobal a => IdeState -> IO a
getIdeGlobalState IdeState
state
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (NormalizedUri -> Maybe Text -> IO ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NormalizedUri -> Maybe Text -> IO ())
setVirtualFileContents) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"setSomethingModified can't be called on this type of VFSHandle"
    -- Update database to remove any files that might have been renamed/deleted
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue (HieDb -> IO ()) -> (HieDb -> IO ()) -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue (HieDbWriter -> TQueue (HieDb -> IO ())
indexQueue (HieDbWriter -> TQueue (HieDb -> IO ()))
-> HieDbWriter -> TQueue (HieDb -> IO ())
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> HieDbWriter
hiedbWriter (ShakeExtras -> HieDbWriter) -> ShakeExtras -> HieDbWriter
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state) HieDb -> IO ()
deleteMissingRealFiles
    IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IdeState -> [DelayedAction ()] -> IO ()
shakeRestart IdeState
state []