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

module Development.IDE.Core.FileStore(
    getFileContents,
    setFileModified,
    setSomethingModified,
    fileStoreRules,
    modificationTime,
    typecheckParents,
    resetFileStore,
    resetInterfaceStore,
    getModificationTimeImpl,
    addIdeGlobal,
    getFileContentsImpl,
    getModTime,
    isWatchSupported,
    registerFileWatches,
    shareFilePath,
    Log(..)
    ) where

import           Control.Concurrent.STM.Stats                 (STM, atomically,
                                                               modifyTVar')
import           Control.Concurrent.STM.TQueue                (writeTQueue)
import           Control.Exception
import           Control.Monad.Extra
import           Control.Monad.IO.Class
import qualified Data.Binary                                  as B
import qualified Data.ByteString                              as BS
import qualified Data.ByteString.Lazy                         as LBS
import qualified Data.HashMap.Strict                          as HashMap
import           Data.IORef
import           Data.List                                    (foldl')
import qualified Data.Text                                    as T
import qualified Data.Text                                    as Text
import qualified Data.Text.Utf16.Rope                         as Rope
import           Data.Time
import           Data.Time.Clock.POSIX
import           Development.IDE.Core.FileUtils
import           Development.IDE.Core.IdeConfiguration        (isWorkspaceFile)
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Shake                   hiding (Log)
import qualified Development.IDE.Core.Shake                   as Shake
import           Development.IDE.GHC.Orphans                  ()
import           Development.IDE.Graph
import           Development.IDE.Import.DependencyInformation
import           Development.IDE.Types.Diagnostics
import           Development.IDE.Types.Location
import           Development.IDE.Types.Options
import           HieDb.Create                                 (deleteMissingRealFiles)
import           Ide.Logger                                   (Pretty (pretty),
                                                               Priority (Info),
                                                               Recorder,
                                                               WithPriority,
                                                               cmapWithPrio,
                                                               logWith, viaShow,
                                                               (<+>))
import qualified Ide.Logger                                   as L
import           Ide.Plugin.Config                            (CheckParents (..),
                                                               Config)
import           Language.LSP.Protocol.Message                (toUntypedRegistration)
import qualified Language.LSP.Protocol.Message                as LSP
import           Language.LSP.Protocol.Types                  (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions),
                                                               FileSystemWatcher (..),
                                                               _watchers)
import qualified Language.LSP.Protocol.Types                  as LSP
import qualified Language.LSP.Server                          as LSP
import           Language.LSP.VFS
import           System.FilePath
import           System.IO.Error
import           System.IO.Unsafe


data Log
  = LogCouldNotIdentifyReverseDeps !NormalizedFilePath
  | LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath])
  | LogShake Shake.Log
  deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> FilePath
(Int -> Log -> ShowS)
-> (Log -> FilePath) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> FilePath
show :: Log -> FilePath
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogCouldNotIdentifyReverseDeps NormalizedFilePath
path ->
      Doc ann
"Could not identify reverse dependencies for" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedFilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow NormalizedFilePath
path
    (LogTypeCheckingReverseDeps NormalizedFilePath
path Maybe [NormalizedFilePath]
reverseDepPaths) ->
      Doc ann
"Typechecking reverse dependencies for"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedFilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow NormalizedFilePath
path
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe [FilePath] -> Doc ann
forall ann. Maybe [FilePath] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (([NormalizedFilePath] -> [FilePath])
-> Maybe [NormalizedFilePath] -> Maybe [FilePath]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NormalizedFilePath -> FilePath)
-> [NormalizedFilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NormalizedFilePath -> FilePath
forall a. Show a => a -> FilePath
show) Maybe [NormalizedFilePath]
reverseDepPaths)
    LogShake Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg

addWatchedFileRule :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
addWatchedFileRule :: Recorder (WithPriority Log)
-> (NormalizedFilePath -> Action Bool) -> Rules ()
addWatchedFileRule Recorder (WithPriority Log)
recorder NormalizedFilePath -> Action Bool
isWatched = Recorder (WithPriority Log)
-> (AddWatchedFile -> NormalizedFilePath -> Action (Maybe Bool))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()
defineNoDiagnostics ((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) ((AddWatchedFile -> NormalizedFilePath -> Action (Maybe Bool))
 -> Rules ())
-> (AddWatchedFile -> NormalizedFilePath -> Action (Maybe Bool))
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \AddWatchedFile
AddWatchedFile NormalizedFilePath
f -> do
  Bool
isAlreadyWatched <- NormalizedFilePath -> Action Bool
isWatched NormalizedFilePath
f
  Bool
isWp <- NormalizedFilePath -> Action Bool
isWorkspaceFile NormalizedFilePath
f
  if Bool
isAlreadyWatched then Maybe Bool -> Action (Maybe Bool)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) else
    if Bool -> Bool
not Bool
isWp then Maybe Bool -> Action (Maybe Bool)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) else do
        ShakeExtras{Maybe (LanguageContextEnv Config)
lspEnv :: Maybe (LanguageContextEnv Config)
$sel:lspEnv:ShakeExtras :: ShakeExtras -> Maybe (LanguageContextEnv Config)
lspEnv} <- Action ShakeExtras
getShakeExtras
        case Maybe (LanguageContextEnv Config)
lspEnv of
            Just LanguageContextEnv Config
env -> (Bool -> Maybe Bool) -> Action Bool -> Action (Maybe Bool)
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Action Bool -> Action (Maybe Bool))
-> Action Bool -> Action (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ 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
$ LanguageContextEnv Config -> LspT Config IO Bool -> IO Bool
forall config (m :: * -> *) a.
LanguageContextEnv config -> LspT config m a -> m a
LSP.runLspT LanguageContextEnv Config
env (LspT Config IO Bool -> IO Bool) -> LspT Config IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
                [FilePath] -> LspT Config IO Bool
registerFileWatches [NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f]
            Maybe (LanguageContextEnv Config)
Nothing -> Maybe Bool -> Action (Maybe Bool)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> Action (Maybe Bool))
-> Maybe Bool -> Action (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False


getModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()
getModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()
getModificationTimeRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> RuleBody GetModificationTime FileVersion -> 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 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 ->
    Bool
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult FileVersion)
getModificationTimeImpl Bool
missingFileDiags NormalizedFilePath
file

getModificationTimeImpl
  :: Bool
  -> NormalizedFilePath
  -> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
getModificationTimeImpl :: Bool
-> NormalizedFilePath
-> Action (Maybe ByteString, IdeResult FileVersion)
getModificationTimeImpl Bool
missingFileDiags NormalizedFilePath
file = do
    let file' :: FilePath
file' = NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
file
    let wrap :: POSIXTime -> (Maybe ByteString, ([a], Maybe FileVersion))
wrap POSIXTime
time = (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
$ Rational -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Rational -> ByteString) -> Rational -> ByteString
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational POSIXTime
time, ([], FileVersion -> Maybe FileVersion
forall a. a -> Maybe a
Just (FileVersion -> Maybe FileVersion)
-> FileVersion -> Maybe FileVersion
forall a b. (a -> b) -> a -> b
$ POSIXTime -> FileVersion
ModificationTime POSIXTime
time))
    Maybe VirtualFile
mbVf <- NormalizedFilePath -> Action (Maybe VirtualFile)
getVirtualFile NormalizedFilePath
file
    case Maybe VirtualFile
mbVf of
        Just (VirtualFile -> Int32
virtualFileVersion -> Int32
ver) -> do
            Action ()
alwaysRerun
            (Maybe ByteString, IdeResult FileVersion)
-> Action (Maybe ByteString, IdeResult FileVersion)
forall a. a -> Action a
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
$ Int32 -> ByteString
forall a. Binary a => a -> ByteString
B.encode Int32
ver, ([], FileVersion -> Maybe FileVersion
forall a. a -> Maybe a
Just (FileVersion -> Maybe FileVersion)
-> FileVersion -> Maybe FileVersion
forall a b. (a -> b) -> a -> b
$ Int32 -> FileVersion
VFSVersion Int32
ver))
        Maybe VirtualFile
Nothing -> do
            Bool
isWF <- AddWatchedFile -> NormalizedFilePath -> Action Bool
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ AddWatchedFile
AddWatchedFile NormalizedFilePath
file
            if Bool
isWF
                then -- the file is watched so we can rely on FileWatched notifications,
                        -- but also need a dependency on IsFileOfInterest to reinstall
                        -- alwaysRerun when the file becomes VFS
                    Action IsFileOfInterestResult -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IsFileOfInterest
-> NormalizedFilePath -> Action IsFileOfInterestResult
forall k v. IdeRule k v => k -> NormalizedFilePath -> Action v
use_ IsFileOfInterest
IsFileOfInterest NormalizedFilePath
file)
                else if NormalizedFilePath -> Bool
isInterface NormalizedFilePath
file
                    then -- interface files are tracked specially using the closed world assumption
                        () -> Action ()
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    else -- in all other cases we will need to freshly check the file system
                        Action ()
alwaysRerun

            IO (Maybe ByteString, IdeResult FileVersion)
-> Action (Maybe ByteString, IdeResult FileVersion)
forall a. IO a -> Action a
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
$ (POSIXTime -> (Maybe ByteString, IdeResult FileVersion))
-> IO POSIXTime -> IO (Maybe ByteString, IdeResult FileVersion)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap POSIXTime -> (Maybe ByteString, IdeResult FileVersion)
forall {a}.
POSIXTime -> (Maybe ByteString, ([a], Maybe FileVersion))
wrap (FilePath -> IO POSIXTime
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 -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
file'
                            | Bool
otherwise = FilePath
"IO error while reading " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
file' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", " FilePath -> ShowS
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 a. a -> IO a
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 a. a -> IO a
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 = ShowS
takeExtension (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f) FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
".hi", FilePath
".hi-boot", FilePath
".hie", FilePath
".hie-boot", FilePath
".core"]

-- | Reset the GetModificationTime state of interface files
resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM ()
resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM ()
resetInterfaceStore ShakeExtras
state NormalizedFilePath
f = do
    ShakeExtras -> GetModificationTime -> NormalizedFilePath -> STM ()
forall k.
ShakeValue k =>
ShakeExtras -> k -> NormalizedFilePath -> STM ()
deleteValue ShakeExtras
state GetModificationTime
GetModificationTime NormalizedFilePath
f

-- | Reset the GetModificationTime state of watched files
--   Assumes the list does not include any FOIs
resetFileStore :: IdeState -> [(NormalizedFilePath, LSP.FileChangeType)] -> IO ()
resetFileStore :: IdeState -> [(NormalizedFilePath, FileChangeType)] -> IO ()
resetFileStore IdeState
ideState [(NormalizedFilePath, FileChangeType)]
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
_ -> do
    -- we record FOIs document versions in all the stored values
    -- so NEVER reset FOIs to avoid losing their versions
    -- FOI filtering is done by the caller (LSP Notification handler)
    [(NormalizedFilePath, FileChangeType)]
-> ((NormalizedFilePath, FileChangeType) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(NormalizedFilePath, FileChangeType)]
changes (((NormalizedFilePath, FileChangeType) -> IO ()) -> IO ())
-> ((NormalizedFilePath, FileChangeType) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(NormalizedFilePath
nfp, FileChangeType
c) -> do
        case FileChangeType
c of
            FileChangeType
LSP.FileChangeType_Changed
            --  already checked elsewhere |  not $ HM.member nfp fois
              -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
               ShakeExtras -> GetModificationTime -> NormalizedFilePath -> STM ()
forall k.
ShakeValue k =>
ShakeExtras -> k -> NormalizedFilePath -> STM ()
deleteValue (IdeState -> ShakeExtras
shakeExtras IdeState
ideState) GetModificationTime
GetModificationTime NormalizedFilePath
nfp
            FileChangeType
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


modificationTime :: FileVersion -> Maybe UTCTime
modificationTime :: FileVersion -> Maybe UTCTime
modificationTime VFSVersion{}             = Maybe UTCTime
forall a. Maybe a
Nothing
modificationTime (ModificationTime POSIXTime
posix) = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
posix

getFileContentsRule :: Recorder (WithPriority Log) -> Rules ()
getFileContentsRule :: Recorder (WithPriority Log) -> Rules ()
getFileContentsRule Recorder (WithPriority Log)
recorder = Recorder (WithPriority Log)
-> (GetFileContents
    -> NormalizedFilePath
    -> Action (IdeResult (FileVersion, Maybe Text)))
-> Rules ()
forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define ((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) ((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 -> NormalizedFilePath -> Action (IdeResult (FileVersion, Maybe Text))
getFileContentsImpl NormalizedFilePath
file

getFileContentsImpl
    :: NormalizedFilePath
    -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
getFileContentsImpl :: NormalizedFilePath -> Action (IdeResult (FileVersion, Maybe Text))
getFileContentsImpl 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
    Maybe Text
res <- do
        Maybe VirtualFile
mbVirtual <- NormalizedFilePath -> Action (Maybe VirtualFile)
getVirtualFile NormalizedFilePath
file
        Maybe Text -> Action (Maybe Text)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Action (Maybe Text))
-> Maybe Text -> Action (Maybe Text)
forall a b. (a -> b) -> a -> b
$ VirtualFile -> Text
virtualFileText (VirtualFile -> Text) -> Maybe VirtualFile -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe VirtualFile
mbVirtual
    IdeResult (FileVersion, Maybe Text)
-> Action (IdeResult (FileVersion, Maybe Text))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], (FileVersion, Maybe Text) -> Maybe (FileVersion, Maybe Text)
forall a. a -> Maybe a
Just (FileVersion
time, Maybe Text
res))

-- | 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 a. a -> Action a
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 a. IO a -> Action a
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
            POSIXTime
posix <- FilePath -> IO POSIXTime
getModTime (FilePath -> IO POSIXTime) -> FilePath -> IO POSIXTime
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
f
            UTCTime -> IO UTCTime
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> IO UTCTime) -> UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
posix
    (UTCTime, Maybe Text) -> Action (UTCTime, Maybe Text)
forall a. a -> Action a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
modTime, Maybe Text
txt)

fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules :: Recorder (WithPriority Log)
-> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules Recorder (WithPriority Log)
recorder NormalizedFilePath -> Action Bool
isWatched = do
    Recorder (WithPriority Log) -> Rules ()
getModificationTimeRule Recorder (WithPriority Log)
recorder
    Recorder (WithPriority Log) -> Rules ()
getFileContentsRule Recorder (WithPriority Log)
recorder
    Recorder (WithPriority Log)
-> (NormalizedFilePath -> Action Bool) -> Rules ()
addWatchedFileRule Recorder (WithPriority Log)
recorder NormalizedFilePath -> Action Bool
isWatched

-- | Note that some buffer for a specific file has been modified but not
-- with what changes.
setFileModified :: Recorder (WithPriority Log)
                -> VFSModified
                -> IdeState
                -> Bool -- ^ Was the file saved?
                -> NormalizedFilePath
                -> IO ()
setFileModified :: Recorder (WithPriority Log)
-> VFSModified -> IdeState -> Bool -> NormalizedFilePath -> IO ()
setFileModified Recorder (WithPriority Log)
recorder VFSModified
vfs 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
CheckOnSave -> Bool
saved
          CheckParents
_           -> Bool
False
    IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ STM (IO ()) -> IO (IO ())
forall a. STM a -> IO a
atomically (STM (IO ()) -> IO (IO ())) -> STM (IO ()) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ ShakeExtras
-> GetModificationTime -> [NormalizedFilePath] -> STM (IO ())
forall k.
ShakeValue k =>
ShakeExtras -> k -> [NormalizedFilePath] -> STM (IO ())
recordDirtyKeys (IdeState -> ShakeExtras
shakeExtras IdeState
state) GetModificationTime
GetModificationTime [NormalizedFilePath
nfp]
    ShakeExtras
-> VFSModified -> FilePath -> [DelayedAction ()] -> IO ()
restartShakeSession (IdeState -> ShakeExtras
shakeExtras IdeState
state) VFSModified
vfs (NormalizedFilePath -> FilePath
fromNormalizedFilePath NormalizedFilePath
nfp FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" (modified)") []
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
checkParents (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> IO ()
typecheckParents Recorder (WithPriority Log)
recorder IdeState
state NormalizedFilePath
nfp

typecheckParents :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO ()
typecheckParents :: Recorder (WithPriority Log)
-> IdeState -> NormalizedFilePath -> IO ()
typecheckParents Recorder (WithPriority Log)
recorder 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 (Recorder (WithPriority Log) -> NormalizedFilePath -> Action ()
typecheckParentsAction Recorder (WithPriority Log)
recorder NormalizedFilePath
nfp)

typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action ()
typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action ()
typecheckParentsAction Recorder (WithPriority Log)
recorder 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
    case Maybe [NormalizedFilePath]
revs of
      Maybe [NormalizedFilePath]
Nothing -> Recorder (WithPriority Log) -> Priority -> Log -> Action ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Info (Log -> Action ()) -> Log -> Action ()
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Log
LogCouldNotIdentifyReverseDeps NormalizedFilePath
nfp
      Just [NormalizedFilePath]
rs -> do
        Recorder (WithPriority Log) -> Priority -> Log -> Action ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Info (Log -> Action ()) -> Log -> Action ()
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Maybe [NormalizedFilePath] -> Log
LogTypeCheckingReverseDeps NormalizedFilePath
nfp Maybe [NormalizedFilePath]
revs
        Action [Maybe HiFileResult] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [Maybe HiFileResult] -> Action ())
-> Action [Maybe HiFileResult] -> Action ()
forall a b. (a -> b) -> a -> b
$ GetModIface -> [NormalizedFilePath] -> Action [Maybe HiFileResult]
forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k -> f NormalizedFilePath -> Action (f (Maybe v))
uses GetModIface
GetModIface [NormalizedFilePath]
rs

-- | Note that some keys have been modified and restart the session
--   Only valid if the virtual file system was initialised by LSP, as that
--   independently tracks which files are modified.
setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO ()
setSomethingModified :: VFSModified -> IdeState -> [Key] -> FilePath -> IO ()
setSomethingModified VFSModified
vfs IdeState
state [Key]
keys FilePath
reason = do
    -- 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
$ do
        TQueue (((HieDb -> IO ()) -> IO ()) -> IO ())
-> (((HieDb -> IO ()) -> IO ()) -> IO ()) -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue (HieDbWriter -> TQueue (((HieDb -> IO ()) -> IO ()) -> IO ())
indexQueue (HieDbWriter -> TQueue (((HieDb -> IO ()) -> IO ()) -> IO ()))
-> HieDbWriter -> TQueue (((HieDb -> IO ()) -> IO ()) -> 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 ()) -> IO ()
withHieDb -> (HieDb -> IO ()) -> IO ()
withHieDb HieDb -> IO ()
deleteMissingRealFiles)
        TVar KeySet -> (KeySet -> KeySet) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (ShakeExtras -> TVar KeySet
dirtyKeys (ShakeExtras -> TVar KeySet) -> ShakeExtras -> TVar KeySet
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
state) ((KeySet -> KeySet) -> STM ()) -> (KeySet -> KeySet) -> STM ()
forall a b. (a -> b) -> a -> b
$ \KeySet
x ->
            (KeySet -> Key -> KeySet) -> KeySet -> [Key] -> KeySet
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Key -> KeySet -> KeySet) -> KeySet -> Key -> KeySet
forall a b c. (a -> b -> c) -> b -> a -> c
flip Key -> KeySet -> KeySet
insertKeySet) KeySet
x [Key]
keys
    IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ShakeExtras
-> VFSModified -> FilePath -> [DelayedAction ()] -> IO ()
restartShakeSession (IdeState -> ShakeExtras
shakeExtras IdeState
state) VFSModified
vfs FilePath
reason []

registerFileWatches :: [String] -> LSP.LspT Config IO Bool
registerFileWatches :: [FilePath] -> LspT Config IO Bool
registerFileWatches [FilePath]
globs = do
      Bool
watchSupported <- LspT Config IO Bool
isWatchSupported
      if Bool
watchSupported
      then do
        let
          regParams :: RegistrationParams
regParams    = [Registration] -> RegistrationParams
LSP.RegistrationParams  [TRegistration 'Method_WorkspaceDidChangeWatchedFiles
-> Registration
forall {t :: MessageKind} (m :: Method 'ClientToServer t).
TRegistration m -> Registration
toUntypedRegistration TRegistration 'Method_WorkspaceDidChangeWatchedFiles
registration]
          -- The registration ID is arbitrary and is only used in case we want to deregister (which we won't).
          -- We could also use something like a random UUID, as some other servers do, but this works for
          -- our purposes.
          registration :: TRegistration 'Method_WorkspaceDidChangeWatchedFiles
registration = LSP.TRegistration { $sel:_id:TRegistration :: Text
_id =Text
"globalFileWatches"
                                           , $sel:_method:TRegistration :: SClientMethod 'Method_WorkspaceDidChangeWatchedFiles
_method = SClientMethod 'Method_WorkspaceDidChangeWatchedFiles
LSP.SMethod_WorkspaceDidChangeWatchedFiles
                                           , $sel:_registerOptions:TRegistration :: Maybe (RegistrationOptions 'Method_WorkspaceDidChangeWatchedFiles)
_registerOptions = DidChangeWatchedFilesRegistrationOptions
-> Maybe DidChangeWatchedFilesRegistrationOptions
forall a. a -> Maybe a
Just DidChangeWatchedFilesRegistrationOptions
regOptions}
          regOptions :: DidChangeWatchedFilesRegistrationOptions
regOptions =
            DidChangeWatchedFilesRegistrationOptions { $sel:_watchers:DidChangeWatchedFilesRegistrationOptions :: [FileSystemWatcher]
_watchers = [FileSystemWatcher]
watchers }
          -- See Note [File existence cache and LSP file watchers] for why this exists, and the choice of watch kind
          -- WatchKind_Custom 7 is for create, change, and delete
          watchKind :: WatchKind
watchKind = UInt -> WatchKind
LSP.WatchKind_Custom UInt
7
          -- See Note [Which files should we watch?] for an explanation of why the pattern is the way that it is
          -- The patterns will be something like "**/.hs", i.e. "any number of directory segments,
          -- followed by a file with an extension 'hs'.
          watcher :: GlobPattern -> FileSystemWatcher
watcher GlobPattern
glob = FileSystemWatcher { $sel:_globPattern:FileSystemWatcher :: GlobPattern
_globPattern = GlobPattern
glob, $sel:_kind:FileSystemWatcher :: Maybe WatchKind
_kind = WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
watchKind }
          -- We use multiple watchers instead of one using '{}' because lsp-test doesn't
          -- support that: https://github.com/bubba/lsp-test/issues/77
          watchers :: [FileSystemWatcher]
watchers = [ GlobPattern -> FileSystemWatcher
watcher ((Pattern |? RelativePattern) -> GlobPattern
LSP.GlobPattern (Pattern -> Pattern |? RelativePattern
forall a b. a -> a |? b
LSP.InL (Text -> Pattern
LSP.Pattern (FilePath -> Text
Text.pack FilePath
glob)))) | FilePath
glob <- [FilePath]
globs ]

        LspT Config IO (LspId 'Method_ClientRegisterCapability)
-> LspT Config IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LspT Config IO (LspId 'Method_ClientRegisterCapability)
 -> LspT Config IO ())
-> LspT Config IO (LspId 'Method_ClientRegisterCapability)
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'Method_ClientRegisterCapability
-> MessageParams 'Method_ClientRegisterCapability
-> (Either
      ResponseError (MessageResult 'Method_ClientRegisterCapability)
    -> LspT Config IO ())
-> LspT Config IO (LspId 'Method_ClientRegisterCapability)
forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'Method_ClientRegisterCapability
LSP.SMethod_ClientRegisterCapability RegistrationParams
MessageParams 'Method_ClientRegisterCapability
regParams (LspT Config IO ()
-> Either
     ResponseError (MessageResult 'Method_ClientRegisterCapability)
-> LspT Config IO ()
forall a b. a -> b -> a
const (LspT Config IO ()
 -> Either
      ResponseError (MessageResult 'Method_ClientRegisterCapability)
 -> LspT Config IO ())
-> LspT Config IO ()
-> Either
     ResponseError (MessageResult 'Method_ClientRegisterCapability)
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ () -> LspT Config IO ()
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) -- TODO handle response
        Bool -> LspT Config IO Bool
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      else Bool -> LspT Config IO Bool
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

isWatchSupported :: LSP.LspT Config IO Bool
isWatchSupported :: LspT Config IO Bool
isWatchSupported = do
      ClientCapabilities
clientCapabilities <- LspT Config IO ClientCapabilities
forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
LSP.getClientCapabilities
      Bool -> LspT Config IO Bool
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> LspT Config IO Bool) -> Bool -> LspT Config IO Bool
forall a b. (a -> b) -> a -> b
$ case () of
            ()
_ | LSP.ClientCapabilities{Maybe WorkspaceClientCapabilities
_workspace :: Maybe WorkspaceClientCapabilities
$sel:_workspace:ClientCapabilities :: ClientCapabilities -> Maybe WorkspaceClientCapabilities
_workspace} <- ClientCapabilities
clientCapabilities
              , Just LSP.WorkspaceClientCapabilities{Maybe DidChangeWatchedFilesClientCapabilities
_didChangeWatchedFiles :: Maybe DidChangeWatchedFilesClientCapabilities
$sel:_didChangeWatchedFiles:WorkspaceClientCapabilities :: WorkspaceClientCapabilities
-> Maybe DidChangeWatchedFilesClientCapabilities
_didChangeWatchedFiles} <- Maybe WorkspaceClientCapabilities
_workspace
              , Just LSP.DidChangeWatchedFilesClientCapabilities{Maybe Bool
_dynamicRegistration :: Maybe Bool
$sel:_dynamicRegistration:DidChangeWatchedFilesClientCapabilities :: DidChangeWatchedFilesClientCapabilities -> Maybe Bool
_dynamicRegistration} <- Maybe DidChangeWatchedFilesClientCapabilities
_didChangeWatchedFiles
              , Just Bool
True <- Maybe Bool
_dynamicRegistration
                -> Bool
True
              | Bool
otherwise -> Bool
False

filePathMap :: IORef (HashMap.HashMap FilePath FilePath)
filePathMap :: IORef (HashMap FilePath FilePath)
filePathMap = IO (IORef (HashMap FilePath FilePath))
-> IORef (HashMap FilePath FilePath)
forall a. IO a -> a
unsafePerformIO (IO (IORef (HashMap FilePath FilePath))
 -> IORef (HashMap FilePath FilePath))
-> IO (IORef (HashMap FilePath FilePath))
-> IORef (HashMap FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ HashMap FilePath FilePath -> IO (IORef (HashMap FilePath FilePath))
forall a. a -> IO (IORef a)
newIORef HashMap FilePath FilePath
forall k v. HashMap k v
HashMap.empty
{-# NOINLINE filePathMap #-}

shareFilePath :: FilePath -> FilePath
shareFilePath :: ShowS
shareFilePath FilePath
k = IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ do
  IORef (HashMap FilePath FilePath)
-> (HashMap FilePath FilePath
    -> (HashMap FilePath FilePath, FilePath))
-> IO FilePath
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (HashMap FilePath FilePath)
filePathMap ((HashMap FilePath FilePath
  -> (HashMap FilePath FilePath, FilePath))
 -> IO FilePath)
-> (HashMap FilePath FilePath
    -> (HashMap FilePath FilePath, FilePath))
-> IO FilePath
forall a b. (a -> b) -> a -> b
$ \HashMap FilePath FilePath
km ->
    let new_key :: Maybe FilePath
new_key = FilePath -> HashMap FilePath FilePath -> Maybe FilePath
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup FilePath
k HashMap FilePath FilePath
km
    in case Maybe FilePath
new_key of
          Just FilePath
v  -> (HashMap FilePath FilePath
km, FilePath
v)
          Maybe FilePath
Nothing -> (FilePath
-> FilePath
-> HashMap FilePath FilePath
-> HashMap FilePath FilePath
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert FilePath
k FilePath
k HashMap FilePath FilePath
km, FilePath
k)
{-# NOINLINE shareFilePath  #-}