git-annex/Utility/LogFile.hs
Joey Hess 25703e1413
finally really add back custom-setup stanza
Fourth or fifth try at this and finally found a way to make it work.

Absurd amount of busy-work forced on me by change in cabal's behavior.
Split up Utility modules that need posix stuff out of ones used by
Setup. Various other hacks around inability for Setup to use anything
that ifdefs a use of unix.

Probably lost a full day of my life to this.
This is how build systems make their users hate them. Just saying.
2017-12-31 16:36:39 -04:00

60 lines
1.2 KiB
Haskell

{- log files
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP #-}
module Utility.LogFile where
import Common
#ifndef mingw32_HOST_OS
import System.Posix.Types
import System.Posix.IO
#endif
openLog :: FilePath -> IO Handle
openLog logfile = do
rotateLog logfile
openFile logfile AppendMode
rotateLog :: FilePath -> IO ()
rotateLog logfile = go 0
where
go num
| num > maxLogs = return ()
| otherwise = whenM (doesFileExist currfile) $ do
go (num + 1)
rename currfile nextfile
where
currfile = filename num
nextfile = filename (num + 1)
filename n
| n == 0 = logfile
| otherwise = rotatedLog logfile n
rotatedLog :: FilePath -> Int -> FilePath
rotatedLog logfile n = logfile ++ "." ++ show n
{- Lists most recent logs last. -}
listLogs :: FilePath -> IO [FilePath]
listLogs logfile = filterM doesFileExist $ reverse $
logfile : map (rotatedLog logfile) [1..maxLogs]
maxLogs :: Int
maxLogs = 9
#ifndef mingw32_HOST_OS
redirLog :: Fd -> IO ()
redirLog logfd = do
mapM_ (redir logfd) [stdOutput, stdError]
closeFd logfd
redir :: Fd -> Fd -> IO ()
redir newh h = do
closeFd h
void $ dupTo newh h
#endif