{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- | This modules provides an executable for running charon.
module Charon.Runner
  ( -- * Main functions
    runCharon,
    runCmd,

    -- * Helpers
    getConfiguration,
  )
where

import Charon qualified
import Charon.Backend.Data (Backend (BackendCbor))
import Charon.Data.Index qualified as Index
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex (TrashHome),
  )
import Charon.Env (HasBackend, HasTrashHome)
import Charon.Env qualified as Env
import Charon.Prelude
import Charon.Runner.Args
  ( TomlConfigPath
      ( TomlDefault,
        TomlNone,
        TomlPath
      ),
    getArgs,
  )
import Charon.Runner.CharonT (runCharonT)
import Charon.Runner.Command
  ( Command
      ( Convert,
        Delete,
        Empty,
        List,
        Merge,
        Metadata,
        PermDelete,
        Restore
      ),
    CommandP2,
  )
import Charon.Runner.Command.List (ListCmdP2)
import Charon.Runner.Env
  ( Env (MkEnv, backend, trashHome),
    LogEnv (MkLogEnv),
    LogFile (MkLogFile),
    handle,
    logEnv,
    logFile,
    logLevel,
    logNamespace,
  )
import Charon.Runner.FileSizeMode (FileSizeMode (..))
import Charon.Runner.FileSizeMode qualified as FileSizeMode
import Charon.Runner.Toml (TomlConfig, defaultTomlConfig, mergeConfigs)
import Charon.Utils qualified as U
import Data.Bytes (FloatingFormatter (MkFloatingFormatter))
import Data.Bytes qualified as Bytes
import Data.Text qualified as T
import Effects.FileSystem.HandleWriter (withBinaryFile)
import Effects.FileSystem.PathReader (getXdgData, getXdgState)
import Effects.FileSystem.PathWriter (MonadPathWriter (removeFile))
import TOML qualified

-- | Entry point for running Charon. Does everything: reads CLI args,
-- optional Toml config, and creates the environment before running
-- Charon.
runCharon ::
  ( HasCallStack,
    MonadAsync m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadMask m,
    MonadOptparse m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixCompat m,
    MonadTerminal m,
    MonadTime m
  ) =>
  m ()
runCharon :: forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadFileReader m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadOptparse m,
 MonadPathReader m, MonadPathWriter m, MonadPosixCompat m,
 MonadTerminal m, MonadTime m) =>
m ()
runCharon = do
  (TomlConfig
config, CommandP2
cmd) <- m (TomlConfig, CommandP2)
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadOptparse m,
 MonadPathReader m, MonadThrow m) =>
m (TomlConfig, CommandP2)
getConfiguration
  TomlConfig -> (Env m -> m ()) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadTerminal m) =>
TomlConfig -> (Env m -> m a) -> m a
withEnv TomlConfig
config (CharonT (Env m) m () -> Env m -> m ()
forall env (m :: * -> *) a. CharonT env m a -> env -> m a
runCharonT (CharonT (Env m) m () -> Env m -> m ())
-> CharonT (Env m) m () -> Env m -> m ()
forall a b. (a -> b) -> a -> b
$ CommandP2 -> CharonT (Env m) m ()
forall (m :: * -> *) env.
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadLoggerNS m, MonadFileReader m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadPathReader m,
 MonadPathWriter m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m, MonadTime m) =>
CommandP2 -> m ()
runCmd CommandP2
cmd)

-- | Runs Charon in the given environment. This is useful in conjunction with
-- 'getConfiguration' as an alternative 'runCharon', when we want to use a
-- custom env.
runCmd ::
  forall m env.
  ( HasBackend env,
    HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadLoggerNS m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadMask m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m,
    MonadTime m
  ) =>
  CommandP2 ->
  m ()
runCmd :: forall (m :: * -> *) env.
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadLoggerNS m, MonadFileReader m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadPathReader m,
 MonadPathWriter m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m, MonadTime m) =>
CommandP2 -> m ()
runCmd CommandP2
cmd =
  -- NOTE: This adds a callstack to any thrown exceptions e.g. exitFailure.
  -- This is what we want, as it similar to what we will get once GHC
  -- natively supports exceptions with callstacks.
  CommandP2 -> m ()
runCmd' CommandP2
cmd m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadCatch m) =>
m a -> (e -> m a) -> m a
`catchCS` SomeException -> m ()
forall a. HasCallStack => SomeException -> m a
logEx
  where
    runCmd' :: CommandP2 -> m ()
runCmd' = \case
      Delete UniqueSeqNE (PathI 'TrashEntryOriginalPath)
paths -> UniqueSeqNE (PathI 'TrashEntryOriginalPath) -> m ()
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadFileWriter m, MonadIORef m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m,
 MonadTime m) =>
UniqueSeqNE (PathI 'TrashEntryOriginalPath) -> m ()
Charon.delete UniqueSeqNE (PathI 'TrashEntryOriginalPath)
paths
      PermDelete Bool
force UniqueSeqNE (PathI 'TrashEntryFileName)
paths -> Bool -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadPathReader m,
 MonadPathWriter m, MonadPosixCompat m, MonadLoggerNS m,
 MonadReader env m, MonadTerminal m, MonadTime m) =>
Bool -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
Charon.permDelete Bool
force UniqueSeqNE (PathI 'TrashEntryFileName)
paths
      Empty Bool
force -> Bool -> m ()
forall (m :: * -> *) env.
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadHandleWriter m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m) =>
Bool -> m ()
Charon.emptyTrash Bool
force
      Restore UniqueSeqNE (PathI 'TrashEntryFileName)
paths -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadFileWriter m, MonadIORef m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m,
 MonadTime m) =>
UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
Charon.restore UniqueSeqNE (PathI 'TrashEntryFileName)
paths
      List ListCmd 'Phase2
listCmd -> ListCmd 'Phase2 -> m ()
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m) =>
ListCmd 'Phase2 -> m ()
printIndex ListCmd 'Phase2
listCmd
      CommandP2
Metadata -> m ()
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m) =>
m ()
printMetadata
      Convert Backend
dest -> Backend -> m ()
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadFileReader m, MonadFileWriter m, MonadIORef m,
 MonadLoggerNS m, MonadMask m, MonadPathReader m, MonadPathWriter m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m,
 MonadTime m) =>
Backend -> m ()
Charon.convert Backend
dest
      Merge PathI 'TrashHome
dest -> PathI 'TrashHome -> m ()
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadFileReader m,
 MonadFileWriter m, MonadIORef m, MonadLoggerNS m, MonadMask m,
 MonadPathReader m, MonadPathWriter m, MonadReader env m,
 MonadTerminal m, MonadTime m) =>
PathI 'TrashHome -> m ()
Charon.merge PathI 'TrashHome
dest

    logEx :: (HasCallStack) => SomeException -> m a
    logEx :: forall a. HasCallStack => SomeException -> m a
logEx SomeException
ex = do
      $(logError) (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall e. Exception e => e -> String
displayNoCS SomeException
ex)
      SomeException -> m a
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS SomeException
ex

withEnv ::
  ( HasCallStack,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m
  ) =>
  TomlConfig ->
  (Env m -> m a) ->
  m a
withEnv :: forall (m :: * -> *) a.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadTerminal m) =>
TomlConfig -> (Env m -> m a) -> m a
withEnv TomlConfig
mergedConfig Env m -> m a
onEnv = do
  PathI 'TrashHome
trashHome <- Maybe (PathI 'TrashHome) -> m (PathI 'TrashHome)
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
Maybe (PathI 'TrashHome) -> m (PathI 'TrashHome)
trashOrDefault (Maybe (PathI 'TrashHome) -> m (PathI 'TrashHome))
-> Maybe (PathI 'TrashHome) -> m (PathI 'TrashHome)
forall a b. (a -> b) -> a -> b
$ TomlConfig
mergedConfig TomlConfig
-> Optic' A_Lens NoIx TomlConfig (Maybe (PathI 'TrashHome))
-> Maybe (PathI 'TrashHome)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TomlConfig (Maybe (PathI 'TrashHome))
#trashHome

  Maybe FileSizeMode -> (Handle -> m a) -> m a
forall (m :: * -> *) a.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadTerminal m) =>
Maybe FileSizeMode -> (Handle -> m a) -> m a
withLogHandle (TomlConfig
mergedConfig TomlConfig
-> Optic' A_Lens NoIx TomlConfig (Maybe FileSizeMode)
-> Maybe FileSizeMode
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TomlConfig (Maybe FileSizeMode)
#logSizeMode) ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
    let logFile :: Maybe (LogFile m)
logFile =
          Maybe (Maybe LogLevel) -> Maybe LogLevel
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (TomlConfig
mergedConfig TomlConfig
-> Optic' A_Lens NoIx TomlConfig (Maybe (Maybe LogLevel))
-> Maybe (Maybe LogLevel)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TomlConfig (Maybe (Maybe LogLevel))
#logLevel) Maybe LogLevel -> (LogLevel -> LogFile m) -> Maybe (LogFile m)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \LogLevel
logLevel ->
            MkLogFile
              { Handle
$sel:handle:MkLogFile :: Handle
handle :: Handle
handle,
                LogLevel
$sel:logLevel:MkLogFile :: LogLevel
logLevel :: LogLevel
logLevel
              }
     in Env m -> m a
onEnv
          (Env m -> m a) -> Env m -> m a
forall a b. (a -> b) -> a -> b
$ MkEnv
            { PathI 'TrashHome
$sel:trashHome:MkEnv :: PathI 'TrashHome
trashHome :: PathI 'TrashHome
trashHome,
              $sel:backend:MkEnv :: Backend
backend = Backend -> Maybe Backend -> Backend
forall a. a -> Maybe a -> a
fromMaybe Backend
BackendCbor (TomlConfig
mergedConfig TomlConfig
-> Optic' A_Lens NoIx TomlConfig (Maybe Backend) -> Maybe Backend
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx TomlConfig (Maybe Backend)
#backend),
              $sel:logEnv:MkEnv :: LogEnv m
logEnv =
                MkLogEnv
                  { Maybe (LogFile m)
$sel:logFile:MkLogEnv :: Maybe (LogFile m)
logFile :: Maybe (LogFile m)
logFile,
                    $sel:logNamespace:MkLogEnv :: Namespace
logNamespace = Namespace
"main"
                  }
            }

-- | Parses CLI 'Args' and optional 'TomlConfig' to produce the user
-- configuration. For values shared between the CLI and Toml file, the CLI
-- takes priority.
--
-- For example, if both the CLI and Toml file specify the trash home, then
-- the CLI's value will be used.
getConfiguration ::
  ( HasCallStack,
    MonadFileReader m,
    MonadOptparse m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  m (TomlConfig, CommandP2)
getConfiguration :: forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadOptparse m,
 MonadPathReader m, MonadThrow m) =>
m (TomlConfig, CommandP2)
getConfiguration = do
  -- get CLI args
  Args
args <- m Args
forall (m :: * -> *). MonadOptparse m => m Args
getArgs

  -- get toml config
  TomlConfig
tomlConfig <- case Args
args Args -> Optic' A_Lens NoIx Args TomlConfigPath -> TomlConfigPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Args TomlConfigPath
#tomlConfigPath of
    -- 1. explicit toml config path given: read
    TomlPath OsPath
tomlPath -> OsPath -> m TomlConfig
forall {m :: * -> *} {b}.
(MonadFileReader m, MonadThrow m, DecodeTOML b) =>
OsPath -> m b
readConfig OsPath
tomlPath
    -- no toml config path given...
    TomlConfigPath
TomlDefault -> do
      OsPath
xdgConfig <- OsPath -> m OsPath
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgConfig OsPath
charonPath
      let defPath :: OsPath
defPath = OsPath
xdgConfig OsPath -> OsPath -> OsPath
</> [osp|config.toml|]
      Bool
exists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
defPath
      if Bool
exists
        then -- 2. config exists at default path: read
          OsPath -> m TomlConfig
forall {m :: * -> *} {b}.
(MonadFileReader m, MonadThrow m, DecodeTOML b) =>
OsPath -> m b
readConfig OsPath
defPath
        else -- 3. no config exists: return default (empty)
          TomlConfig -> m TomlConfig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TomlConfig
defaultTomlConfig
    -- 4. toml explicitly disabled
    TomlConfigPath
TomlNone -> TomlConfig -> m TomlConfig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TomlConfig
defaultTomlConfig

  -- merge shared CLI and toml values
  (TomlConfig, CommandP2) -> m (TomlConfig, CommandP2)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TomlConfig, CommandP2) -> m (TomlConfig, CommandP2))
-> (TomlConfig, CommandP2) -> m (TomlConfig, CommandP2)
forall a b. (a -> b) -> a -> b
$ Args -> TomlConfig -> (TomlConfig, CommandP2)
mergeConfigs Args
args TomlConfig
tomlConfig
  where
    readConfig :: OsPath -> m b
readConfig OsPath
fp = do
      Text
contents <- OsPath -> m Text
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadThrow m) =>
OsPath -> m Text
readFileUtf8ThrowM OsPath
fp
      case Text -> Either TOMLError b
forall a. DecodeTOML a => Text -> Either TOMLError a
TOML.decode Text
contents of
        Right b
cfg -> b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
cfg
        Left TOMLError
tomlErr -> TOMLError -> m b
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS TOMLError
tomlErr

printIndex ::
  ( HasBackend env,
    HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m
  ) =>
  ListCmdP2 ->
  m ()
printIndex :: forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m) =>
ListCmd 'Phase2 -> m ()
printIndex ListCmd 'Phase2
listCmd = do
  Index
index <- m Index
forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m) =>
m Index
Charon.getIndex
  Text
formatted <- ListCmd 'Phase2 -> Index -> m Text
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadLoggerNS m,
 MonadTerminal m) =>
ListCmd 'Phase2 -> Index -> m Text
Index.formatIndex ListCmd 'Phase2
listCmd Index
index
  Text -> m ()
forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn Text
formatted

printMetadata ::
  ( HasBackend env,
    HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m
  ) =>
  m ()
printMetadata :: forall env (m :: * -> *).
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m) =>
m ()
printMetadata = m Metadata
forall (m :: * -> *) env.
(HasBackend env, HasCallStack, HasTrashHome env, MonadAsync m,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadReader env m,
 MonadTerminal m) =>
m Metadata
Charon.getMetadata m Metadata -> (Metadata -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Metadata -> m ()
forall a (m :: * -> *). (Pretty a, MonadTerminal m) => a -> m ()
prettyDel

prettyDel :: (Pretty a, MonadTerminal m) => a -> m ()
prettyDel :: forall a (m :: * -> *). (Pretty a, MonadTerminal m) => a -> m ()
prettyDel = Text -> m ()
forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn (Text -> m ()) -> (a -> Text) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Pretty a => a -> Text
U.renderPretty

-- | If the argument is given, returns it. Otherwise searches for the default
-- trash location.
trashOrDefault ::
  ( HasCallStack,
    MonadPathReader m
  ) =>
  Maybe (PathI TrashHome) ->
  m (PathI TrashHome)
trashOrDefault :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
Maybe (PathI 'TrashHome) -> m (PathI 'TrashHome)
trashOrDefault = m (PathI 'TrashHome)
-> (PathI 'TrashHome -> m (PathI 'TrashHome))
-> Maybe (PathI 'TrashHome)
-> m (PathI 'TrashHome)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (PathI 'TrashHome)
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
m (PathI 'TrashHome)
getTrashHome PathI 'TrashHome -> m (PathI 'TrashHome)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Retrieves the default trash directory.
getTrashHome ::
  ( HasCallStack,
    MonadPathReader m
  ) =>
  m (PathI TrashHome)
getTrashHome :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
m (PathI 'TrashHome)
getTrashHome = OsPath -> PathI 'TrashHome
forall (i :: PathIndex). OsPath -> PathI i
MkPathI (OsPath -> PathI 'TrashHome) -> m OsPath -> m (PathI 'TrashHome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OsPath -> m OsPath
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgData OsPath
charonPath)

withLogHandle ::
  ( HasCallStack,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m
  ) =>
  Maybe FileSizeMode ->
  (Handle -> m a) ->
  m a
withLogHandle :: forall (m :: * -> *) a.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadTerminal m) =>
Maybe FileSizeMode -> (Handle -> m a) -> m a
withLogHandle Maybe FileSizeMode
sizeMode Handle -> m a
onHandle = do
  OsPath
xdgState <- OsPath -> m OsPath
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgState OsPath
charonPath
  Bool -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
True OsPath
xdgState

  MkPathI OsPath
logPath <- m (PathI 'TrashLog)
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
m (PathI 'TrashLog)
Env.getTrashLog

  OsPath -> Maybe FileSizeMode -> m ()
forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m,
 MonadTerminal m) =>
OsPath -> Maybe FileSizeMode -> m ()
handleLogSize OsPath
logPath Maybe FileSizeMode
sizeMode

  OsPath -> IOMode -> (Handle -> m a) -> m a
forall a.
HasCallStack =>
OsPath -> IOMode -> (Handle -> m a) -> m a
forall (m :: * -> *) a.
(MonadHandleWriter m, HasCallStack) =>
OsPath -> IOMode -> (Handle -> m a) -> m a
withBinaryFile OsPath
logPath IOMode
AppendMode Handle -> m a
onHandle

handleLogSize ::
  ( HasCallStack,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m
  ) =>
  OsPath ->
  Maybe FileSizeMode ->
  m ()
handleLogSize :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m,
 MonadTerminal m) =>
OsPath -> Maybe FileSizeMode -> m ()
handleLogSize OsPath
logFile Maybe FileSizeMode
msizeMode = do
  Bool
logExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
logFile
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
logExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Integer
logSize <- OsPath -> m Integer
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Integer
getFileSize OsPath
logFile
    let logSize' :: Bytes 'B Natural
logSize' = Natural -> Bytes 'B Natural
forall (s :: Size) n. n -> Bytes s n
MkBytes (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
logSize)

    case FileSizeMode
sizeMode of
      FileSizeModeWarn Bytes 'B Natural
warnSize ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bytes 'B Natural
logSize' 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 :: * -> *).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn
          (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Bytes 'B Natural -> OsPath -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
warnSize OsPath
logFile Bytes 'B Natural
logSize'
      FileSizeModeDelete Bytes 'B Natural
delSize ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bytes 'B Natural
logSize' 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 :: * -> *).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Bytes 'B Natural -> OsPath -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
delSize OsPath
logFile Bytes 'B Natural
logSize' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Deleting log."
          OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeFile OsPath
logFile
  where
    sizeMode :: FileSizeMode
sizeMode = FileSizeMode -> Maybe FileSizeMode -> FileSizeMode
forall a. a -> Maybe a -> a
fromMaybe FileSizeMode
FileSizeMode.defaultSizeMode Maybe FileSizeMode
msizeMode
    sizeWarning :: Bytes 'B Natural -> OsPath -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
warnSize OsPath
fp Bytes 'B Natural
fileSize =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Warning: log dir ",
          OsPath -> Text
decodeOsToFpDisplayExT 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 (Unwrapped (Norm (Bytes 'B Double)))
-> SizedFormatter -> Norm (Bytes 'B Double) -> Text
forall a.
(Formatter (BaseFormatter (Unwrapped a)), PrintfArg (Unwrapped a),
 Sized a, Unwrapper a) =>
BaseFormatter (Unwrapped a) -> SizedFormatter -> a -> Text
Bytes.formatSized (Maybe Word8 -> FloatingFormatter
MkFloatingFormatter (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
2)) SizedFormatter
Bytes.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
Bytes.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 :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Natural @Double)

charonPath :: OsPath
charonPath :: OsPath
charonPath = [osp|charon|]