git.iko.soy/ghcide
on master help sign in
print modtime
dde3c50Moritz Kiefer
src/Development/IDE/Core/Compile.hs+2
compare with master
unifiedsplit
@@ -68,6 +68,7 @@ import Data.Maybe
68import Data.Tuple.Extra
68import Data.Tuple.Extra
69import qualified Data.Map.Strict as Map
69import qualified Data.Map.Strict as Map
70import System.FilePath
70import System.FilePath
71+import System.IO
71
72
72
73
73-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
74-- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
@@ -81,6 +82,7 @@ parseModule IdeOptions{..} env filename mbContents =
81 fmap (either (, Nothing) id) $
82 fmap (either (, Nothing) id) $
82 runGhcEnv env $ runExceptT $ do
83 runGhcEnv env $ runExceptT $ do
83 (contents, dflags) <- preprocessor filename mbContents
84 (contents, dflags) <- preprocessor filename mbContents
85+ liftIO $ hPutStrLn stderr (show $ lexemeToString contents (len contents))
84 (diag, modu) <- parseFileContents optPreprocessor dflags filename contents
86 (diag, modu) <- parseFileContents optPreprocessor dflags filename contents
85 return (diag, Just (contents, modu))
87 return (diag, Just (contents, modu))
86
88
src/Development/IDE/Core/FileStore.hs+6−2
@@ -14,6 +14,7 @@ module Development.IDE.Core.FileStore(
14 makeLSPVFSHandle
14 makeLSPVFSHandle
15 ) where
15 ) where
16
16
17+import System.IO
17import Development.IDE.GHC.Orphans()
18import Development.IDE.GHC.Orphans()
18import Development.IDE.Core.Shake
19import Development.IDE.Core.Shake
19import Control.Concurrent.Extra
20import Control.Concurrent.Extra
@@ -95,13 +96,15 @@ getModificationTimeRule :: VFSHandle -> Rules ()
95getModificationTimeRule vfs =
96getModificationTimeRule vfs =
96 defineEarlyCutoff $ \GetModificationTime file -> do
97 defineEarlyCutoff $ \GetModificationTime file -> do
97 let file' = fromNormalizedFilePath file
98 let file' = fromNormalizedFilePath file
99+ let wrap time@(l,s) = do
100+ hPutStrLn stderr (show $ BS.pack $ show time)
98− let wrap time@(l,s) = (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s))
101+ pure (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s))
99 alwaysRerun
102 alwaysRerun
100 mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
103 mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
101 case mbVirtual of
104 case mbVirtual of
102 Just (virtualFileVersion -> ver) ->
105 Just (virtualFileVersion -> ver) ->
103 pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))
106 pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver))
104− Nothing -> liftIO $ fmap wrap (getModTime file')
107+ Nothing -> liftIO $ (wrap =<< getModTime file')
105 `catch` \(e :: IOException) -> do
108 `catch` \(e :: IOException) -> do
106 let err | isDoesNotExistError e = "File does not exist: " ++ file'
109 let err | isDoesNotExistError e = "File does not exist: " ++ file'
107 | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
110 | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
@@ -130,6 +133,7 @@ getModificationTimeRule vfs =
130 Posix.throwErrnoPathIfMinus1Retry_ "getmodtime" f $ c_getModTime f' secPtr nsecPtr
133 Posix.throwErrnoPathIfMinus1Retry_ "getmodtime" f $ c_getModTime f' secPtr nsecPtr
131 sec <- peek secPtr
134 sec <- peek secPtr
132 nsec <- peek nsecPtr
135 nsec <- peek nsecPtr
136+ hPutStrLn stderr (show (f, sec, nsec))
133 pure (fromEnum sec, fromIntegral nsec)
137 pure (fromEnum sec, fromIntegral nsec)
134
138
135-- Sadly even unix’s getFileStatus + modificationTimeHiRes is still about twice as slow
139-- Sadly even unix’s getFileStatus + modificationTimeHiRes is still about twice as slow
src/Development/IDE/Core/Rules.hs+4
@@ -25,6 +25,7 @@ module Development.IDE.Core.Rules(
25 generateCore,
25 generateCore,
26 ) where
26 ) where
27
27
28+import System.IO
28import Fingerprint
29import Fingerprint
29
30
30import Data.Binary
31import Data.Binary
@@ -189,6 +190,7 @@ getParsedModuleRule =
189 (_, contents) <- getFileContents file
190 (_, contents) <- getFileContents file
190 packageState <- hscEnv <$> use_ GhcSession file
191 packageState <- hscEnv <$> use_ GhcSession file
191 opt <- getIdeOptions
192 opt <- getIdeOptions
193+ liftIO $ hPutStrLn stderr "parsing module"
192 (diag, res) <- liftIO $ parseModule opt packageState (fromNormalizedFilePath file) (fmap textToStringBuffer contents)
194 (diag, res) <- liftIO $ parseModule opt packageState (fromNormalizedFilePath file) (fmap textToStringBuffer contents)
193 case res of
195 case res of
194 Nothing -> pure (Nothing, (diag, Nothing))
196 Nothing -> pure (Nothing, (diag, Nothing))
@@ -196,6 +198,7 @@ getParsedModuleRule =
196 mbFingerprint <- if isNothing $ optShakeFiles opt
198 mbFingerprint <- if isNothing $ optShakeFiles opt
197 then pure Nothing
199 then pure Nothing
198 else liftIO $ Just . fingerprintToBS <$> fingerprintFromStringBuffer contents
200 else liftIO $ Just . fingerprintToBS <$> fingerprintFromStringBuffer contents
201+ liftIO $ hPutStrLn stderr ("fingerprint: " <> show mbFingerprint)
199 pure (mbFingerprint, (diag, Just modu))
202 pure (mbFingerprint, (diag, Just modu))
200
203
201getLocatedImportsRule :: Rules ()
204getLocatedImportsRule :: Rules ()
@@ -346,6 +349,7 @@ typeCheckRule =
346 else uses_ TypeCheck (transitiveModuleDeps deps)
349 else uses_ TypeCheck (transitiveModuleDeps deps)
347 setPriority priorityTypeCheck
350 setPriority priorityTypeCheck
348 IdeOptions{ optDefer = defer} <- getIdeOptions
351 IdeOptions{ optDefer = defer} <- getIdeOptions
352+ liftIO $ hPutStrLn stderr "typechecking"
349 liftIO $ typecheckModule defer packageState tms pm
353 liftIO $ typecheckModule defer packageState tms pm
350 where
354 where
351 uses_th_qq dflags = xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
355 uses_th_qq dflags = xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags