Recache cabal-helper stuff when cabal-helper-* executable changes

This commit is contained in:
Daniel Gröber 2015-03-06 15:48:26 +01:00
parent c05bd816e7
commit e23772b1ed
3 changed files with 32 additions and 26 deletions

View File

@ -54,16 +54,17 @@ usage = do
usageMsg = "\ usageMsg = "\
\( print-appdatadir\n\ \( print-appdatadir\n\
\| print-build-platform\n\ \| print-build-platform\n\
\| DIST_DIR [CABAL_HELPER_ARGS...]\n\ \| DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n"
\)\n"
main :: IO () main :: IO ()
main = handlePanic $ do main = handlePanic $ do
args <- getArgs args <- getArgs
case args of case args of
[] -> usage
"--help":[] -> usage
"print-appdatadir":[] -> putStrLn =<< appDataDir "print-appdatadir":[] -> putStrLn =<< appDataDir
"print-build-platform":[] -> putStrLn $ display buildPlatform "print-build-platform":[] -> putStrLn $ display buildPlatform
distdir:_ -> do distdir:args' -> do
cfgf <- canonicalizePath (distdir </> "setup-config") cfgf <- canonicalizePath (distdir </> "setup-config")
mhdr <- getCabalConfigHeader cfgf mhdr <- getCabalConfigHeader cfgf
case mhdr of case mhdr of
@ -76,12 +77,13 @@ main = handlePanic $ do
eexe <- compileHelper hdrCabalVersion eexe <- compileHelper hdrCabalVersion
case eexe of case eexe of
Left e -> exitWith e Left e -> exitWith e
Right exe -> do Right exe ->
case args' of
"print-exe":_ -> putStrLn exe
_ -> do
(_,_,_,h) <- createProcess $ proc exe args (_,_,_,h) <- createProcess $ proc exe args
exitWith =<< waitForProcess h exitWith =<< waitForProcess h
_ -> usage
appDataDir :: IO FilePath appDataDir :: IO FilePath
appDataDir = (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod" appDataDir = (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"
@ -137,7 +139,7 @@ compileHelper cabalVer = do
db <- installCabal cabalVer `E.catch` db <- installCabal cabalVer `E.catch`
\(SomeException _) -> errorInstallCabal cabalVer \(SomeException _) -> errorInstallCabal cabalVer
compileWithPkg chdir (Just db) compileWithPkg chdir (Just db)
Just _ -> Just _ -> do
compileWithPkg chdir Nothing compileWithPkg chdir Nothing
where where
@ -229,12 +231,25 @@ compile Compile {..} = do
if recompile if recompile
then do then do
-- TODO: touch exe after, ghc doesn't do that if the input files didn't
-- actually change
rv <- callProcessStderr' Nothing "ghc" ghc_opts rv <- callProcessStderr' Nothing "ghc" ghc_opts
return $ case rv of return $ case rv of
ExitSuccess -> Right exe ExitSuccess -> Right exe
e@(ExitFailure _) -> Left e e@(ExitFailure _) -> Left e
else return $ Right exe else return $ Right exe
where
timeHsFiles :: FilePath -> IO [TimedFile]
timeHsFiles dir = do
fs <- map (dir</>) <$> getDirectoryContents dir
mapM timeFile =<< filterM isHsFile (filter (=="Wrapper.hs") fs)
where
isHsFile f = do
exists <- doesFileExist f
return $ exists && ".hs" `isSuffixOf` f
callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode
callProcessStderr' mwd exe args = do callProcessStderr' mwd exe args = do
(_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr (_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr
@ -254,15 +269,6 @@ processFailedException fn exe args rv =
, intercalate " " (map show args) , intercalate " " (map show args)
, " (exit " ++ show rv ++ ")"] , " (exit " ++ show rv ++ ")"]
timeHsFiles :: FilePath -> IO [TimedFile]
timeHsFiles dir = do
fs <- map (dir</>) <$> getDirectoryContents dir
mapM timeFile =<< filterM isHsFile fs
where
isHsFile f = do
exists <- doesFileExist f
return $ exists && ".hs" `isSuffixOf` f
installCabal :: Version -> IO FilePath installCabal :: Version -> IO FilePath
installCabal ver = do installCabal ver = do
db <- createPkgDb ver db <- createPkgDb ver

View File

@ -80,18 +80,17 @@ data CabalHelper = CabalHelper {
cabalHelper :: (MonadIO m, GmEnv m) => m CabalHelper cabalHelper :: (MonadIO m, GmEnv m) => m CabalHelper
cabalHelper = withCabal $ do cabalHelper = withCabal $ do
Cradle {..} <- cradle
let cmds = [ "entrypoints" let cmds = [ "entrypoints"
, "source-dirs" , "source-dirs"
, "ghc-options" , "ghc-options"
, "ghc-src-options" , "ghc-src-options"
, "ghc-pkg-options" ] , "ghc-pkg-options" ]
distdir = cradleRootDir </> "dist"
Cradle {..} <- cradle
exe <- liftIO $ findLibexecExe "cabal-helper-wrapper" exe <- liftIO $ findLibexecExe "cabal-helper-wrapper"
hexe <- liftIO $ readProcess exe [distdir, "print-exe"] ""
let distdir = cradleRootDir </> "dist" res <- liftIO $ cached cradleRootDir (cabalHelperCache hexe cmds) $ do
res <- liftIO $ cached cradleRootDir (cabalHelperCache cmds) $ do
out <- readProcess exe (distdir:cmds) "" out <- readProcess exe (distdir:cmds) ""
evaluate (read out) `E.catch` evaluate (read out) `E.catch`
\(SomeException _) -> error "cabalHelper: read failed" \(SomeException _) -> error "cabalHelper: read failed"

View File

@ -233,9 +233,10 @@ cabalBuildPlatform = dropWhileEnd isSpace $ unsafePerformIO $
packageCache :: String packageCache :: String
packageCache = "package.cache" packageCache = "package.cache"
cabalHelperCache :: [String] -> Cached [String] [Maybe GmCabalHelperResponse] cabalHelperCache ::
cabalHelperCache cmds = Cached { FilePath -> [String] -> Cached [String] [Maybe GmCabalHelperResponse]
inputFiles = [setupConfigPath], cabalHelperCache cabalHelperExe cmds = Cached {
inputFiles = [cabalHelperExe, setupConfigPath],
inputData = cmds, inputData = cmds,
cacheFile = setupConfigPath <.> "ghc-mod.cabal-helper" cacheFile = setupConfigPath <.> "ghc-mod.cabal-helper"
} }