Support unliftio-0.2.0.0 #3625

Author: snoyberg

src/Stack/Build/Execute.hs

@@ -1766,7 +1766,7 @@ data ExcludeTHLoading = ExcludeTHLoading | KeepTHLoading
 data ConvertPathsToAbsolute = ConvertPathsToAbsolute | KeepPathsAsIs
 
 -- | Strip Template Haskell "Loading package" lines and making paths absolute.
-mungeBuildOutput :: forall m. (MonadUnliftIO m, MonadThrow m)
+mungeBuildOutput :: forall m. MonadIO m
                  => ExcludeTHLoading       -- ^ exclude TH loading?
                  -> ConvertPathsToAbsolute -- ^ convert paths to absolute?
                  -> Path Abs Dir           -- ^ package's root directory

src/Stack/Prelude.hs

@@ -3,7 +3,11 @@
 {-# LANGUAGE OverloadedStrings          #-}
 module Stack.Prelude
   ( mapLeft
+  , ResourceT
   , runConduitRes
+  , runResourceT
+  , liftResourceT
+  , NoLogging (..)
   , withSystemTempDir
   , fromFirst
   , mapMaybeA
@@ -107,6 +111,9 @@ import           UnliftIO             as X
 import qualified Data.Text            as T
 import qualified Path.IO
 
+import qualified Control.Monad.Trans.Resource as Res (runResourceT, transResourceT)
+import           Control.Monad.Trans.Resource.Internal (ResourceT (ResourceT))
+
 mapLeft :: (a1 -> a2) -> Either a1 b -> Either a2 b
 mapLeft f (Left a1) = Left (f a1)
 mapLeft _ (Right b) = Right b
@@ -137,6 +144,22 @@ stripCR t = fromMaybe t (T.stripSuffix "\r" t)
 runConduitRes :: MonadUnliftIO m => ConduitM () Void (ResourceT m) r -> m r
 runConduitRes = runResourceT . runConduit
 
+runResourceT :: MonadUnliftIO m => ResourceT m a -> m a
+runResourceT r = withRunInIO $ \run -> Res.runResourceT (Res.transResourceT run r)
+
+liftResourceT :: MonadIO m => ResourceT IO a -> ResourceT m a
+liftResourceT (ResourceT f) = ResourceT $ liftIO . f
+
+-- | Avoid orphan messes
+newtype NoLogging a = NoLogging { runNoLogging :: IO a }
+  deriving (Functor, Applicative, Monad, MonadIO)
+instance MonadUnliftIO NoLogging where
+  askUnliftIO = NoLogging $
+                withUnliftIO $ \u ->
+                return (UnliftIO (unliftIO u . runNoLogging))
+instance MonadLogger NoLogging where
+  monadLoggerLog _ _ _ _ = return ()
+
 -- | Path version
 withSystemTempDir :: MonadUnliftIO m => String -> (Path Abs Dir -> m a) -> m a
 withSystemTempDir str inner = withRunInIO $ \run -> Path.IO.withSystemTempDir str $ run . inner

src/main/Main.hs

@@ -19,7 +19,6 @@ module Main (main) where
 import qualified Build_stack
 #endif
 import           Stack.Prelude
-import           Control.Monad.Logger (runNoLoggingT)
 import           Control.Monad.Reader (local)
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Writer.Lazy (Writer)
@@ -508,7 +507,7 @@ secondaryCommandHandler args f =
           -- TODO show the command in verbose mode
           -- hPutStrLn stderr $ unwords $
           --   ["Running", "[" ++ ex, unwords (tail args) ++ "]"]
-          _ <- runNoLoggingT (exec menv ex (tail args))
+          _ <- runNoLogging (exec menv ex (tail args))
           return f
         Nothing -> return $ fmap (vcatErrorHelp (noSuchCmd cmd)) f
   where

src/test/Stack/PackageDumpSpec.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE TupleSections     #-}
 module Stack.PackageDumpSpec where
 
-import           Control.Monad.Logger
 import           Data.Conduit
 import qualified Data.Conduit.Binary           as CB
 import qualified Data.Conduit.List             as CL
@@ -208,7 +207,7 @@ spec = do
             }
 
 
-    it "ghcPkgDump + addProfiling + addHaddock" $ (id :: IO () -> IO ()) $ runNoLoggingT $ do
+    it "ghcPkgDump + addProfiling + addHaddock" $ (id :: IO () -> IO ()) $ runNoLogging $ do
         menv' <- getEnvOverride buildPlatform
         menv <- mkEnvOverride buildPlatform $ Map.delete "GHC_PACKAGE_PATH" $ unEnvOverride menv'
         icache <- newInstalledCache
@@ -223,7 +222,7 @@ spec = do
         menv' <- getEnvOverride buildPlatform
         menv <- mkEnvOverride buildPlatform $ Map.delete "GHC_PACKAGE_PATH" $ unEnvOverride menv'
         icache <- newInstalledCache
-        m <- runNoLoggingT $ ghcPkgDump menv Ghc []
+        m <- runNoLogging $ ghcPkgDump menv Ghc []
             $  conduitDumpPackage
             =$ addProfiling icache
             =$ addHaddock icache

stack-nightly.yaml

@@ -7,3 +7,4 @@ nix:
     - http-client-tls-0.3.4
 extra-deps:
 - bindings-uname-0.1
+- unliftio-0.2.0.0

stack.yaml

@@ -26,3 +26,4 @@ extra-deps:
 - extra-1.6
 - hsc2hs-0.68.2
 - hpack-0.20.0
+- unliftio-0.2.0.0