{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE UndecidableInstances #-}

module Shrun.Configuration.Data.FileLogging
  ( FileLogInitP (..),
    FileLogOpened (..),
    FileLoggingP (..),
    FileLoggingArgs,
    FileLoggingToml,
    FileLoggingMerged,
    FileLoggingEnv,
    DeleteOnSuccessSwitch (..),
    mergeFileLogging,
    withFileLoggingEnv,
  )
where

import Data.Bytes
  ( FloatingFormatter (MkFloatingFormatter),
    Normalize (normalize),
    formatSized,
    sizedFormatterNatural,
  )
import Data.Text qualified as T
import Effects.FileSystem.HandleWriter (MonadHandleWriter (withBinaryFile))
import Effects.FileSystem.PathWriter (MonadPathWriter (createDirectoryIfMissing))
import Effects.FileSystem.Utils qualified as FsUtils
import GHC.Num (Num (fromInteger))
import Shrun.Configuration.Data.ConfigPhase
  ( ConfigPhase
      ( ConfigPhaseArgs,
        ConfigPhaseEnv,
        ConfigPhaseMerged,
        ConfigPhaseToml
      ),
    ConfigPhaseF,
    ConfigPhaseMaybeF,
    LineTruncF,
    SwitchF,
  )
import Shrun.Configuration.Data.FileLogging.FileMode
  ( FileMode
      ( FileModeAppend,
        FileModeWrite
      ),
  )
import Shrun.Configuration.Data.FileLogging.FilePathDefault
  ( FilePathDefault
      ( FPDefault,
        FPManual
      ),
  )
import Shrun.Configuration.Data.FileLogging.FileSizeMode
  ( FileSizeMode
      ( FileSizeModeDelete,
        FileSizeModeNothing,
        FileSizeModeWarn
      ),
  )
import Shrun.Configuration.Data.StripControl (FileLogStripControl)
import Shrun.Configuration.Data.Truncation
  ( TruncRegion (TruncCommandName),
    Truncation,
    configToLineTrunc,
    decodeCommandNameTrunc,
    decodeLineTrunc,
  )
import Shrun.Configuration.Data.WithDisabled
  ( WithDisabled (Disabled, With, Without),
    (<>?),
    (<>?.),
    (<>??),
  )
import Shrun.Configuration.Data.WithDisabled qualified as WD
import Shrun.Configuration.Default (Default (def))
import Shrun.Logging.Types (FileLog)
import Shrun.Prelude

-- | Switch for deleting the log file upon success.
data DeleteOnSuccessSwitch
  = DeleteOnSuccessOff
  | DeleteOnSuccessOn
  deriving stock (DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch -> Bool
(DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch -> Bool)
-> (DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch -> Bool)
-> Eq DeleteOnSuccessSwitch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch -> Bool
== :: DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch -> Bool
$c/= :: DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch -> Bool
/= :: DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch -> Bool
Eq, Int -> DeleteOnSuccessSwitch -> ShowS
[DeleteOnSuccessSwitch] -> ShowS
DeleteOnSuccessSwitch -> String
(Int -> DeleteOnSuccessSwitch -> ShowS)
-> (DeleteOnSuccessSwitch -> String)
-> ([DeleteOnSuccessSwitch] -> ShowS)
-> Show DeleteOnSuccessSwitch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteOnSuccessSwitch -> ShowS
showsPrec :: Int -> DeleteOnSuccessSwitch -> ShowS
$cshow :: DeleteOnSuccessSwitch -> String
show :: DeleteOnSuccessSwitch -> String
$cshowList :: [DeleteOnSuccessSwitch] -> ShowS
showList :: [DeleteOnSuccessSwitch] -> ShowS
Show)

instance Default DeleteOnSuccessSwitch where
  def :: DeleteOnSuccessSwitch
def = DeleteOnSuccessSwitch
DeleteOnSuccessOff

instance
  ( k ~ An_Iso,
    a ~ Bool,
    b ~ Bool
  ) =>
  LabelOptic
    "boolIso"
    k
    DeleteOnSuccessSwitch
    DeleteOnSuccessSwitch
    a
    b
  where
  labelOptic :: Optic k NoIx DeleteOnSuccessSwitch DeleteOnSuccessSwitch a b
labelOptic =
    (DeleteOnSuccessSwitch -> a)
-> (b -> DeleteOnSuccessSwitch)
-> Iso DeleteOnSuccessSwitch DeleteOnSuccessSwitch a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
      (\cases DeleteOnSuccessSwitch
DeleteOnSuccessOn -> a
Bool
True; DeleteOnSuccessSwitch
DeleteOnSuccessOff -> a
Bool
False)
      (\cases b
Bool
True -> DeleteOnSuccessSwitch
DeleteOnSuccessOn; b
Bool
False -> DeleteOnSuccessSwitch
DeleteOnSuccessOff)
  {-# INLINE labelOptic #-}

-- NOTE: [Args vs. Toml mandatory fields]
--
-- Some fields are mandatory e.g. FileLogging's path if we are actually
-- doing file logging. The latter is determined by the FileLoggingP itself
-- being Just (cf. Nothing), thus the path itself is mandatory on Toml and
-- Merged.
--
-- So why is it optional on Args? Because Args' FileLoggingP is _always_
-- present, unlike Toml and Merged's Maybe. We need this behavior because the
-- former's fields can be used to override toml fields, even if file-logging is
-- not specified on the CLI.
--
-- For example, 'shrun --file-log-mode write cmd' _should_ overwrite toml's
-- file-log.mode even though we did not specify --file-log. Therefore Args'
-- FileLoggingP always needs to be present hence all its field must be
-- optional, even when some are mandatory on Merged.

-- | File logging's path is only optional for the Args. For Toml and merged,
-- it must be present if file logging is active.
type FileLogPathF :: ConfigPhase -> Type
type family FileLogPathF p where
  FileLogPathF ConfigPhaseArgs = WithDisabled FilePathDefault
  FileLogPathF ConfigPhaseToml = FilePathDefault
  FileLogPathF ConfigPhaseMerged = FilePathDefault

-- | Initial file log params, for usage before we create the final Env.
data FileLogInitP p = MkFileLogInitP
  { -- | Optional path to log file.
    forall (p :: ConfigPhase). FileLogInitP p -> FileLogPathF p
path :: FileLogPathF p,
    -- | Mode to use with the file log.
    forall (p :: ConfigPhase).
FileLogInitP p -> ConfigPhaseF p FileMode
mode :: ConfigPhaseF p FileMode,
    -- | Threshold for when we should warn about the log file size.
    forall (p :: ConfigPhase).
FileLogInitP p -> ConfigPhaseF p FileSizeMode
sizeMode :: ConfigPhaseF p FileSizeMode
  }

instance
  ( k ~ A_Lens,
    a ~ FileLogPathF p,
    b ~ FileLogPathF p
  ) =>
  LabelOptic "path" k (FileLogInitP p) (FileLogInitP p) a b
  where
  labelOptic :: Optic k NoIx (FileLogInitP p) (FileLogInitP p) a b
labelOptic =
    LensVL (FileLogInitP p) (FileLogInitP p) a b
-> Lens (FileLogInitP p) (FileLogInitP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLogInitP p) (FileLogInitP p) a b
 -> Lens (FileLogInitP p) (FileLogInitP p) a b)
-> LensVL (FileLogInitP p) (FileLogInitP p) a b
-> Lens (FileLogInitP p) (FileLogInitP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkFileLogInitP FileLogPathF p
_path ConfigPhaseF p FileMode
_mode ConfigPhaseF p FileSizeMode
_sizeMode) ->
          (b -> FileLogInitP p) -> f b -> f (FileLogInitP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\b
path' -> FileLogPathF p
-> ConfigPhaseF p FileMode
-> ConfigPhaseF p FileSizeMode
-> FileLogInitP p
forall (p :: ConfigPhase).
FileLogPathF p
-> ConfigPhaseF p FileMode
-> ConfigPhaseF p FileSizeMode
-> FileLogInitP p
MkFileLogInitP b
FileLogPathF p
path' ConfigPhaseF p FileMode
_mode ConfigPhaseF p FileSizeMode
_sizeMode)
            (a -> f b
f a
FileLogPathF p
_path)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ ConfigPhaseF p FileMode,
    b ~ ConfigPhaseF p FileMode
  ) =>
  LabelOptic "mode" k (FileLogInitP p) (FileLogInitP p) a b
  where
  labelOptic :: Optic k NoIx (FileLogInitP p) (FileLogInitP p) a b
labelOptic =
    LensVL (FileLogInitP p) (FileLogInitP p) a b
-> Lens (FileLogInitP p) (FileLogInitP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLogInitP p) (FileLogInitP p) a b
 -> Lens (FileLogInitP p) (FileLogInitP p) a b)
-> LensVL (FileLogInitP p) (FileLogInitP p) a b
-> Lens (FileLogInitP p) (FileLogInitP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkFileLogInitP FileLogPathF p
_path ConfigPhaseF p FileMode
_mode ConfigPhaseF p FileSizeMode
_sizeMode) ->
          (b -> FileLogInitP p) -> f b -> f (FileLogInitP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (\b
mode' -> FileLogPathF p
-> ConfigPhaseF p FileMode
-> ConfigPhaseF p FileSizeMode
-> FileLogInitP p
forall (p :: ConfigPhase).
FileLogPathF p
-> ConfigPhaseF p FileMode
-> ConfigPhaseF p FileSizeMode
-> FileLogInitP p
MkFileLogInitP FileLogPathF p
_path b
ConfigPhaseF p FileMode
mode' ConfigPhaseF p FileSizeMode
_sizeMode)
            (a -> f b
f a
ConfigPhaseF p FileMode
_mode)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ ConfigPhaseF p FileSizeMode,
    b ~ ConfigPhaseF p FileSizeMode
  ) =>
  LabelOptic "sizeMode" k (FileLogInitP p) (FileLogInitP p) a b
  where
  labelOptic :: Optic k NoIx (FileLogInitP p) (FileLogInitP p) a b
labelOptic =
    LensVL (FileLogInitP p) (FileLogInitP p) a b
-> Lens (FileLogInitP p) (FileLogInitP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLogInitP p) (FileLogInitP p) a b
 -> Lens (FileLogInitP p) (FileLogInitP p) a b)
-> LensVL (FileLogInitP p) (FileLogInitP p) a b
-> Lens (FileLogInitP p) (FileLogInitP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkFileLogInitP FileLogPathF p
_path ConfigPhaseF p FileMode
_mode ConfigPhaseF p FileSizeMode
_sizeMode) ->
          (b -> FileLogInitP p) -> f b -> f (FileLogInitP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (FileLogPathF p
-> ConfigPhaseF p FileMode
-> ConfigPhaseF p FileSizeMode
-> FileLogInitP p
forall (p :: ConfigPhase).
FileLogPathF p
-> ConfigPhaseF p FileMode
-> ConfigPhaseF p FileSizeMode
-> FileLogInitP p
MkFileLogInitP FileLogPathF p
_path ConfigPhaseF p FileMode
_mode)
            (a -> f b
f a
ConfigPhaseF p FileSizeMode
_sizeMode)
  {-# INLINE labelOptic #-}

type FileLogInitArgs = FileLogInitP ConfigPhaseArgs

type FileLogInitToml = FileLogInitP ConfigPhaseToml

type FileLogInitMerged = FileLogInitP ConfigPhaseMerged

deriving stock instance Eq FileLogInitArgs

deriving stock instance Show FileLogInitArgs

deriving stock instance Eq FileLogInitToml

deriving stock instance Show FileLogInitToml

deriving stock instance Eq FileLogInitMerged

deriving stock instance Show FileLogInitMerged

-- Only Default instance is for Args, since others require the Path.
instance Default FileLogInitArgs where
  def :: FileLogInitArgs
def =
    MkFileLogInitP
      { path :: FileLogPathF 'ConfigPhaseArgs
path = WithDisabled FilePathDefault
FileLogPathF 'ConfigPhaseArgs
forall a. Default a => a
def,
        mode :: ConfigPhaseF 'ConfigPhaseArgs FileMode
mode = WithDisabled FileMode
ConfigPhaseF 'ConfigPhaseArgs FileMode
forall a. Default a => a
def,
        sizeMode :: ConfigPhaseF 'ConfigPhaseArgs FileSizeMode
sizeMode = WithDisabled FileSizeMode
ConfigPhaseF 'ConfigPhaseArgs FileSizeMode
forall a. Default a => a
def
      }

instance DecodeTOML FileLogInitToml where
  tomlDecoder :: Decoder FileLogInitToml
tomlDecoder =
    FilePathDefault
-> Maybe FileMode -> Maybe FileSizeMode -> FileLogInitToml
FileLogPathF 'ConfigPhaseToml
-> ConfigPhaseF 'ConfigPhaseToml FileMode
-> ConfigPhaseF 'ConfigPhaseToml FileSizeMode
-> FileLogInitToml
forall (p :: ConfigPhase).
FileLogPathF p
-> ConfigPhaseF p FileMode
-> ConfigPhaseF p FileSizeMode
-> FileLogInitP p
MkFileLogInitP
      (FilePathDefault
 -> Maybe FileMode -> Maybe FileSizeMode -> FileLogInitToml)
-> Decoder FilePathDefault
-> Decoder
     (Maybe FileMode -> Maybe FileSizeMode -> FileLogInitToml)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder FilePathDefault
decodeFileLogging
      Decoder (Maybe FileMode -> Maybe FileSizeMode -> FileLogInitToml)
-> Decoder (Maybe FileMode)
-> Decoder (Maybe FileSizeMode -> FileLogInitToml)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe FileMode)
decodeFileLogMode
      Decoder (Maybe FileSizeMode -> FileLogInitToml)
-> Decoder (Maybe FileSizeMode) -> Decoder FileLogInitToml
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe FileSizeMode)
decodeFileLogSizeMode

decodeFileLogging :: Decoder FilePathDefault
decodeFileLogging :: Decoder FilePathDefault
decodeFileLogging = Decoder FilePathDefault -> Text -> Decoder FilePathDefault
forall a. Decoder a -> Text -> Decoder a
getFieldWith Decoder FilePathDefault
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"path"

decodeFileLogMode :: Decoder (Maybe FileMode)
decodeFileLogMode :: Decoder (Maybe FileMode)
decodeFileLogMode = Decoder FileMode -> Text -> Decoder (Maybe FileMode)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder FileMode
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"mode"

decodeFileLogSizeMode :: Decoder (Maybe FileSizeMode)
decodeFileLogSizeMode :: Decoder (Maybe FileSizeMode)
decodeFileLogSizeMode = Decoder FileSizeMode -> Text -> Decoder (Maybe FileSizeMode)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder FileSizeMode
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"size-mode"

-- | Params after we have opened the file for logging.
data FileLogOpened = MkFileLogOpened
  { -- | File handle.
    FileLogOpened -> Handle
handle :: ~Handle,
    -- | File log queue.
    FileLogOpened -> TBQueue FileLog
queue :: ~(TBQueue FileLog)
  }

instance
  ( k ~ A_Lens,
    a ~ Handle,
    b ~ Handle
  ) =>
  LabelOptic "handle" k FileLogOpened FileLogOpened a b
  where
  labelOptic :: Optic k NoIx FileLogOpened FileLogOpened a b
labelOptic =
    LensVL FileLogOpened FileLogOpened a b
-> Lens FileLogOpened FileLogOpened a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL FileLogOpened FileLogOpened a b
 -> Lens FileLogOpened FileLogOpened a b)
-> LensVL FileLogOpened FileLogOpened a b
-> Lens FileLogOpened FileLogOpened a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkFileLogOpened Handle
_handle TBQueue FileLog
_queue) ->
          (Handle -> FileLogOpened) -> f Handle -> f FileLogOpened
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (Handle -> TBQueue FileLog -> FileLogOpened
`MkFileLogOpened` TBQueue FileLog
_queue)
            (a -> f b
f a
Handle
_handle)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ TBQueue FileLog,
    b ~ TBQueue FileLog
  ) =>
  LabelOptic "queue" k FileLogOpened FileLogOpened a b
  where
  labelOptic :: Optic k NoIx FileLogOpened FileLogOpened a b
labelOptic =
    LensVL FileLogOpened FileLogOpened a b
-> Lens FileLogOpened FileLogOpened a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL FileLogOpened FileLogOpened a b
 -> Lens FileLogOpened FileLogOpened a b)
-> LensVL FileLogOpened FileLogOpened a b
-> Lens FileLogOpened FileLogOpened a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         (MkFileLogOpened Handle
_handle TBQueue FileLog
_queue) ->
          (TBQueue FileLog -> FileLogOpened)
-> f (TBQueue FileLog) -> f FileLogOpened
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (Handle -> TBQueue FileLog -> FileLogOpened
MkFileLogOpened Handle
_handle)
            (a -> f b
f a
TBQueue FileLog
_queue)
  {-# INLINE labelOptic #-}

type FileLogFileF :: ConfigPhase -> Type
type family FileLogFileF p where
  FileLogFileF ConfigPhaseArgs = FileLogInitP ConfigPhaseArgs
  FileLogFileF ConfigPhaseToml = FileLogInitP ConfigPhaseToml
  FileLogFileF ConfigPhaseMerged = FileLogInitP ConfigPhaseMerged
  FileLogFileF ConfigPhaseEnv = FileLogOpened

-- | Holds file logging config.
type FileLoggingP :: ConfigPhase -> Type
data FileLoggingP p = MkFileLoggingP
  { -- | File-related params.
    forall (p :: ConfigPhase). FileLoggingP p -> FileLogFileF p
file :: FileLogFileF p,
    -- | The max number of command characters to display in the file logs.
    forall (p :: ConfigPhase).
FileLoggingP p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
commandNameTrunc :: ConfigPhaseMaybeF p (Truncation TruncCommandName),
    -- | If active, deletes the log file upon success.
    forall (p :: ConfigPhase).
FileLoggingP p -> SwitchF p DeleteOnSuccessSwitch
deleteOnSuccess :: SwitchF p DeleteOnSuccessSwitch,
    -- | Determines to what extent we should remove control characters
    -- from file logs.
    forall (p :: ConfigPhase). FileLoggingP p -> LineTruncF p
lineTrunc :: LineTruncF p,
    -- | Strip control
    forall (p :: ConfigPhase).
FileLoggingP p -> ConfigPhaseF p FileLogStripControl
stripControl :: ConfigPhaseF p FileLogStripControl
  }

instance
  ( k ~ A_Lens,
    a ~ FileLogFileF p,
    b ~ FileLogFileF p
  ) =>
  LabelOptic "file" k (FileLoggingP p) (FileLoggingP p) a b
  where
  labelOptic :: Optic k NoIx (FileLoggingP p) (FileLoggingP p) a b
labelOptic =
    LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLoggingP p) (FileLoggingP p) a b
 -> Lens (FileLoggingP p) (FileLoggingP p) a b)
-> LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         ( MkFileLoggingP
             FileLogFileF p
_file
             ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
             SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
             LineTruncF p
_lineTrunc
             ConfigPhaseF p FileLogStripControl
_stripControl
           ) ->
          (b -> FileLoggingP p) -> f b -> f (FileLoggingP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \b
file' ->
                FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
forall (p :: ConfigPhase).
FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
MkFileLoggingP
                  b
FileLogFileF p
file'
                  ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
                  SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
                  LineTruncF p
_lineTrunc
                  ConfigPhaseF p FileLogStripControl
_stripControl
            )
            (a -> f b
f a
FileLogFileF p
_file)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ ConfigPhaseMaybeF p (Truncation TruncCommandName),
    b ~ ConfigPhaseMaybeF p (Truncation TruncCommandName)
  ) =>
  LabelOptic "commandNameTrunc" k (FileLoggingP p) (FileLoggingP p) a b
  where
  labelOptic :: Optic k NoIx (FileLoggingP p) (FileLoggingP p) a b
labelOptic =
    LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLoggingP p) (FileLoggingP p) a b
 -> Lens (FileLoggingP p) (FileLoggingP p) a b)
-> LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         ( MkFileLoggingP
             FileLogFileF p
_file
             ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
             SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
             LineTruncF p
_lineTrunc
             ConfigPhaseF p FileLogStripControl
_stripControl
           ) ->
          (b -> FileLoggingP p) -> f b -> f (FileLoggingP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \b
commandNameTrunc' ->
                FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
forall (p :: ConfigPhase).
FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
MkFileLoggingP
                  FileLogFileF p
_file
                  b
ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
commandNameTrunc'
                  SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
                  LineTruncF p
_lineTrunc
                  ConfigPhaseF p FileLogStripControl
_stripControl
            )
            (a -> f b
f a
ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ SwitchF p DeleteOnSuccessSwitch,
    b ~ SwitchF p DeleteOnSuccessSwitch
  ) =>
  LabelOptic "deleteOnSuccess" k (FileLoggingP p) (FileLoggingP p) a b
  where
  labelOptic :: Optic k NoIx (FileLoggingP p) (FileLoggingP p) a b
labelOptic =
    LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLoggingP p) (FileLoggingP p) a b
 -> Lens (FileLoggingP p) (FileLoggingP p) a b)
-> LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         ( MkFileLoggingP
             FileLogFileF p
_file
             ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
             SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
             LineTruncF p
_lineTrunc
             ConfigPhaseF p FileLogStripControl
_stripControl
           ) ->
          (b -> FileLoggingP p) -> f b -> f (FileLoggingP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \b
deleteOnSuccess' ->
                FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
forall (p :: ConfigPhase).
FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
MkFileLoggingP
                  FileLogFileF p
_file
                  ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
                  b
SwitchF p DeleteOnSuccessSwitch
deleteOnSuccess'
                  LineTruncF p
_lineTrunc
                  ConfigPhaseF p FileLogStripControl
_stripControl
            )
            (a -> f b
f a
SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ LineTruncF p,
    b ~ LineTruncF p
  ) =>
  LabelOptic "lineTrunc" k (FileLoggingP p) (FileLoggingP p) a b
  where
  labelOptic :: Optic k NoIx (FileLoggingP p) (FileLoggingP p) a b
labelOptic =
    LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLoggingP p) (FileLoggingP p) a b
 -> Lens (FileLoggingP p) (FileLoggingP p) a b)
-> LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         ( MkFileLoggingP
             FileLogFileF p
_file
             ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
             SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
             LineTruncF p
_lineTrunc
             ConfigPhaseF p FileLogStripControl
_stripControl
           ) ->
          (b -> FileLoggingP p) -> f b -> f (FileLoggingP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \b
lineTrunc' ->
                FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
forall (p :: ConfigPhase).
FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
MkFileLoggingP
                  FileLogFileF p
_file
                  ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
                  SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
                  b
LineTruncF p
lineTrunc'
                  ConfigPhaseF p FileLogStripControl
_stripControl
            )
            (a -> f b
f a
LineTruncF p
_lineTrunc)
  {-# INLINE labelOptic #-}

instance
  ( k ~ A_Lens,
    a ~ ConfigPhaseF p FileLogStripControl,
    b ~ ConfigPhaseF p FileLogStripControl
  ) =>
  LabelOptic "stripControl" k (FileLoggingP p) (FileLoggingP p) a b
  where
  labelOptic :: Optic k NoIx (FileLoggingP p) (FileLoggingP p) a b
labelOptic =
    LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL
      (LensVL (FileLoggingP p) (FileLoggingP p) a b
 -> Lens (FileLoggingP p) (FileLoggingP p) a b)
-> LensVL (FileLoggingP p) (FileLoggingP p) a b
-> Lens (FileLoggingP p) (FileLoggingP p) a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f
         ( MkFileLoggingP
             FileLogFileF p
_file
             ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
             SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
             LineTruncF p
_lineTrunc
             ConfigPhaseF p FileLogStripControl
_stripControl
           ) ->
          (b -> FileLoggingP p) -> f b -> f (FileLoggingP p)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
forall (p :: ConfigPhase).
FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
MkFileLoggingP
                FileLogFileF p
_file
                ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
_commandNameTrunc
                SwitchF p DeleteOnSuccessSwitch
_deleteOnSuccess
                LineTruncF p
_lineTrunc
            )
            (a -> f b
f a
ConfigPhaseF p FileLogStripControl
_stripControl)
  {-# INLINE labelOptic #-}

type FileLoggingArgs = FileLoggingP ConfigPhaseArgs

type FileLoggingToml = FileLoggingP ConfigPhaseToml

type FileLoggingMerged = FileLoggingP ConfigPhaseMerged

type FileLoggingEnv = FileLoggingP ConfigPhaseEnv

deriving stock instance Eq (FileLoggingP ConfigPhaseArgs)

deriving stock instance Show (FileLoggingP ConfigPhaseArgs)

deriving stock instance Eq (FileLoggingP ConfigPhaseToml)

deriving stock instance Show (FileLoggingP ConfigPhaseToml)

deriving stock instance Eq (FileLoggingP ConfigPhaseMerged)

deriving stock instance Show (FileLoggingP ConfigPhaseMerged)

instance
  ( Default (FileLogFileF p),
    Default (ConfigPhaseMaybeF p (Truncation TruncCommandName)),
    Default (SwitchF p DeleteOnSuccessSwitch),
    Default (LineTruncF p),
    Default (ConfigPhaseF p FileLogStripControl)
  ) =>
  Default (FileLoggingP p)
  where
  def :: FileLoggingP p
def =
    MkFileLoggingP
      { file :: FileLogFileF p
file = FileLogFileF p
forall a. Default a => a
def,
        commandNameTrunc :: ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
commandNameTrunc = ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
forall a. Default a => a
def,
        deleteOnSuccess :: SwitchF p DeleteOnSuccessSwitch
deleteOnSuccess = SwitchF p DeleteOnSuccessSwitch
forall a. Default a => a
def,
        lineTrunc :: LineTruncF p
lineTrunc = LineTruncF p
forall a. Default a => a
def,
        stripControl :: ConfigPhaseF p FileLogStripControl
stripControl = ConfigPhaseF p FileLogStripControl
forall a. Default a => a
def
      }

-- | Merges args and toml configs.
mergeFileLogging ::
  ( HasCallStack,
    MonadTerminal m
  ) =>
  FileLoggingArgs ->
  Maybe FileLoggingToml ->
  m (Maybe FileLoggingMerged)
mergeFileLogging :: forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
FileLoggingP 'ConfigPhaseArgs
-> Maybe (FileLoggingP 'ConfigPhaseToml)
-> m (Maybe (FileLoggingP 'ConfigPhaseMerged))
mergeFileLogging FileLoggingP 'ConfigPhaseArgs
args Maybe (FileLoggingP 'ConfigPhaseToml)
mToml = Maybe FilePathDefault
-> (FilePathDefault -> m (FileLoggingP 'ConfigPhaseMerged))
-> m (Maybe (FileLoggingP 'ConfigPhaseMerged))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe FilePathDefault
mPath ((FilePathDefault -> m (FileLoggingP 'ConfigPhaseMerged))
 -> m (Maybe (FileLoggingP 'ConfigPhaseMerged)))
-> (FilePathDefault -> m (FileLoggingP 'ConfigPhaseMerged))
-> m (Maybe (FileLoggingP 'ConfigPhaseMerged))
forall a b. (a -> b) -> a -> b
$ \FilePathDefault
path -> do
  let toml :: FileLoggingP 'ConfigPhaseToml
toml = FileLoggingP 'ConfigPhaseToml
-> Maybe (FileLoggingP 'ConfigPhaseToml)
-> FileLoggingP 'ConfigPhaseToml
forall a. a -> Maybe a -> a
fromMaybe (FilePathDefault -> FileLoggingP 'ConfigPhaseToml
defaultToml FilePathDefault
path) Maybe (FileLoggingP 'ConfigPhaseToml)
mToml

  Maybe (Truncation 'TruncLine)
lineTrunc <-
    WithDisabled LineTruncation -> m (Maybe (Truncation 'TruncLine))
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
WithDisabled LineTruncation -> m (Maybe (Truncation 'TruncLine))
configToLineTrunc (WithDisabled LineTruncation -> m (Maybe (Truncation 'TruncLine)))
-> WithDisabled LineTruncation -> m (Maybe (Truncation 'TruncLine))
forall a b. (a -> b) -> a -> b
$ (FileLoggingP 'ConfigPhaseArgs
args FileLoggingP 'ConfigPhaseArgs
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled LineTruncation)
-> WithDisabled LineTruncation
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (WithDisabled LineTruncation)
#lineTrunc) WithDisabled LineTruncation
-> Maybe LineTruncation -> WithDisabled LineTruncation
forall a. WithDisabled a -> Maybe a -> WithDisabled a
<>? (FileLoggingP 'ConfigPhaseToml
toml FileLoggingP 'ConfigPhaseToml
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseToml) (Maybe LineTruncation)
-> Maybe LineTruncation
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens NoIx (FileLoggingP 'ConfigPhaseToml) (Maybe LineTruncation)
#lineTrunc)

  pure
    $ MkFileLoggingP
      { file :: FileLogFileF 'ConfigPhaseMerged
file =
          MkFileLogInitP
            { FilePathDefault
FileLogPathF 'ConfigPhaseMerged
path :: FileLogPathF 'ConfigPhaseMerged
path :: FilePathDefault
path,
              mode :: ConfigPhaseF 'ConfigPhaseMerged FileMode
mode =
                (FileLoggingP 'ConfigPhaseArgs
args FileLoggingP 'ConfigPhaseArgs
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode))
-> WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (FileLoggingP 'ConfigPhaseArgs)
  FileLogInitArgs
  FileLogInitArgs
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (FileLoggingP 'ConfigPhaseArgs)
  FileLogInitArgs
  FileLogInitArgs
-> Optic
     A_Lens
     NoIx
     FileLogInitArgs
     FileLogInitArgs
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode))
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode))
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitArgs
  FileLogInitArgs
  (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode))
  (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode))
#mode) WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileMode)
-> Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode)
-> ConfigPhaseF 'ConfigPhaseMerged FileMode
forall a. Default a => WithDisabled a -> Maybe a -> a
<>?. (FileLoggingP 'ConfigPhaseToml
toml FileLoggingP 'ConfigPhaseToml
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseToml)
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode))
-> Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (FileLoggingP 'ConfigPhaseToml)
  FileLogInitToml
  FileLogInitToml
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (FileLoggingP 'ConfigPhaseToml)
  FileLogInitToml
  FileLogInitToml
-> Optic
     A_Lens
     NoIx
     FileLogInitToml
     FileLogInitToml
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode))
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode))
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseToml)
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitToml
  FileLogInitToml
  (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode))
  (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileMode))
#mode),
              sizeMode :: ConfigPhaseF 'ConfigPhaseMerged FileSizeMode
sizeMode =
                (FileLoggingP 'ConfigPhaseArgs
args FileLoggingP 'ConfigPhaseArgs
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
-> WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (FileLoggingP 'ConfigPhaseArgs)
  FileLogInitArgs
  FileLogInitArgs
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (FileLoggingP 'ConfigPhaseArgs)
  FileLogInitArgs
  FileLogInitArgs
-> Optic
     A_Lens
     NoIx
     FileLogInitArgs
     FileLogInitArgs
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitArgs
  FileLogInitArgs
  (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
  (WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
#sizeMode) WithDisabled (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode)
-> Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode)
-> ConfigPhaseF 'ConfigPhaseMerged FileSizeMode
forall a. Default a => WithDisabled a -> Maybe a -> a
<>?. (FileLoggingP 'ConfigPhaseToml
toml FileLoggingP 'ConfigPhaseToml
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseToml)
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
-> Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (FileLoggingP 'ConfigPhaseToml)
  FileLogInitToml
  FileLogInitToml
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (FileLoggingP 'ConfigPhaseToml)
  FileLogInitToml
  FileLogInitToml
-> Optic
     A_Lens
     NoIx
     FileLogInitToml
     FileLogInitToml
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseToml)
     (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitToml
  FileLogInitToml
  (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
  (Maybe (ConfigPhaseF 'ConfigPhaseMerged FileSizeMode))
#sizeMode)
            },
        commandNameTrunc :: ConfigPhaseMaybeF 'ConfigPhaseMerged (Truncation 'TruncCommandName)
commandNameTrunc =
          (FileLoggingP 'ConfigPhaseArgs
args FileLoggingP 'ConfigPhaseArgs
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled (Truncation 'TruncCommandName))
-> WithDisabled (Truncation 'TruncCommandName)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (WithDisabled (Truncation 'TruncCommandName))
#commandNameTrunc) WithDisabled (Truncation 'TruncCommandName)
-> Maybe (Truncation 'TruncCommandName)
-> Maybe (Truncation 'TruncCommandName)
forall a. WithDisabled a -> Maybe a -> Maybe a
<>?? (FileLoggingP 'ConfigPhaseToml
toml FileLoggingP 'ConfigPhaseToml
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseToml)
     (Maybe (Truncation 'TruncCommandName))
-> Maybe (Truncation 'TruncCommandName)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (Maybe (Truncation 'TruncCommandName))
#commandNameTrunc),
        deleteOnSuccess :: SwitchF 'ConfigPhaseMerged DeleteOnSuccessSwitch
deleteOnSuccess =
          WithDisabled DeleteOnSuccessSwitch -> DeleteOnSuccessSwitch
forall a. Default a => WithDisabled a -> a
WD.fromDefault
            ( Optic' An_Iso NoIx DeleteOnSuccessSwitch Bool
-> Bool -> DeleteOnSuccessSwitch
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' An_Iso NoIx DeleteOnSuccessSwitch Bool
#boolIso
                (Bool -> DeleteOnSuccessSwitch)
-> WithDisabled Bool -> WithDisabled DeleteOnSuccessSwitch
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> WithDisabled Bool
argsDeleteOnSuccess
                WithDisabled Bool -> Maybe Bool -> WithDisabled Bool
forall a. WithDisabled a -> Maybe a -> WithDisabled a
<>? (FileLoggingP 'ConfigPhaseToml
toml FileLoggingP 'ConfigPhaseToml
-> Optic' A_Lens NoIx (FileLoggingP 'ConfigPhaseToml) (Maybe Bool)
-> Maybe Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (FileLoggingP 'ConfigPhaseToml) (Maybe Bool)
#deleteOnSuccess)
            ),
        Maybe (Truncation 'TruncLine)
LineTruncF 'ConfigPhaseMerged
lineTrunc :: LineTruncF 'ConfigPhaseMerged
lineTrunc :: Maybe (Truncation 'TruncLine)
lineTrunc,
        stripControl :: ConfigPhaseF 'ConfigPhaseMerged FileLogStripControl
stripControl =
          (FileLoggingP 'ConfigPhaseArgs
args FileLoggingP 'ConfigPhaseArgs
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled FileLogStripControl)
-> WithDisabled FileLogStripControl
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (WithDisabled FileLogStripControl)
#stripControl) WithDisabled FileLogStripControl
-> Maybe FileLogStripControl -> FileLogStripControl
forall a. Default a => WithDisabled a -> Maybe a -> a
<>?. (FileLoggingP 'ConfigPhaseToml
toml FileLoggingP 'ConfigPhaseToml
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseToml)
     (Maybe FileLogStripControl)
-> Maybe FileLogStripControl
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (Maybe FileLogStripControl)
#stripControl)
      }
  where
    -- Convert WithDisabled () -> WithDisabled Bool for below operation.
    argsDeleteOnSuccess :: WithDisabled Bool
    argsDeleteOnSuccess :: WithDisabled Bool
argsDeleteOnSuccess = FileLoggingP 'ConfigPhaseArgs
args FileLoggingP 'ConfigPhaseArgs
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseArgs) (WithDisabled ())
-> WithDisabled ()
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens NoIx (FileLoggingP 'ConfigPhaseArgs) (WithDisabled ())
#deleteOnSuccess WithDisabled () -> Bool -> WithDisabled Bool
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> Bool
True

    -- NOTE: [Config two-part pattern matching]
    --
    -- Why do we pattern match here and in the main body of mergeFileLogging,
    -- rather than just once? If we did all of it in the body we'd have logic
    -- like:
    --
    --     if Disabled and No Toml
    --       Nothing
    --     else if No args and No Toml
    --       Nothing
    --     else if Args and No Toml
    --       Just fileLogging ...
    --     else if No Args and Toml
    --       Just fileLogging ...
    --     else Args and Toml
    --       Just fileLogging ..
    --
    -- That is, we'd repeate the "Just fileLogging" step several types, and
    -- since it is already quite wordy, readability suffers. It is easier to
    -- reduce the pattern matching down to a "go no-go" switch first, then
    -- make the fileLogging based on that.
    mPath :: Maybe FilePathDefault
mPath = case (FileLoggingP 'ConfigPhaseArgs
args FileLoggingP 'ConfigPhaseArgs
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled FilePathDefault)
-> WithDisabled FilePathDefault
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (FileLoggingP 'ConfigPhaseArgs)
  FileLogInitArgs
  FileLogInitArgs
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseArgs)
  (FileLoggingP 'ConfigPhaseArgs)
  FileLogInitArgs
  FileLogInitArgs
-> Optic
     A_Lens
     NoIx
     FileLogInitArgs
     FileLogInitArgs
     (WithDisabled FilePathDefault)
     (WithDisabled FilePathDefault)
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseArgs)
     (WithDisabled FilePathDefault)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitArgs
  FileLogInitArgs
  (WithDisabled FilePathDefault)
  (WithDisabled FilePathDefault)
#path, Maybe (FileLoggingP 'ConfigPhaseToml)
mToml) of
      -- 1. Logging globally disabled
      (WithDisabled FilePathDefault
Disabled, Maybe (FileLoggingP 'ConfigPhaseToml)
_) -> Maybe FilePathDefault
forall a. Maybe a
Nothing
      -- 2. No Args and no Toml
      (WithDisabled FilePathDefault
Without, Maybe (FileLoggingP 'ConfigPhaseToml)
Nothing) -> Maybe FilePathDefault
forall a. Maybe a
Nothing
      (With FilePathDefault
p, Maybe (FileLoggingP 'ConfigPhaseToml)
_) -> FilePathDefault -> Maybe FilePathDefault
forall a. a -> Maybe a
Just FilePathDefault
p
      (WithDisabled FilePathDefault
_, Just FileLoggingP 'ConfigPhaseToml
toml) -> FilePathDefault -> Maybe FilePathDefault
forall a. a -> Maybe a
Just (FilePathDefault -> Maybe FilePathDefault)
-> FilePathDefault -> Maybe FilePathDefault
forall a b. (a -> b) -> a -> b
$ FileLoggingP 'ConfigPhaseToml
toml FileLoggingP 'ConfigPhaseToml
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseToml) FilePathDefault
-> FilePathDefault
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (FileLoggingP 'ConfigPhaseToml)
  FileLogInitToml
  FileLogInitToml
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseToml)
  (FileLoggingP 'ConfigPhaseToml)
  FileLogInitToml
  FileLogInitToml
-> Optic
     A_Lens
     NoIx
     FileLogInitToml
     FileLogInitToml
     FilePathDefault
     FilePathDefault
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseToml) FilePathDefault
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitToml
  FileLogInitToml
  FilePathDefault
  FilePathDefault
#path

instance DecodeTOML FileLoggingToml where
  tomlDecoder :: Decoder (FileLoggingP 'ConfigPhaseToml)
tomlDecoder =
    FileLogFileF 'ConfigPhaseToml
-> ConfigPhaseMaybeF
     'ConfigPhaseToml (Truncation 'TruncCommandName)
-> SwitchF 'ConfigPhaseToml DeleteOnSuccessSwitch
-> LineTruncF 'ConfigPhaseToml
-> ConfigPhaseF 'ConfigPhaseToml FileLogStripControl
-> FileLoggingP 'ConfigPhaseToml
FileLogInitToml
-> Maybe (Truncation 'TruncCommandName)
-> Maybe Bool
-> Maybe LineTruncation
-> Maybe FileLogStripControl
-> FileLoggingP 'ConfigPhaseToml
forall (p :: ConfigPhase).
FileLogFileF p
-> ConfigPhaseMaybeF p (Truncation 'TruncCommandName)
-> SwitchF p DeleteOnSuccessSwitch
-> LineTruncF p
-> ConfigPhaseF p FileLogStripControl
-> FileLoggingP p
MkFileLoggingP
      (FileLogInitToml
 -> Maybe (Truncation 'TruncCommandName)
 -> Maybe Bool
 -> Maybe LineTruncation
 -> Maybe FileLogStripControl
 -> FileLoggingP 'ConfigPhaseToml)
-> Decoder FileLogInitToml
-> Decoder
     (Maybe (Truncation 'TruncCommandName)
      -> Maybe Bool
      -> Maybe LineTruncation
      -> Maybe FileLogStripControl
      -> FileLoggingP 'ConfigPhaseToml)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder FileLogInitToml
forall a. DecodeTOML a => Decoder a
tomlDecoder
      Decoder
  (Maybe (Truncation 'TruncCommandName)
   -> Maybe Bool
   -> Maybe LineTruncation
   -> Maybe FileLogStripControl
   -> FileLoggingP 'ConfigPhaseToml)
-> Decoder (Maybe (Truncation 'TruncCommandName))
-> Decoder
     (Maybe Bool
      -> Maybe LineTruncation
      -> Maybe FileLogStripControl
      -> FileLoggingP 'ConfigPhaseToml)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe (Truncation 'TruncCommandName))
decodeCommandNameTrunc
      Decoder
  (Maybe Bool
   -> Maybe LineTruncation
   -> Maybe FileLogStripControl
   -> FileLoggingP 'ConfigPhaseToml)
-> Decoder (Maybe Bool)
-> Decoder
     (Maybe LineTruncation
      -> Maybe FileLogStripControl -> FileLoggingP 'ConfigPhaseToml)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe Bool)
decodeFileDeleteOnSuccess
      Decoder
  (Maybe LineTruncation
   -> Maybe FileLogStripControl -> FileLoggingP 'ConfigPhaseToml)
-> Decoder (Maybe LineTruncation)
-> Decoder
     (Maybe FileLogStripControl -> FileLoggingP 'ConfigPhaseToml)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe LineTruncation)
decodeLineTrunc
      Decoder
  (Maybe FileLogStripControl -> FileLoggingP 'ConfigPhaseToml)
-> Decoder (Maybe FileLogStripControl)
-> Decoder (FileLoggingP 'ConfigPhaseToml)
forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Decoder (Maybe FileLogStripControl)
decodeFileLogStripControl

decodeFileDeleteOnSuccess :: Decoder (Maybe Bool)
decodeFileDeleteOnSuccess :: Decoder (Maybe Bool)
decodeFileDeleteOnSuccess = Decoder Bool -> Text -> Decoder (Maybe Bool)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder Bool
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"delete-on-success"

decodeFileLogStripControl :: Decoder (Maybe FileLogStripControl)
decodeFileLogStripControl :: Decoder (Maybe FileLogStripControl)
decodeFileLogStripControl = Decoder FileLogStripControl
-> Text -> Decoder (Maybe FileLogStripControl)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder FileLogStripControl
forall a. DecodeTOML a => Decoder a
tomlDecoder Text
"strip-control"

type MLogging = Maybe (Tuple3 FileLoggingMerged Handle (TBQueue FileLog))

-- | Given merged FileLogging config, constructs a FileLoggingEnv and calls
-- the continuation.
withFileLoggingEnv ::
  forall m a.
  ( HasCallStack,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadSTM m,
    MonadTerminal m
  ) =>
  Maybe FileLoggingMerged ->
  (Maybe FileLoggingEnv -> m a) ->
  m a
withFileLoggingEnv :: forall (m :: Type -> Type) a.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadSTM m,
 MonadTerminal m) =>
Maybe (FileLoggingP 'ConfigPhaseMerged)
-> (Maybe FileLoggingEnv -> m a) -> m a
withFileLoggingEnv Maybe (FileLoggingP 'ConfigPhaseMerged)
mFileLogging Maybe FileLoggingEnv -> m a
onFileLoggingEnv = do
  let mkEnv :: MLogging -> Maybe FileLoggingEnv
      mkEnv :: MLogging -> Maybe FileLoggingEnv
mkEnv MLogging
Nothing = Maybe FileLoggingEnv
forall a. Maybe a
Nothing
      mkEnv (Just (FileLoggingP 'ConfigPhaseMerged
fl, Handle
h, TBQueue FileLog
q)) =
        FileLoggingEnv -> Maybe FileLoggingEnv
forall a. a -> Maybe a
Just
          (FileLoggingEnv -> Maybe FileLoggingEnv)
-> FileLoggingEnv -> Maybe FileLoggingEnv
forall a b. (a -> b) -> a -> b
$ MkFileLoggingP
            { file :: FileLogFileF 'ConfigPhaseEnv
file =
                MkFileLogOpened
                  { handle :: Handle
handle = Handle
h,
                    queue :: TBQueue FileLog
queue = TBQueue FileLog
q
                  },
              commandNameTrunc :: ConfigPhaseMaybeF 'ConfigPhaseEnv (Truncation 'TruncCommandName)
commandNameTrunc = FileLoggingP 'ConfigPhaseMerged
fl FileLoggingP 'ConfigPhaseMerged
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseMerged)
     (Maybe (Truncation 'TruncCommandName))
-> Maybe (Truncation 'TruncCommandName)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (Maybe (Truncation 'TruncCommandName))
#commandNameTrunc,
              lineTrunc :: LineTruncF 'ConfigPhaseEnv
lineTrunc = FileLoggingP 'ConfigPhaseMerged
fl FileLoggingP 'ConfigPhaseMerged
-> Optic'
     A_Lens
     NoIx
     (FileLoggingP 'ConfigPhaseMerged)
     (Maybe (Truncation 'TruncLine))
-> Maybe (Truncation 'TruncLine)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (Maybe (Truncation 'TruncLine))
#lineTrunc,
              deleteOnSuccess :: SwitchF 'ConfigPhaseEnv DeleteOnSuccessSwitch
deleteOnSuccess = FileLoggingP 'ConfigPhaseMerged
fl FileLoggingP 'ConfigPhaseMerged
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) DeleteOnSuccessSwitch
-> DeleteOnSuccessSwitch
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) DeleteOnSuccessSwitch
#deleteOnSuccess,
              stripControl :: ConfigPhaseF 'ConfigPhaseEnv FileLogStripControl
stripControl = FileLoggingP 'ConfigPhaseMerged
fl FileLoggingP 'ConfigPhaseMerged
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FileLogStripControl
-> FileLogStripControl
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FileLogStripControl
#stripControl
            }

  Maybe (FileLoggingP 'ConfigPhaseMerged) -> (MLogging -> m a) -> m a
forall (m :: Type -> Type) a.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadSTM m,
 MonadTerminal m) =>
Maybe (FileLoggingP 'ConfigPhaseMerged) -> (MLogging -> m a) -> m a
withMLogging Maybe (FileLoggingP 'ConfigPhaseMerged)
mFileLogging (Maybe FileLoggingEnv -> m a
onFileLoggingEnv (Maybe FileLoggingEnv -> m a)
-> (MLogging -> Maybe FileLoggingEnv) -> MLogging -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLogging -> Maybe FileLoggingEnv
mkEnv)

withMLogging ::
  forall m a.
  ( HasCallStack,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadSTM m,
    MonadTerminal m
  ) =>
  Maybe FileLoggingMerged ->
  (MLogging -> m a) ->
  m a
-- 1. No file logging
withMLogging :: forall (m :: Type -> Type) a.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadSTM m,
 MonadTerminal m) =>
Maybe (FileLoggingP 'ConfigPhaseMerged) -> (MLogging -> m a) -> m a
withMLogging Maybe (FileLoggingP 'ConfigPhaseMerged)
Nothing MLogging -> m a
onLogging = MLogging -> m a
onLogging MLogging
forall a. Maybe a
Nothing
-- 2. Use the default path.
withMLogging (Just FileLoggingP 'ConfigPhaseMerged
fileLogging) MLogging -> m a
onLogging = do
  let ioMode :: IOMode
ioMode = case FileLoggingP 'ConfigPhaseMerged
fileLogging FileLoggingP 'ConfigPhaseMerged
-> Optic' A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FileMode
-> FileMode
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (FileLoggingP 'ConfigPhaseMerged)
  FileLogInitMerged
  FileLogInitMerged
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (FileLoggingP 'ConfigPhaseMerged)
  FileLogInitMerged
  FileLogInitMerged
-> Optic
     A_Lens NoIx FileLogInitMerged FileLogInitMerged FileMode FileMode
-> Optic' A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FileMode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx FileLogInitMerged FileLogInitMerged FileMode FileMode
#mode of
        FileMode
FileModeAppend -> IOMode
AppendMode
        FileMode
FileModeWrite -> IOMode
WriteMode

  OsPath
fp <- case FileLoggingP 'ConfigPhaseMerged
fileLogging FileLoggingP 'ConfigPhaseMerged
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FilePathDefault
-> FilePathDefault
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (FileLoggingP 'ConfigPhaseMerged)
  FileLogInitMerged
  FileLogInitMerged
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (FileLoggingP 'ConfigPhaseMerged)
  FileLogInitMerged
  FileLogInitMerged
-> Optic
     A_Lens
     NoIx
     FileLogInitMerged
     FileLogInitMerged
     FilePathDefault
     FilePathDefault
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FilePathDefault
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitMerged
  FileLogInitMerged
  FilePathDefault
  FilePathDefault
#path of
    FilePathDefault
FPDefault -> do
      OsPath
stateDir <- m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m OsPath
getShrunXdgState
      let fp :: OsPath
fp = OsPath
stateDir OsPath -> OsPath -> OsPath
</> [osp|shrun.log|]
      Bool
stateExists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
stateDir
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
stateExists (Bool -> OsPath -> m ()
forall (m :: Type -> Type).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
True OsPath
stateDir)
      pure OsPath
fp
    FPManual OsPath
fp -> OsPath -> m OsPath
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OsPath
fp

  OsPath -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadFileWriter m, MonadPathReader m) =>
OsPath -> m ()
ensureFileExists OsPath
fp
  FileSizeMode -> OsPath -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m, MonadPathWriter m,
 MonadTerminal m) =>
FileSizeMode -> OsPath -> m ()
handleLogFileSize (FileLoggingP 'ConfigPhaseMerged
fileLogging FileLoggingP 'ConfigPhaseMerged
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FileSizeMode
-> FileSizeMode
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (FileLoggingP 'ConfigPhaseMerged)
  FileLogInitMerged
  FileLogInitMerged
#file Optic
  A_Lens
  NoIx
  (FileLoggingP 'ConfigPhaseMerged)
  (FileLoggingP 'ConfigPhaseMerged)
  FileLogInitMerged
  FileLogInitMerged
-> Optic
     A_Lens
     NoIx
     FileLogInitMerged
     FileLogInitMerged
     FileSizeMode
     FileSizeMode
-> Optic'
     A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) FileSizeMode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  FileLogInitMerged
  FileLogInitMerged
  FileSizeMode
  FileSizeMode
#sizeMode) OsPath
fp
  TBQueue FileLog
fileQueue <- Natural -> m (TBQueue FileLog)
forall (m :: Type -> Type) a.
(HasCallStack, MonadSTM m) =>
Natural -> m (TBQueue a)
newTBQueueA Natural
1000

  a
result <-
    OsPath -> IOMode -> (Handle -> m a) -> m a
forall a.
HasCallStack =>
OsPath -> IOMode -> (Handle -> m a) -> m a
forall (m :: Type -> Type) a.
(MonadHandleWriter m, HasCallStack) =>
OsPath -> IOMode -> (Handle -> m a) -> m a
withBinaryFile OsPath
fp IOMode
ioMode ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
      MLogging -> m a
onLogging ((FileLoggingP 'ConfigPhaseMerged, Handle, TBQueue FileLog)
-> MLogging
forall a. a -> Maybe a
Just (FileLoggingP 'ConfigPhaseMerged
fileLogging, Handle
h, TBQueue FileLog
fileQueue))

  -- If the above command succeeded and deleteOnSuccess is true, delete the
  -- log file. Otherwise we will not reach here due to withBinaryFile
  -- rethrowing an exception, so the file will not be deleted.
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (FileLoggingP 'ConfigPhaseMerged
fileLogging FileLoggingP 'ConfigPhaseMerged
-> Optic' A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) Bool
-> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) DeleteOnSuccessSwitch
#deleteOnSuccess Optic'
  A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) DeleteOnSuccessSwitch
-> Optic' An_Iso NoIx DeleteOnSuccessSwitch Bool
-> Optic' A_Lens NoIx (FileLoggingP 'ConfigPhaseMerged) Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic' An_Iso NoIx DeleteOnSuccessSwitch Bool
#boolIso)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ OsPath -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m ()
removeFileIfExists OsPath
fp

  pure a
result

handleLogFileSize ::
  ( HasCallStack,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m
  ) =>
  FileSizeMode ->
  OsPath ->
  m ()
handleLogFileSize :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m, MonadPathWriter m,
 MonadTerminal m) =>
FileSizeMode -> OsPath -> m ()
handleLogFileSize FileSizeMode
fileSizeMode OsPath
fp = do
  Bytes 'B Natural
fileSize <- forall (s :: Size) n. n -> Bytes s n
MkBytes @B (Natural -> Bytes 'B Natural)
-> (Integer -> Natural) -> Integer -> Bytes 'B Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
forall a b.
(Bits a, Bits b, HasCallStack, Integral a, Integral b, Show a,
 Typeable a, Typeable b) =>
a -> b
unsafeConvertIntegral (Integer -> Bytes 'B Natural) -> m Integer -> m (Bytes 'B Natural)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m Integer
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Integer
getFileSize OsPath
fp
  case FileSizeMode
fileSizeMode of
    FileSizeModeWarn Bytes 'B Natural
warnSize ->
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bytes 'B Natural
fileSize Bytes 'B Natural -> Bytes 'B Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Bytes 'B Natural
warnSize)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn
        (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Bytes 'B Natural -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
warnSize Bytes 'B Natural
fileSize
    FileSizeModeDelete Bytes 'B Natural
delSize ->
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bytes 'B Natural
fileSize Bytes 'B Natural -> Bytes 'B Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Bytes 'B Natural
delSize) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Bytes 'B Natural -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
delSize Bytes 'B Natural
fileSize Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Deleting log."
        OsPath -> m ()
forall (m :: Type -> Type).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeFile OsPath
fp
    FileSizeMode
FileSizeModeNothing -> () -> m ()
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
  where
    sizeWarning :: Bytes 'B Natural -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
warnSize Bytes 'B Natural
fileSize =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Warning: log file '",
          String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OsPath -> String
FsUtils.decodeOsToFpShow OsPath
fp,
          Text
"' has size: ",
          Bytes 'B Natural -> Text
formatBytes Bytes 'B Natural
fileSize,
          Text
", but specified threshold is: ",
          Bytes 'B Natural -> Text
formatBytes Bytes 'B Natural
warnSize,
          Text
"."
        ]

    formatBytes :: Bytes 'B Natural -> Text
formatBytes =
      BaseFormatter (Raw (Norm (Bytes 'B Double)))
-> SizedFormatter -> Norm (Bytes 'B Double) -> Text
forall a.
(Formatter (BaseFormatter (Raw a)), PrintfArg (Raw a),
 RawNumeric a, Sized a) =>
BaseFormatter (Raw a) -> SizedFormatter -> a -> Text
formatSized (Maybe Word8 -> FloatingFormatter
MkFloatingFormatter (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
2)) SizedFormatter
sizedFormatterNatural
        (Norm (Bytes 'B Double) -> Text)
-> (Bytes 'B Natural -> Norm (Bytes 'B Double))
-> Bytes 'B Natural
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes 'B Double -> Norm (Bytes 'B Double)
forall a. Normalize a => a -> Norm a
normalize
        -- Convert to double _before_ normalizing. We may lose some precision
        -- here, but it is better than normalizing a natural, which will
        -- truncate (i.e. greater precision loss).
        (Bytes 'B Double -> Norm (Bytes 'B Double))
-> (Bytes 'B Natural -> Bytes 'B Double)
-> Bytes 'B Natural
-> Norm (Bytes 'B Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural -> Double) -> Bytes 'B Natural -> Bytes 'B Double
forall a b. (a -> b) -> Bytes 'B a -> Bytes 'B b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Double
toDouble (Integer -> Double) -> (Natural -> Integer) -> Natural -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b.
(Bits a, Bits b, HasCallStack, Integral a, Integral b, Show a,
 Typeable a, Typeable b) =>
a -> b
unsafeConvertIntegral)

    toDouble :: Integer -> Double
    toDouble :: Integer -> Double
toDouble = Integer -> Double
forall a. Num a => Integer -> a
fromInteger

ensureFileExists ::
  ( HasCallStack,
    MonadFileWriter m,
    MonadPathReader m
  ) =>
  OsPath ->
  m ()
ensureFileExists :: forall (m :: Type -> Type).
(HasCallStack, MonadFileWriter m, MonadPathReader m) =>
OsPath -> m ()
ensureFileExists OsPath
fp = do
  Bool
exists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
fp
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
exists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ OsPath -> Text -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadFileWriter m) =>
OsPath -> Text -> m ()
writeFileUtf8 OsPath
fp Text
""

getShrunXdgState :: (HasCallStack, MonadPathReader m) => m OsPath
getShrunXdgState :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m OsPath
getShrunXdgState = OsPath -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgState [osp|shrun|]

defaultToml :: FilePathDefault -> FileLoggingToml
defaultToml :: FilePathDefault -> FileLoggingP 'ConfigPhaseToml
defaultToml FilePathDefault
path =
  MkFileLoggingP
    { file :: FileLogFileF 'ConfigPhaseToml
file =
        MkFileLogInitP
          { FilePathDefault
FileLogPathF 'ConfigPhaseToml
path :: FileLogPathF 'ConfigPhaseToml
path :: FilePathDefault
path,
            mode :: ConfigPhaseF 'ConfigPhaseToml FileMode
mode = Maybe FileMode
ConfigPhaseF 'ConfigPhaseToml FileMode
forall a. Maybe a
Nothing,
            sizeMode :: ConfigPhaseF 'ConfigPhaseToml FileSizeMode
sizeMode = Maybe FileSizeMode
ConfigPhaseF 'ConfigPhaseToml FileSizeMode
forall a. Maybe a
Nothing
          },
      commandNameTrunc :: ConfigPhaseMaybeF 'ConfigPhaseToml (Truncation 'TruncCommandName)
commandNameTrunc = Maybe (Truncation 'TruncCommandName)
ConfigPhaseMaybeF 'ConfigPhaseToml (Truncation 'TruncCommandName)
forall a. Maybe a
Nothing,
      deleteOnSuccess :: SwitchF 'ConfigPhaseToml DeleteOnSuccessSwitch
deleteOnSuccess = Maybe Bool
SwitchF 'ConfigPhaseToml DeleteOnSuccessSwitch
forall a. Maybe a
Nothing,
      lineTrunc :: LineTruncF 'ConfigPhaseToml
lineTrunc = Maybe LineTruncation
LineTruncF 'ConfigPhaseToml
forall a. Maybe a
Nothing,
      stripControl :: ConfigPhaseF 'ConfigPhaseToml FileLogStripControl
stripControl = Maybe FileLogStripControl
ConfigPhaseF 'ConfigPhaseToml FileLogStripControl
forall a. Maybe a
Nothing
    }