{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

module Navi.Runner
  ( makeEnvAndRun,
    withEnv,
  )
where

import Data.Bytes qualified as Bytes
import Data.Bytes.Formatting (FloatingFormatter (MkFloatingFormatter))
import Data.Functor.Identity (Identity (runIdentity))
import Data.Text qualified as T
import Effects.FileSystem.HandleWriter (MonadHandleWriter (withBinaryFile), die)
import Effects.FileSystem.PathReader qualified as Dir
import Effects.FileSystem.PathWriter (MonadPathWriter)
import Effects.FileSystem.PathWriter qualified as Dir
import Effects.Time (MonadTime)
import Effects.Time qualified as Time
import FileSystem.OsPath (encodeThrowM, encodeValidThrowM)
import GHC.Conc.Sync (setUncaughtExceptionHandler)
import Navi (NaviT, runNavi, runNaviT)
import Navi.Args (Args, getArgs)
import Navi.Config
  ( Config,
    LogLoc (DefPath, File, Stdout),
    Logging,
    NoteSystem (AppleScript, DBus, NotifySend),
    readConfig,
  )
import Navi.Config.Types
  ( FilesSizeMode
      ( FilesSizeModeDelete,
        FilesSizeModeWarn
      ),
    defaultSizeMode,
  )
import Navi.Data.NaviLog
  ( LogEnv
      ( MkLogEnv,
        logHandle,
        logLevel,
        logNamespace,
        logQueue
      ),
  )
import Navi.Effects (MonadSystemInfo)
import Navi.Effects.MonadNotify (MonadNotify)
import Navi.Env.AppleScript (mkAppleScriptEnv)
import Navi.Env.Core (Env)
import Navi.Env.DBus (MonadDBus, mkDBusEnv)
import Navi.Env.NotifySend (mkNotifySendEnv)
import Navi.Prelude

{- ORMOLU_DISABLE -}

makeEnvAndRun ::
  forall m.
  ( HasCallStack,
    MonadAsync m,
    MonadDBus m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadMask m,
    MonadOptparse m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadSTM m,
    MonadSystemInfo m,
    MonadTerminal m,
    MonadThread m,
    MonadTime m,
    MonadTypedProcess m
  ) =>
  m ()
makeEnvAndRun :: forall (m :: Type -> Type).
(HasCallStack, MonadAsync m, MonadDBus m, MonadFileReader m,
 MonadFileWriter m, MonadHandleWriter m, MonadIORef m, MonadMask m,
 MonadOptparse m, MonadPathReader m, MonadPathWriter m, MonadSTM m,
 MonadSystemInfo m, MonadTerminal m, MonadThread m, MonadTime m,
 MonadTypedProcess m) =>
m ()
makeEnvAndRun = (Env -> m ()) -> m ()
forall (m :: Type -> Type) a.
(HasCallStack, MonadAsync m, MonadDBus m, MonadFileReader m,
 MonadFileWriter m, MonadHandleWriter m, MonadIORef m, MonadMask m,
 MonadOptparse m, MonadPathReader m, MonadPathWriter m, MonadSTM m,
 MonadTerminal m, MonadTime m) =>
(Env -> m a) -> m a
withEnv Env -> m ()
forall {k} {env} {f :: Type -> Type} {b}.
(LabelOptic' "namespace" k env Namespace, Is k A_Setter,
 Is k A_Getter, MonadIORef f, MonadHandleWriter f, MonadAsync f,
 HasNoteQueue env, HasLogEnv env, HasEvents env,
 MonadLogger (NaviT env f), MonadMask f, MonadNotify (NaviT env f),
 MonadSTM f, MonadSystemInfo f, MonadTerminal f, MonadThread f) =>
env -> f b
runWithEnv
  where
    runWithEnv :: env -> f b
runWithEnv env
env = Void -> b
forall a. Void -> a
absurd (Void -> b) -> f Void -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NaviT env f Void -> env -> f Void
forall env (m :: Type -> Type) a. NaviT env m a -> env -> m a
runNaviT NaviT env f Void
forall env (m :: Type -> Type) k.
(HasCallStack, HasEvents env, HasLogEnv env, HasNoteQueue env,
 MonadAsync m, MonadHandleWriter m, MonadIORef m,
 MonadLoggerNS m env k, MonadMask m, MonadNotify m, MonadSTM m,
 MonadSystemInfo m, MonadTerminal m, MonadThread m) =>
m Void
runNavi env
env

withEnv ::
  forall m a.
  ( HasCallStack,
    MonadAsync m,
    MonadDBus m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadMask m,
    MonadOptparse m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadSTM m,
    MonadTerminal m,
    MonadTime m
  ) =>
  (Env -> m a) ->
  m a
withEnv :: forall (m :: Type -> Type) a.
(HasCallStack, MonadAsync m, MonadDBus m, MonadFileReader m,
 MonadFileWriter m, MonadHandleWriter m, MonadIORef m, MonadMask m,
 MonadOptparse m, MonadPathReader m, MonadPathWriter m, MonadSTM m,
 MonadTerminal m, MonadTime m) =>
(Env -> m a) -> m a
withEnv Env -> m a
onEnv = do
  Args Identity
args <- m (Args Identity)
forall (m :: Type -> Type).
(HasCallStack, MonadOptparse m, MonadPathReader m) =>
m (Args Identity)
getArgs
  Config
config <-
    Args Identity -> m Config
forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadThrow m) =>
Args Identity -> m Config
tryParseConfig Args Identity
args
      m Config -> (SomeException -> m Config) -> m Config
forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchSync` SomeException -> m Config
forall (m :: Type -> Type) void.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadThrow m) =>
SomeException -> m void
writeConfigErr

  Logging -> (Maybe LogEnv -> m a) -> m a
forall (m :: Type -> Type) a.
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadSTM m, MonadTerminal m, MonadThrow m,
 MonadTime m) =>
Logging -> (Maybe LogEnv -> m a) -> m a
withLogEnv (Config
config Config -> Optic' A_Lens NoIx Config Logging -> Logging
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Config Logging
#logging) ((Maybe LogEnv -> m a) -> m a) -> (Maybe LogEnv -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Maybe LogEnv
logEnv -> do
    let mkNaviEnv :: (Maybe LogEnv -> Config -> m env) -> m env
        mkNaviEnv :: forall env. (Maybe LogEnv -> Config -> m env) -> m env
mkNaviEnv Maybe LogEnv -> Config -> m env
envFn = Maybe LogEnv -> Config -> m env
envFn Maybe LogEnv
logEnv Config
config
    case Config
config Config
-> Optic' A_Lens NoIx Config (NoteSystem 'ConfigPhaseToml)
-> NoteSystem 'ConfigPhaseToml
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Config (NoteSystem 'ConfigPhaseToml)
#noteSystem of
#if OSX
      AppleScript -> mkNaviEnv mkAppleScriptEnv >>= onEnv
      DBus () -> throwText "Detected osx, but DBus is only available on linux!"
      NotifySend -> throwText "Detected osx, but NotifySend is only available on linux!"
#else
      NoteSystem 'ConfigPhaseToml
AppleScript -> Text -> m a
forall (m :: Type -> Type) a.
(HasCallStack, MonadThrow m) =>
Text -> m a
throwText Text
"Detected linux, but AppleScript is only available on osx!"
      DBus () -> (Maybe LogEnv -> Config -> m Env) -> m Env
forall env. (Maybe LogEnv -> Config -> m env) -> m env
mkNaviEnv Maybe LogEnv -> Config -> m Env
forall (m :: Type -> Type).
(HasCallStack, MonadDBus m, MonadSTM m) =>
Maybe LogEnv -> Config -> m Env
mkDBusEnv m Env -> (Env -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> m a
onEnv
      NoteSystem 'ConfigPhaseToml
NotifySend -> (Maybe LogEnv -> Config -> m Env) -> m Env
forall env. (Maybe LogEnv -> Config -> m env) -> m env
mkNaviEnv Maybe LogEnv -> Config -> m Env
forall (m :: Type -> Type).
MonadSTM m =>
Maybe LogEnv -> Config -> m Env
mkNotifySendEnv m Env -> (Env -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> m a
onEnv
#endif
  --where
  --  runWithEnv env = absurd <$> runNaviT runNavi env

{- ORMOLU_ENABLE -}

tryParseConfig ::
  ( HasCallStack,
    MonadFileReader m,
    MonadIORef m,
    MonadThrow m
  ) =>
  Args Identity ->
  m Config
tryParseConfig :: forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadThrow m) =>
Args Identity -> m Config
tryParseConfig =
  OsPath -> m Config
forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadThrow m) =>
OsPath -> m Config
readConfig
    (OsPath -> m Config)
-> (Args Identity -> OsPath) -> Args Identity -> m Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity OsPath -> OsPath
forall a. Identity a -> a
runIdentity
    (Identity OsPath -> OsPath)
-> (Args Identity -> Identity OsPath) -> Args Identity -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Optic' An_Iso NoIx (Args Identity) (Identity OsPath)
-> Args Identity -> Identity OsPath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx (Args Identity) (Identity OsPath)
#configFile

withLogEnv ::
  ( HasCallStack,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadSTM m,
    MonadTerminal m,
    MonadThrow m,
    MonadTime m
  ) =>
  Logging ->
  (Maybe LogEnv -> m a) ->
  m a
withLogEnv :: forall (m :: Type -> Type) a.
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadSTM m, MonadTerminal m, MonadThrow m,
 MonadTime m) =>
Logging -> (Maybe LogEnv -> m a) -> m a
withLogEnv Logging
logging Maybe LogEnv -> m a
onLogEnv = do
  case Logging
logging Logging
-> Optic' A_Lens NoIx Logging (Maybe LogLevel) -> Maybe LogLevel
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Logging (Maybe LogLevel)
#severity of
    Maybe LogLevel
Nothing -> Maybe LogEnv -> m a
onLogEnv Maybe LogEnv
forall a. Maybe a
Nothing
    Just LogLevel
logLevel -> do
      TBQueue LogStr
logQueue <- Natural -> m (TBQueue LogStr)
forall (m :: Type -> Type) a.
(HasCallStack, MonadSTM m) =>
Natural -> m (TBQueue a)
newTBQueueA Natural
1000
      Logging -> (Maybe Handle -> m a) -> m a
forall (m :: Type -> Type) a.
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadTerminal m, MonadThrow m, MonadTime m) =>
Logging -> (Maybe Handle -> m a) -> m a
withLogHandle Logging
logging ((Maybe Handle -> m a) -> m a) -> (Maybe Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
logHandle ->
        Maybe LogEnv -> m a
onLogEnv
          (Maybe LogEnv -> m a) -> Maybe LogEnv -> m a
forall a b. (a -> b) -> a -> b
$ LogEnv -> Maybe LogEnv
forall a. a -> Maybe a
Just
          (LogEnv -> Maybe LogEnv) -> LogEnv -> Maybe LogEnv
forall a b. (a -> b) -> a -> b
$ MkLogEnv
            { Maybe Handle
logHandle :: Maybe Handle
logHandle :: Maybe Handle
logHandle,
              LogLevel
logLevel :: LogLevel
logLevel :: LogLevel
logLevel,
              logNamespace :: Namespace
logNamespace = Namespace
"main",
              TBQueue LogStr
logQueue :: TBQueue LogStr
logQueue :: TBQueue LogStr
logQueue
            }

withLogHandle ::
  ( HasCallStack,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m,
    MonadThrow m,
    MonadTime m
  ) =>
  Logging ->
  (Maybe Handle -> m a) ->
  m a
withLogHandle :: forall (m :: Type -> Type) a.
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadTerminal m, MonadThrow m, MonadTime m) =>
Logging -> (Maybe Handle -> m a) -> m a
withLogHandle Logging
logging Maybe Handle -> m a
onMHandle = do
  case LogLoc
logLoc' of
    -- Log location defined in config file as stdout.
    LogLoc
Stdout -> Maybe Handle -> m a
onMHandle Maybe Handle
forall a. Maybe a
Nothing
    -- Custom log path.
    File OsPath
f -> do
      OsPath -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadThrow m) =>
OsPath -> m ()
renameIfExists OsPath
f
      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
f IOMode
WriteMode ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Maybe Handle -> m a
onMHandle (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h)
    -- Use the default log path: xdgState </> navi/log
    LogLoc
DefPath -> do
      OsPath
xdgState <- OsPath -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
Dir.getXdgState [osp|navi|]

      -- handle large log dir
      OsPath -> FilesSizeMode -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m, MonadPathWriter m,
 MonadTerminal m) =>
OsPath -> FilesSizeMode -> m ()
handleLogSize OsPath
xdgState FilesSizeMode
sizeMode

      OsPath
currTimeOs <-
        String -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
String -> m OsPath
encodeValidThrowM
          (String -> m OsPath) -> (String -> String) -> String -> m OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
replaceSpc
          (String -> m OsPath) -> m String -> m OsPath
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< m String
forall (m :: Type -> Type). (HasCallStack, MonadTime m) => m String
Time.getSystemTimeString
      let logFile :: OsPath
logFile = OsPath
xdgState OsPath -> OsPath -> OsPath
</> OsPath
currTimeOs OsPath -> OsPath -> OsPath
forall a. Semigroup a => a -> a -> a
<> [osp|.log|]
      Bool
stateExists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesDirectoryExist OsPath
xdgState
      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 ()
Dir.createDirectoryIfMissing Bool
True OsPath
xdgState)

      OsPath -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadThrow m) =>
OsPath -> m ()
renameIfExists OsPath
logFile
      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
logFile IOMode
WriteMode ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Maybe Handle -> m a
onMHandle (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h)
  where
    logLoc' :: LogLoc
logLoc' = LogLoc -> Maybe LogLoc -> LogLoc
forall a. a -> Maybe a -> a
fromMaybe LogLoc
DefPath (Logging
logging Logging
-> Optic' A_Lens NoIx Logging (Maybe LogLoc) -> Maybe LogLoc
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Logging (Maybe LogLoc)
#location)
    sizeMode :: FilesSizeMode
sizeMode = FilesSizeMode -> Maybe FilesSizeMode -> FilesSizeMode
forall a. a -> Maybe a -> a
fromMaybe FilesSizeMode
defaultSizeMode (Logging
logging Logging
-> Optic' A_Lens NoIx Logging (Maybe FilesSizeMode)
-> Maybe FilesSizeMode
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Logging (Maybe FilesSizeMode)
#sizeMode)

    replaceSpc :: Char -> Char
replaceSpc Char
' ' = Char
'_'
    replaceSpc Char
x = Char
x

writeConfigErr ::
  ( HasCallStack,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadThrow m
  ) =>
  SomeException ->
  m void
writeConfigErr :: forall (m :: Type -> Type) void.
(HasCallStack, MonadFileWriter m, MonadHandleWriter m,
 MonadPathReader m, MonadPathWriter m, MonadThrow m) =>
SomeException -> m void
writeConfigErr SomeException
ex = do
  OsPath
xdgBase <- OsPath -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
Dir.getXdgState [osp|navi|]
  let logFile :: OsPath
logFile = OsPath
xdgBase OsPath -> OsPath -> OsPath
</> [osp|config_fatal.log|]
  OsPath -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadThrow m) =>
OsPath -> m ()
renameIfExists OsPath
logFile
  OsPath -> Text -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadFileWriter m) =>
OsPath -> Text -> m ()
writeFileUtf8 OsPath
logFile (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Couldn't read config: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
displayExceptiont SomeException
ex
  SomeException -> m void
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SomeException
ex

renameIfExists ::
  ( HasCallStack,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadThrow m
  ) =>
  OsPath ->
  m ()
renameIfExists :: forall (m :: Type -> Type).
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadPathWriter m, MonadThrow m) =>
OsPath -> m ()
renameIfExists OsPath
fp = do
  Bool
fileExists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesFileExist OsPath
fp
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
fileExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    OsPath
fp' <- OsPath -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadThrow m) =>
OsPath -> m OsPath
uniqName OsPath
fp
    OsPath -> OsPath -> m ()
forall (m :: Type -> Type).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
Dir.renameFile OsPath
fp OsPath
fp'

uniqName ::
  forall m.
  ( HasCallStack,
    MonadHandleWriter m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  OsPath ->
  m OsPath
uniqName :: forall (m :: Type -> Type).
(HasCallStack, MonadHandleWriter m, MonadPathReader m,
 MonadThrow m) =>
OsPath -> m OsPath
uniqName OsPath
fp = Word16 -> m OsPath
go Word16
1
  where
    go :: Word16 -> m OsPath
    go :: Word16 -> m OsPath
go !Word16
counter
      | Word16
counter Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
forall a. Bounded a => a
maxBound = String -> m OsPath
forall (m :: Type -> Type) a.
(HasCallStack, MonadHandleWriter m, MonadThrow m) =>
String -> m a
die (String -> m OsPath) -> String -> m OsPath
forall a b. (a -> b) -> a -> b
$ String
"Failed renaming file: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OsPath -> String
forall a. Show a => a -> String
show OsPath
fp
      | Bool
otherwise = do
          OsPath
fp' <- (OsPath
fp OsPath -> OsPath -> OsPath
forall a. Semigroup a => a -> a -> a
<>) (OsPath -> OsPath) -> m OsPath -> m OsPath
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
String -> m OsPath
encodeThrowM (Word16 -> String
forall a. Show a => a -> String
show Word16
counter)
          Bool
b <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
Dir.doesFileExist OsPath
fp'
          if Bool
b
            then Word16 -> m OsPath
go (Word16
counter Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1)
            else OsPath -> m OsPath
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OsPath
fp'

handleLogSize ::
  ( HasCallStack,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m
  ) =>
  OsPath ->
  FilesSizeMode ->
  m ()
handleLogSize :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m, MonadPathWriter m,
 MonadTerminal m) =>
OsPath -> FilesSizeMode -> m ()
handleLogSize OsPath
naviState FilesSizeMode
sizeMode = do
  -- NOTE: Only files should be logs
  [OsPath]
logFiles <- OsPath -> m [OsPath]
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
Dir.listDirectory OsPath
naviState
  Integer
totalBytes <-
    (m Integer -> OsPath -> m Integer)
-> m Integer -> [OsPath] -> m Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
      (\m Integer
macc OsPath
path -> (Integer -> Integer -> Integer)
-> m Integer -> m Integer -> m Integer
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) m Integer
macc (OsPath -> m Integer
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Integer
Dir.getFileSize (OsPath
naviState OsPath -> OsPath -> OsPath
</> OsPath
path)))
      (Integer -> m Integer
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Integer
0)
      [OsPath]
logFiles
  let totalBytes' :: Bytes 'B Natural
totalBytes' = forall (s :: Size) n. n -> Bytes s n
MkBytes @B @Natural (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
totalBytes)

  case FilesSizeMode
sizeMode of
    FilesSizeModeWarn Bytes 'B Natural
warnSize ->
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bytes 'B Natural
totalBytes' 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 -> OsPath -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
warnSize OsPath
naviState Bytes 'B Natural
totalBytes'
    FilesSizeModeDelete Bytes 'B Natural
delSize ->
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bytes 'B Natural
totalBytes' 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 -> OsPath -> Bytes 'B Natural -> Text
sizeWarning Bytes 'B Natural
delSize OsPath
naviState Bytes 'B Natural
totalBytes' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Deleting logs."
        OsPath -> m ()
forall (m :: Type -> Type).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
Dir.removeDirectoryRecursive OsPath
naviState
        Bool -> OsPath -> m ()
forall (m :: Type -> Type).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
Dir.createDirectoryIfMissing Bool
False OsPath
naviState
  where
    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
forall a. Show a => a -> Text
showt 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
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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Natural @Double)