Skip to content

Commit 56f8160

Browse files
snoybergsnoyberg
committed
Avoid runResourceT/liftResourceT
1 parent cad6aca commit 56f8160

File tree

3 files changed

+41
-40
lines changed

3 files changed

+41
-40
lines changed

‎src/Stack/Build/Execute.hs‎

Lines changed: 12 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,7 @@ import qualified System.Directory as D
8484
import System.Environment (getExecutablePath)
8585
import System.Exit (ExitCode (ExitSuccess))
8686
import qualified System.FilePath as FP
87-
import System.IO
87+
import System.IO (hClose, hPutStr, hFlush, stderr, stdout)
8888
import System.PosixCompat.Files (createLink)
8989
import System.Process.Log (showProcessArgDebug, withProcessTimeLog)
9090
import System.Process.Read
@@ -428,8 +428,8 @@ withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshot
428428

429429
dumpLogIfWarning :: (Path Abs Dir, Path Abs File) -> RIO env ()
430430
dumpLogIfWarning (pkgDir, filepath) = do
431-
firstWarning <- runResourceT
432-
$ transPipe liftResourceT (CB.sourceFile (toFilePath filepath))
431+
firstWarning <- withBinaryFile (toFilePath filepath) ReadMode $ \h ->
432+
CB.sourceHandle h
433433
$$ CT.decodeUtf8Lenient
434434
=$ CT.lines
435435
=$ CL.map stripCR
@@ -445,8 +445,8 @@ withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshot
445445
dumpLog msgSuffix (pkgDir, filepath) = do
446446
logInfo $ T.pack $ concat ["\n-- Dumping log file", msgSuffix, ": ", toFilePath filepath, "\n"]
447447
compilerVer <- view actualCompilerVersionL
448-
runResourceT
449-
$ transPipe liftResourceT (CB.sourceFile (toFilePath filepath))
448+
withBinaryFile (toFilePath filepath) ReadMode $ \h ->
449+
CB.sourceHandle h
450450
$$ CT.decodeUtf8Lenient
451451
=$ mungeBuildOutput ExcludeTHLoading ConvertPathsToAbsolute pkgDir compilerVer
452452
=$ CL.mapM_ logInfo
@@ -935,10 +935,7 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
935935
liftIO $ atomically $ writeTChan eeLogFiles (pkgDir, logPath)
936936
_ -> return ()
937937

938-
bracket
939-
(liftIO $ openBinaryFile fp WriteMode)
940-
(liftIO . hClose)
941-
$ \h -> inner (Just (logPath, h))
938+
withBinaryFile fp WriteMode $ \h -> inner (Just (logPath, h))
942939

943940
withCabal
944941
:: Package
@@ -1094,11 +1091,12 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
10941091
Nothing -> return []
10951092
Just (logFile, h) -> do
10961093
liftIO $ hClose h
1097-
runResourceT
1098-
$ transPipe liftResourceT (CB.sourceFile (toFilePath logFile))
1099-
=$= CT.decodeUtf8Lenient
1100-
$$ mungeBuildOutput stripTHLoading makeAbsolute pkgDir compilerVer
1101-
=$ CL.consume
1094+
withBinaryFile (toFilePath logFile) WriteMode $ \h' ->
1095+
runConduit
1096+
$ CB.sourceHandle h'
1097+
.| CT.decodeUtf8Lenient
1098+
.| mungeBuildOutput stripTHLoading makeAbsolute pkgDir compilerVer
1099+
.| CL.consume
11021100
throwM $ SetupHsBuildFailure
11031101
ec
11041102
(Just taskProvides)

‎src/Stack/Prelude.hs‎

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,6 @@ module Stack.Prelude
55
( mapLeft
66
, ResourceT
77
, runConduitRes
8-
, runResourceT
9-
, liftResourceT
108
, NoLogging (..)
119
, withSystemTempDir
1210
, fromFirst
@@ -112,7 +110,7 @@ import qualified Data.Text as T
112110
import qualified Path.IO
113111

114112
import qualified Control.Monad.Trans.Resource as Res (runResourceT, transResourceT)
115-
import Control.Monad.Trans.Resource.Internal (ResourceT (ResourceT))
113+
import Control.Monad.Trans.Resource (ResourceT)
116114

117115
mapLeft :: (a1 -> a2) -> Either a1 b -> Either a2 b
118116
mapLeft f (Left a1) = Left (f a1)
@@ -147,9 +145,6 @@ runConduitRes = runResourceT . runConduit
147145
runResourceT :: MonadUnliftIO m => ResourceT m a -> m a
148146
runResourceT r = withRunInIO $ \run -> Res.runResourceT (Res.transResourceT run r)
149147

150-
liftResourceT :: MonadIO m => ResourceT IO a -> ResourceT m a
151-
liftResourceT (ResourceT f) = ResourceT $ liftIO . f
152-
153148
-- | Avoid orphan messes
154149
newtype NoLogging a = NoLogging { runNoLogging :: IO a }
155150
deriving (Functor, Applicative, Monad, MonadIO)

‎src/test/Stack/PackageDumpSpec.hs‎

Lines changed: 28 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -66,11 +66,13 @@ spec = do
6666

6767
describe "conduitDumpPackage" $ do
6868
it "ghc 7.8" $ do
69-
haskell2010:_ <- runResourceT
70-
$ CB.sourceFile "test/package-dump/ghc-7.8.txt"
71-
=$= decodeUtf8
72-
$$ conduitDumpPackage
73-
=$ CL.consume
69+
haskell2010:_ <-
70+
withBinaryFile "test/package-dump/ghc-7.8.txt" ReadMode $ \h ->
71+
runConduit
72+
$ CB.sourceHandle h
73+
.| decodeUtf8
74+
.| conduitDumpPackage
75+
.| CL.consume
7476
ghcPkgId <- parseGhcPkgId "haskell2010-1.1.2.0-05c8dd51009e08c6371c82972d40f55a"
7577
packageIdent <- parsePackageIdentifier "haskell2010-1.1.2.0"
7678
depends <- mapM parseGhcPkgId
@@ -96,11 +98,13 @@ spec = do
9698
}
9799

98100
it "ghc 7.10" $ do
99-
haskell2010:_ <- runResourceT
100-
$ CB.sourceFile "test/package-dump/ghc-7.10.txt"
101-
=$= decodeUtf8
102-
$$ conduitDumpPackage
103-
=$ CL.consume
101+
haskell2010:_ <-
102+
withBinaryFile "test/package-dump/ghc-7.10.txt" ReadMode $ \h ->
103+
runConduit
104+
$ CB.sourceHandle h
105+
.| decodeUtf8
106+
.| conduitDumpPackage
107+
.| CL.consume
104108
ghcPkgId <- parseGhcPkgId "ghc-7.10.1-325809317787a897b7a97d646ceaa3a3"
105109
pkgIdent <- parsePackageIdentifier "ghc-7.10.1"
106110
depends <- mapM parseGhcPkgId
@@ -136,11 +140,13 @@ spec = do
136140
, dpExposedModules = []
137141
}
138142
it "ghc 7.8.4 (osx)" $ do
139-
hmatrix:_ <- runResourceT
140-
$ CB.sourceFile "test/package-dump/ghc-7.8.4-osx.txt"
141-
=$= decodeUtf8
142-
$$ conduitDumpPackage
143-
=$ CL.consume
143+
hmatrix:_ <-
144+
withBinaryFile "test/package-dump/ghc-7.8.4-osx.txt" ReadMode $ \h ->
145+
runConduit
146+
$ CB.sourceHandle h
147+
.| decodeUtf8
148+
.| conduitDumpPackage
149+
.| CL.consume
144150
ghcPkgId <- parseGhcPkgId "hmatrix-0.16.1.5-12d5d21f26aa98774cdd8edbc343fbfe"
145151
pkgId <- parsePackageIdentifier "hmatrix-0.16.1.5"
146152
depends <- mapM parseGhcPkgId
@@ -174,11 +180,13 @@ spec = do
174180
, dpExposedModules = ["Data.Packed","Data.Packed.Vector","Data.Packed.Matrix","Data.Packed.Foreign","Data.Packed.ST","Data.Packed.Development","Numeric.LinearAlgebra","Numeric.LinearAlgebra.LAPACK","Numeric.LinearAlgebra.Algorithms","Numeric.Container","Numeric.LinearAlgebra.Util","Numeric.LinearAlgebra.Devel","Numeric.LinearAlgebra.Data","Numeric.LinearAlgebra.HMatrix","Numeric.LinearAlgebra.Static"]
175181
}
176182
it "ghc HEAD" $ do
177-
ghcBoot:_ <- runResourceT
178-
$ CB.sourceFile "test/package-dump/ghc-head.txt"
179-
=$= decodeUtf8
180-
$$ conduitDumpPackage
181-
=$ CL.consume
183+
ghcBoot:_ <-
184+
withBinaryFile "test/package-dump/ghc-head.txt" ReadMode $ \h ->
185+
runConduit
186+
$ CB.sourceHandle h
187+
.| decodeUtf8
188+
.| conduitDumpPackage
189+
.| CL.consume
182190
ghcPkgId <- parseGhcPkgId "ghc-boot-0.0.0.0"
183191
pkgId <- parsePackageIdentifier "ghc-boot-0.0.0.0"
184192
depends <- mapM parseGhcPkgId

0 commit comments

Comments
 (0)