{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Prelude.Logger
( module GHCup.Prelude.Logger
, module GHCup.Prelude.Logger.Internal
)
where
import GHCup.Prelude.Logger.Internal
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils.Dirs (fromGHCupPath)
import GHCup.Prelude.Internal
import GHCup.Prelude.File.Search (findFiles)
import GHCup.Prelude.File (recycleFile)
import GHCup.Prelude.String.QQ
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Prelude hiding ( appendFile )
import System.FilePath
import System.IO.Error
import Text.Regex.Posix
import qualified Data.ByteString as B
initGHCupFileLogging :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadMask m
) => m FilePath
initGHCupFileLogging :: forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
m FilePath
initGHCupFileLogging = do
Dirs { GHCupPath
logsDir :: GHCupPath
$sel:logsDir:Dirs :: Dirs -> GHCupPath
logsDir } <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let logfile :: FilePath
logfile = GHCupPath -> FilePath
fromGHCupPath GHCupPath
logsDir FilePath -> FilePath -> FilePath
</> FilePath
"ghcup.log"
[FilePath]
logFiles <- IO [FilePath] -> m [FilePath]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
(GHCupPath -> FilePath
fromGHCupPath GHCupPath
logsDir)
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|^.*\.log$|] :: B.ByteString)
)
[FilePath] -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
logFiles ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> m ()) -> (FilePath -> FilePath) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCupPath -> FilePath
fromGHCupPath GHCupPath
logsDir FilePath -> FilePath -> FilePath
</>)
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
logfile FilePath
""
FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
logfile