From da0283d969a4b9a0a9bc3add3f5d38e5fa90c070 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 1 May 2020 17:58:06 +0200 Subject: [PATCH 1/8] Avoid locking of the temp file in windows --- src/HIE/Bios/Cradle.hs | 51 +++++++++++++++++++++++------------------- 1 file changed, 28 insertions(+), 23 deletions(-) diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index 150e02ffb..d31b5dda4 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -637,33 +637,38 @@ readProcessWithOutputFile -> FilePath -- ^ Process to call. -> [String] -- ^ Arguments to the process. -> IO (ExitCode, [String], [String], [String]) -readProcessWithOutputFile l ghcProc work_dir fp args = - withSystemTempFile "bios-output" $ \output_file h -> do - hSetBuffering h LineBuffering - old_env <- getEnvironment - let (ghcPath, ghcArgs) = case ghcProc of - Just (p, a) -> (p, unwords a) - Nothing -> - ( fromMaybe "ghc" (lookup hieBiosGhc old_env) - , fromMaybe "" (lookup hieBiosGhcArgs old_env) - ) - -- Pipe stdout directly into the logger - let process = (readProcessInDirectory work_dir fp args) - { env = Just - $ (hieBiosGhc, ghcPath) - : (hieBiosGhcArgs, ghcArgs) - : ("HIE_BIOS_OUTPUT", output_file) - : old_env - } - -- Windows line endings are not converted so you have to filter out `'r` characters - loggingConduit = (C.decodeUtf8 C..| C.lines C..| C.filterE (/= '\r') C..| C.map T.unpack C..| C.iterM l C..| C.sinkList) - (ex, stdo, stde) <- sourceProcessWithStreams process mempty loggingConduit loggingConduit - !res <- force <$> hGetContents h - return (ex, stdo, stde, lines (filter (/= '\r') res)) +readProcessWithOutputFile l ghcProc work_dir fp args = do + old_env <- getEnvironment + let (ghcPath, ghcArgs) = case ghcProc of + Just (p, a) -> (p, unwords a) + Nothing -> + ( fromMaybe "ghc" (lookup hieBiosGhc old_env) + , fromMaybe "" (lookup hieBiosGhcArgs old_env) + ) + output_file <- emptySystemTempFile "hie-bios" + + -- Pipe stdout directly into the logger + let process = (readProcessInDirectory work_dir fp args) + { env = Just + $ (hieBiosGhc, ghcPath) + : (hieBiosGhcArgs, ghcArgs) + : (hieBiosOutput, output_file) + : old_env + } + -- Windows line endings are not converted so you have to filter out `'r` characters + loggingConduit = (C.decodeUtf8 C..| C.lines C..| C.filterE (/= '\r') C..| C.map T.unpack C..| C.iterM l C..| C.sinkList) + (ex, stdo, stde) <- sourceProcessWithStreams process mempty loggingConduit loggingConduit + res <- withFile output_file ReadMode $ \handle -> do + hSetBuffering handle LineBuffering + !res <- force <$> hGetContents handle + return res + + return (ex, stdo, stde, lines (filter (/= '\r') res)) where hieBiosGhc = "HIE_BIOS_GHC" hieBiosGhcArgs = "HIE_BIOS_GHC_ARGS" + hieBiosOutput = "HIE_BIOS_OUTPUT" readProcessInDirectory :: FilePath -> FilePath -> [String] -> CreateProcess readProcessInDirectory wdir p args = (proc p args) { cwd = Just wdir } From a81f8701df83fc5a71a1acba1efee715646a7455 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 1 May 2020 18:02:53 +0200 Subject: [PATCH 2/8] Honour previous value of HIE_BIOS_OUTPUT --- src/HIE/Bios/Cradle.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index d31b5dda4..5651c24be 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -645,7 +645,8 @@ readProcessWithOutputFile l ghcProc work_dir fp args = do ( fromMaybe "ghc" (lookup hieBiosGhc old_env) , fromMaybe "" (lookup hieBiosGhcArgs old_env) ) - output_file <- emptySystemTempFile "hie-bios" + output_file <- maybe (emptySystemTempFile "hie-bios") return + (lookup hieBiosOutput old_env) -- Pipe stdout directly into the logger let process = (readProcessInDirectory work_dir fp args) From 2ca3f7aa3e2bcf4cbbd5a73c003a3f1bcbba6ab8 Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 4 May 2020 23:10:54 +0200 Subject: [PATCH 3/8] Remove temp file after use it --- src/HIE/Bios/Cradle.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index 5651c24be..e1b626bc6 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -49,7 +49,7 @@ import qualified Data.Conduit.Combinators as C import qualified Data.Conduit as C import qualified Data.Conduit.Text as C import qualified Data.Text as T -import Data.Maybe (fromMaybe) +import Data.Maybe (isNothing, fromMaybe) import GHC.Fingerprint (fingerprintString) ---------------------------------------------------------------- @@ -645,8 +645,8 @@ readProcessWithOutputFile l ghcProc work_dir fp args = do ( fromMaybe "ghc" (lookup hieBiosGhc old_env) , fromMaybe "" (lookup hieBiosGhcArgs old_env) ) - output_file <- maybe (emptySystemTempFile "hie-bios") return - (lookup hieBiosOutput old_env) + let mbHieBiosOut = lookup hieBiosOutput old_env + output_file <- maybe (emptySystemTempFile "hie-bios") return mbHieBiosOut -- Pipe stdout directly into the logger let process = (readProcessInDirectory work_dir fp args) @@ -664,6 +664,9 @@ readProcessWithOutputFile l ghcProc work_dir fp args = do !res <- force <$> hGetContents handle return res + -- If the output was not provided by the user we delete it + when (isNothing mbHieBiosOut) (removeFile output_file) + return (ex, stdo, stde, lines (filter (/= '\r') res)) where From 655cb31985c7b28013561695f6aebe6aebfe9212 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 6 May 2020 21:08:48 +0200 Subject: [PATCH 4/8] Ensure removing of temp dir --- src/HIE/Bios/Cradle.hs | 66 +++++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 30 deletions(-) diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index e1b626bc6..a3314c20d 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -49,7 +49,7 @@ import qualified Data.Conduit.Combinators as C import qualified Data.Conduit as C import qualified Data.Conduit.Text as C import qualified Data.Text as T -import Data.Maybe (isNothing, fromMaybe) +import Data.Maybe (fromMaybe) import GHC.Fingerprint (fingerprintString) ---------------------------------------------------------------- @@ -639,37 +639,43 @@ readProcessWithOutputFile -> IO (ExitCode, [String], [String], [String]) readProcessWithOutputFile l ghcProc work_dir fp args = do old_env <- getEnvironment - let (ghcPath, ghcArgs) = case ghcProc of - Just (p, a) -> (p, unwords a) - Nothing -> - ( fromMaybe "ghc" (lookup hieBiosGhc old_env) - , fromMaybe "" (lookup hieBiosGhcArgs old_env) - ) - let mbHieBiosOut = lookup hieBiosOutput old_env - output_file <- maybe (emptySystemTempFile "hie-bios") return mbHieBiosOut - - -- Pipe stdout directly into the logger - let process = (readProcessInDirectory work_dir fp args) - { env = Just - $ (hieBiosGhc, ghcPath) - : (hieBiosGhcArgs, ghcArgs) - : (hieBiosOutput, output_file) - : old_env - } - -- Windows line endings are not converted so you have to filter out `'r` characters - loggingConduit = (C.decodeUtf8 C..| C.lines C..| C.filterE (/= '\r') C..| C.map T.unpack C..| C.iterM l C..| C.sinkList) - (ex, stdo, stde) <- sourceProcessWithStreams process mempty loggingConduit loggingConduit - res <- withFile output_file ReadMode $ \handle -> do - hSetBuffering handle LineBuffering - !res <- force <$> hGetContents handle - return res - - -- If the output was not provided by the user we delete it - when (isNothing mbHieBiosOut) (removeFile output_file) - - return (ex, stdo, stde, lines (filter (/= '\r') res)) + + withHieBiosOutput old_env $ \output_file -> do + let (ghcPath, ghcArgs) = case ghcProc of + Just (p, a) -> (p, unwords a) + Nothing -> + ( fromMaybe "ghc" (lookup hieBiosGhc old_env) + , fromMaybe "" (lookup hieBiosGhcArgs old_env) + ) + + -- Pipe stdout directly into the logger + let process = (readProcessInDirectory work_dir fp args) + { env = Just + $ (hieBiosGhc, ghcPath) + : (hieBiosGhcArgs, ghcArgs) + : (hieBiosOutput, output_file) + : old_env + } + + -- Windows line endings are not converted so you have to filter out `'r` characters + let loggingConduit = (C.decodeUtf8 C..| C.lines C..| C.filterE (/= '\r') C..| C.map T.unpack C..| C.iterM l C..| C.sinkList) + (ex, stdo, stde) <- sourceProcessWithStreams process mempty loggingConduit loggingConduit + res <- withFile output_file ReadMode $ \handle -> do + hSetBuffering handle LineBuffering + !res <- force <$> hGetContents handle + return res + + return (ex, stdo, stde, lines (filter (/= '\r') res)) where + withHieBiosOutput :: [(String,String)] -> (FilePath -> IO a) -> IO a + withHieBiosOutput env action = do + let mbHieBiosOut = lookup hieBiosOutput env + case mbHieBiosOut of + Just file -> action file + Nothing -> withSystemTempDirectory "hie-bios" $ + \ tmpDir -> action $ tmpDir "output" + hieBiosGhc = "HIE_BIOS_GHC" hieBiosGhcArgs = "HIE_BIOS_GHC_ARGS" hieBiosOutput = "HIE_BIOS_OUTPUT" From b5f2017e6f4661eb06e16feff093765291132866 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 6 May 2020 21:11:16 +0200 Subject: [PATCH 5/8] Ignore .vscode config dir --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 44e05588b..150b05c88 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ dist-newstyle/ stack.yaml stack.yaml.lock cabal.project.local* +.vscode/ From ad2a675b2a8874180337fb3ac7295fbfd58d2941 Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 6 May 2020 22:33:24 +0200 Subject: [PATCH 6/8] Only read output file if it exists --- src/HIE/Bios/Cradle.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index a3314c20d..0cc3f9cad 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -660,10 +660,13 @@ readProcessWithOutputFile l ghcProc work_dir fp args = do -- Windows line endings are not converted so you have to filter out `'r` characters let loggingConduit = (C.decodeUtf8 C..| C.lines C..| C.filterE (/= '\r') C..| C.map T.unpack C..| C.iterM l C..| C.sinkList) (ex, stdo, stde) <- sourceProcessWithStreams process mempty loggingConduit loggingConduit - res <- withFile output_file ReadMode $ \handle -> do - hSetBuffering handle LineBuffering - !res <- force <$> hGetContents handle - return res + existsFile <- doesFileExist output_file + res <- if existsFile + then withFile output_file ReadMode $ \handle -> do + hSetBuffering handle LineBuffering + !res <- force <$> hGetContents handle + return res + else return "" return (ex, stdo, stde, lines (filter (/= '\r') res)) From ef2c4db6cf9318a2e3386625b3af9282fdf52e07 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 7 May 2020 12:16:14 +0200 Subject: [PATCH 7/8] Use temp file if HIE_BIOS_OUTPUT is blank --- src/HIE/Bios/Cradle.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index 0cc3f9cad..6a20d752c 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -675,9 +675,12 @@ readProcessWithOutputFile l ghcProc work_dir fp args = do withHieBiosOutput env action = do let mbHieBiosOut = lookup hieBiosOutput env case mbHieBiosOut of - Just file -> action file - Nothing -> withSystemTempDirectory "hie-bios" $ - \ tmpDir -> action $ tmpDir "output" + Just file@(_:_) -> action file + _ -> withTempHieBiosOutput action + + withTempHieBiosOutput action = + withSystemTempDirectory "hie-bios" $ + \ tmpDir -> action $ tmpDir "output" hieBiosGhc = "HIE_BIOS_GHC" hieBiosGhcArgs = "HIE_BIOS_GHC_ARGS" From cd6b41e3f88f825a1e02a7d2f03567b96763926b Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 7 May 2020 21:13:58 +0200 Subject: [PATCH 8/8] Use withSystemTempFile and dont check if it exists --- src/HIE/Bios/Cradle.hs | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index 6a20d752c..cb51c493d 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -660,13 +660,10 @@ readProcessWithOutputFile l ghcProc work_dir fp args = do -- Windows line endings are not converted so you have to filter out `'r` characters let loggingConduit = (C.decodeUtf8 C..| C.lines C..| C.filterE (/= '\r') C..| C.map T.unpack C..| C.iterM l C..| C.sinkList) (ex, stdo, stde) <- sourceProcessWithStreams process mempty loggingConduit loggingConduit - existsFile <- doesFileExist output_file - res <- if existsFile - then withFile output_file ReadMode $ \handle -> do - hSetBuffering handle LineBuffering - !res <- force <$> hGetContents handle - return res - else return "" + res <- withFile output_file ReadMode $ \handle -> do + hSetBuffering handle LineBuffering + !res <- force <$> hGetContents handle + return res return (ex, stdo, stde, lines (filter (/= '\r') res)) @@ -676,11 +673,8 @@ readProcessWithOutputFile l ghcProc work_dir fp args = do let mbHieBiosOut = lookup hieBiosOutput env case mbHieBiosOut of Just file@(_:_) -> action file - _ -> withTempHieBiosOutput action - - withTempHieBiosOutput action = - withSystemTempDirectory "hie-bios" $ - \ tmpDir -> action $ tmpDir "output" + _ -> withSystemTempFile "hie-bios" $ + \ file h -> hClose h >> action file hieBiosGhc = "HIE_BIOS_GHC" hieBiosGhcArgs = "HIE_BIOS_GHC_ARGS"