Yooo

lib/GHCup.hs

@@ -26,6 +26,8 @@ import           Control.Monad.Fail             ( MonadFail )
 import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Class      ( lift )
+import           Control.Monad.Trans.Resource
+                                         hiding ( throwM )
 import           Data.Aeson
 import           Data.Attoparsec.ByteString
 import           Data.ByteString                ( ByteString )
@@ -51,9 +53,7 @@ import           Prelude                 hiding ( abs
 import           Safe
 import           System.IO.Error
 import           System.Info
-import           System.Posix.Env.ByteString    ( getEnvDefault
-                                                , getEnv
-                                                )
+import           System.Posix.Env.ByteString    ( getEnv )
 import           System.Posix.FilePath          ( takeFileName )
 import           System.Posix.Files.ByteString  ( readSymbolicLink )
 import "unix"    System.Posix.IO.ByteString
@@ -62,7 +62,6 @@ import "unix-bytestring" System.Posix.IO.ByteString
                                                 ( fdWrite )
 import           System.Posix.RawFilePath.Directory.Errors
                                                 ( hideError )
-import           System.Posix.Temp.ByteString
 import           System.Posix.Types
 import           URI.ByteString
 import           URI.ByteString.QQ
@@ -553,7 +552,8 @@ installTool :: ( MonadThrow m
                , MonadCatch m
                , MonadIO m
                , MonadFail m
-               )
+               , MonadResource m
+               ) -- tmp file
             => ToolRequest
             -> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
             -> Excepts
@@ -591,7 +591,7 @@ installTool treq mpfReq = do
         | fileExists -> pure $ cachfile
         | otherwise  -> liftE $ download dlinfo cachedir Nothing
     False -> do
-      tmp <- liftIO mkGhcupTmpDir
+      tmp <- lift withGHCupTmpDir
       liftE $ download dlinfo tmp Nothing
 
   -- unpack
@@ -821,7 +821,7 @@ rmGHCVer ver = do
       lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
       liftIO $ rmMinorSymlinks
 
-      lift $ $(logInfo) [i|Removing ghc-x.y symlinks|]
+      lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
       liftE fixMajorSymlinks
 
       when isSetGHC $ liftE $ do
@@ -1011,15 +1011,15 @@ urlBaseName = parseRel . snd . B.breakEnd (== _slash) . urlDecode False
 
 
 -- | Unpack an archive to a temporary directory and return that path.
-unpackToTmpDir :: (MonadLogger m, MonadIO m, MonadThrow m)
+unpackToTmpDir :: (MonadResource m -- temp file
+                                  , MonadLogger m, MonadIO m, MonadThrow m)
                => Path Abs       -- ^ archive path
                -> Excepts '[ArchiveError] m (Path Abs)
 unpackToTmpDir av = do
   let fp = E.decodeUtf8 (toFilePath av)
   lift $ $(logInfo) [i|Unpacking: #{fp}|]
-  fn     <- toFilePath <$> basename av
-  tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
-  tmp    <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
+  fn  <- toFilePath <$> basename av
+  tmp <- toFilePath <$> lift withGHCupTmpDir
   let untar bs = do
         Tar.unpack tmp . Tar.read $ bs
         parseAbs tmp

lib/GHCup/File.hs

@@ -5,6 +5,8 @@ module GHCup.File where
 
 import           Control.Exception.Safe
 import           Control.Monad
+import           Control.Monad.IO.Class
+import           Control.Monad.Trans.Resource
 import           Data.ByteString
 import           Data.ByteString.Unsafe         ( unsafeUseAsCStringLen )
 import           Data.Char
@@ -186,13 +188,19 @@ toProcessError exe args mps = case mps of
   Nothing                            -> Left $ NoSuchPid exe args
 
 
-mkGhcupTmpDir :: IO (Path Abs)
+mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs)
 mkGhcupTmpDir = do
-  tmpdir <- getEnvDefault [s|TMPDIR|] [s|/tmp|]
-  tmp    <- mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
+  tmpdir <- liftIO $ getEnvDefault [s|TMPDIR|] [s|/tmp|]
+  tmp    <- liftIO $ mkdtemp $ (tmpdir FP.</> [s|ghcup-|])
+  liftIO $ System.IO.putStrLn $ show tmp
   parseAbs tmp
 
 
+withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m)
+                => m (Path Abs)
+withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive
+
+
 getHomeDirectory :: IO (Path Abs)
 getHomeDirectory = do
   e <- getEnv [s|HOME|]