diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 567da7d..538f2ca 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1069,7 +1069,7 @@ Report bugs at |] 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 diff --git a/lib/GHCup/Utils/File.hs b/lib/GHCup/Utils/File.hs index 408fec5..e782839 100644 --- a/lib/GHCup/Utils/File.hs +++ b/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 diff --git a/lib/GHCup/Utils/Logger.hs b/lib/GHCup/Utils/Logger.hs index 58fd542..5f84c39 100644 --- a/lib/GHCup/Utils/Logger.hs +++ b/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 context = do +initGHCupFileLogging :: (MonadIO m, MonadReader AppState m) => m (Path Abs) +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