Smarter logging

app/ghcup/Main.hs

@@ -1069,7 +1069,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
           createDirRecursive' baseDir
 
           -- logger interpreter
-          logfile <- flip runReaderT appstate $ initGHCupFileLogging [rel|ghcup.log|]
+          logfile <- flip runReaderT appstate $ initGHCupFileLogging
           let loggerConfig = LoggerConfig
                 { lcPrintDebug = verbose settings
                 , colorOutter  = B.hPut stderr

lib/GHCup/Utils/File.hs

@@ -50,7 +50,7 @@ import           System.Posix.Directory.ByteString
 import           System.Posix.FD               as FD
 import           System.Posix.FilePath   hiding ( (</>) )
 import           System.Posix.Files.ByteString
-import           System.Posix.Foreign           ( oExcl )
+import           System.Posix.Foreign           ( oExcl, oAppend )
 import "unix"    System.Posix.IO.ByteString
                                          hiding ( openFd )
 import           System.Posix.Process           ( ProcessStatus(..) )
@@ -133,14 +133,14 @@ execLogged :: (MonadReader AppState m, MonadIO m, MonadThrow m)
            => ByteString       -- ^ thing to execute
            -> Bool             -- ^ whether to search PATH for the thing
            -> [ByteString]     -- ^ args for the thing
-           -> Path Rel         -- ^ log filename
+           -> Path Rel         -- ^ log filename (opened in append mode)
            -> Maybe (Path Abs) -- ^ optionally chdir into this
            -> Maybe [(ByteString, ByteString)] -- ^ optional environment
            -> m (Either ProcessError ())
 execLogged exe spath args lfile chdir env = do
   AppState { settings = Settings {..}, dirs = Dirs {..} } <- ask
   logfile       <- (logsDir </>) <$> parseRel (toFilePath lfile <> ".log")
-  liftIO $ bracket (createFile (toFilePath logfile) newFilePerms)
+  liftIO $ bracket (openFd (toFilePath logfile) WriteOnly [oAppend] (Just newFilePerms))
                    closeFd
                    (action verbose)
  where

lib/GHCup/Utils/Logger.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE QuasiQuotes      #-}
 
 {-|
 Module      : GHCup.Utils.Logger
@@ -15,6 +16,8 @@ module GHCup.Utils.Logger where
 
 import           GHCup.Types
 import           GHCup.Utils
+import           GHCup.Utils.File
+import           GHCup.Utils.String.QQ
 
 import           Control.Monad
 import           Control.Monad.IO.Class
@@ -25,6 +28,7 @@ import           HPath.IO
 import           Prelude                 hiding ( appendFile )
 import           System.Console.Pretty
 import           System.IO.Error
+import           Text.Regex.Posix
 
 import qualified Data.ByteString               as B
 
@@ -64,12 +68,19 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
     rawOutter outr
 
 
-initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => Path Rel -> m (Path Abs)
+initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => m (Path Abs)
-initGHCupFileLogging context = do
+initGHCupFileLogging = do
   AppState {dirs = Dirs {..}} <- ask
-  let logfile = logsDir </> context
+  let logfile = logsDir </> [rel|ghcup.log|]
   liftIO $ do
     createDirRecursive' logsDir
-    hideError doesNotExistErrorType $ deleteFile logfile
+    logFiles <- findFiles
+      logsDir
+      (makeRegexOpts compExtended
+                     execBlank
+                     ([s|^.*\.log$|] :: B.ByteString)
+      )
+    forM_ logFiles $ hideError doesNotExistErrorType . deleteFile . (logsDir </>)
+
     createRegularFile newFilePerms logfile
     pure logfile