{-# LANGUAGE TemplateHaskell #-}

-- | This module (and sub-hierarchy) provides logic that can be used by any
-- backend (i.e. cbor, fdo, json) that has the following structure:
--
-- @
--   trash/paths/ (paths)
--   trash/info/  (info files)
-- @
--
-- The only difference is in the (de)serialization.
module Charon.Backend.Default
  ( -- * Delete
    delete,
    deletePostHook,
    permDelete,
    permDeletePostHook,
    emptyTrash,

    -- * Restore
    restore,
    restorePostHook,

    -- * Information
    getIndex,
    getMetadata,

    -- * Transformations
    merge,
  )
where

import Charon.Backend.Default.BackendArgs (BackendArgs)
import Charon.Backend.Default.Index qualified as Default.Index
import Charon.Backend.Default.Trash qualified as Trash
import Charon.Backend.Default.Utils qualified as Default.Utils
import Charon.Class.Serial (Serial (DecodeExtra))
import Charon.Data.Index (Index)
import Charon.Data.Index qualified as Index
import Charon.Data.Metadata (Metadata (MkMetadata))
import Charon.Data.Metadata qualified as Metadata
import Charon.Data.PathData (PathData)
import Charon.Data.PathType (PathTypeW)
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex
      ( TrashEntryFileName,
        TrashEntryOriginalPath,
        TrashEntryPath,
        TrashHome
      ),
  )
import Charon.Data.Paths qualified as Paths
import Charon.Data.Timestamp (Timestamp (MkTimestamp))
import Charon.Data.UniqueSeqNE (UniqueSeqNE)
import Charon.Data.UniqueSeqNE qualified as USeqNE
import Charon.Env (HasTrashHome (getTrashHome))
import Charon.Env qualified as Env
import Charon.Prelude
import Charon.Utils qualified as Utils
import Data.Bytes qualified as Bytes
import Data.Char qualified as Ch
import Data.Text qualified as T
import Effects.System.Terminal qualified as Term
import Effects.Time (getSystemTime)
import Numeric.Algebra.Additive.AMonoid (AMonoid (zero))
import Numeric.Algebra.Additive.ASemigroup (ASemigroup ((.+.)))
import Numeric.Literal.Rational (FromRational (afromRational))

-- NOTE: For functions that can encounter multiple exceptions, the first
-- one is rethrown.

-- | @delete trash p@ moves path @p@ to the given trash location @trash@ and
-- writes an entry in the trash index. If the trash location is not given,
-- defaults to XDG data e.g. @~\/.local/share/charon/@.
delete ::
  forall m env pd k.
  ( HasCallStack,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    LabelOptic' "originalPath" k pd (PathI TrashEntryOriginalPath),
    HasTrashHome env,
    MonadCatch m,
    MonadFileWriter m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTerminal m,
    MonadTime m,
    Serial pd,
    Show pd
  ) =>
  BackendArgs m pd ->
  UniqueSeqNE (PathI TrashEntryOriginalPath) ->
  m ()
delete :: forall (m :: * -> *) env pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 LabelOptic' "originalPath" k pd (PathI 'TrashEntryOriginalPath),
 HasTrashHome env, MonadCatch m, MonadFileWriter m, MonadIORef m,
 MonadLoggerNS m, MonadPathWriter m, MonadReader env m,
 MonadTerminal m, MonadTime m, Serial pd, Show pd) =>
BackendArgs m pd
-> UniqueSeqNE (PathI 'TrashEntryOriginalPath) -> m ()
delete BackendArgs m pd
backendArgs = BackendArgs m pd
-> ((pd, PathTypeW, PathI 'TrashEntryPath) -> m ())
-> UniqueSeqNE (PathI 'TrashEntryOriginalPath)
-> m ()
forall (m :: * -> *) env pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 LabelOptic' "originalPath" k pd (PathI 'TrashEntryOriginalPath),
 HasTrashHome env, MonadCatch m, MonadFileWriter m, MonadIORef m,
 MonadLoggerNS m, MonadPathWriter m, MonadReader env m,
 MonadTerminal m, MonadTime m, Serial pd, Show pd) =>
BackendArgs m pd
-> ((pd, PathTypeW, PathI 'TrashEntryPath) -> m ())
-> UniqueSeqNE (PathI 'TrashEntryOriginalPath)
-> m ()
deletePostHook BackendArgs m pd
backendArgs (m () -> (pd, PathTypeW, PathI 'TrashEntryPath) -> m ()
forall a b. a -> b -> a
const (m () -> (pd, PathTypeW, PathI 'TrashEntryPath) -> m ())
-> m () -> (pd, PathTypeW, PathI 'TrashEntryPath) -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | 'delete' that takes a callback that runs on the created path data, assuming
-- the delete succeeded.
deletePostHook ::
  forall m env pd k.
  ( HasCallStack,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    LabelOptic' "originalPath" k pd (PathI TrashEntryOriginalPath),
    HasTrashHome env,
    MonadCatch m,
    MonadFileWriter m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTerminal m,
    MonadTime m,
    Serial pd,
    Show pd
  ) =>
  BackendArgs m pd ->
  ((pd, PathTypeW, PathI TrashEntryPath) -> m ()) ->
  UniqueSeqNE (PathI TrashEntryOriginalPath) ->
  m ()
deletePostHook :: forall (m :: * -> *) env pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 LabelOptic' "originalPath" k pd (PathI 'TrashEntryOriginalPath),
 HasTrashHome env, MonadCatch m, MonadFileWriter m, MonadIORef m,
 MonadLoggerNS m, MonadPathWriter m, MonadReader env m,
 MonadTerminal m, MonadTime m, Serial pd, Show pd) =>
BackendArgs m pd
-> ((pd, PathTypeW, PathI 'TrashEntryPath) -> m ())
-> UniqueSeqNE (PathI 'TrashEntryOriginalPath)
-> m ()
deletePostHook BackendArgs m pd
backendArgs (pd, PathTypeW, PathI 'TrashEntryPath) -> m ()
postHook UniqueSeqNE (PathI 'TrashEntryOriginalPath)
paths = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"deletePostHook" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Paths: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (PathI 'TrashEntryOriginalPath -> Text)
-> UniqueSeqNE (PathI 'TrashEntryOriginalPath) -> Text
forall a. (a -> Text) -> UniqueSeqNE a -> Text
USeqNE.display PathI 'TrashEntryOriginalPath -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText UniqueSeqNE (PathI 'TrashEntryOriginalPath)
paths
  PathI 'TrashHome
trashHome <- (env -> PathI 'TrashHome) -> m (PathI 'TrashHome)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> PathI 'TrashHome
forall a. HasTrashHome a => a -> PathI 'TrashHome
getTrashHome

  m (PathI 'TrashDirFiles, PathI 'TrashDirInfo) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathWriter m, MonadReader env m) =>
m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
Trash.createTrash

  IORef (Maybe SomeException)
someExRef <- Maybe SomeException -> m (IORef (Maybe SomeException))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing
  Timestamp
currTime <- LocalTime -> Timestamp
MkTimestamp (LocalTime -> Timestamp) -> m LocalTime -> m Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LocalTime
forall (m :: * -> *). (HasCallStack, MonadTime m) => m LocalTime
getSystemTime

  let deleteAction :: PathI 'TrashEntryOriginalPath
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
deleteAction = BackendArgs m pd
-> PathI 'TrashHome
-> Timestamp
-> PathI 'TrashEntryOriginalPath
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
forall k pd (m :: * -> *).
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 LabelOptic' "originalPath" k pd (PathI 'TrashEntryOriginalPath),
 MonadCatch m, MonadFileWriter m, MonadLoggerNS m,
 MonadPathWriter m, Serial pd, Show pd) =>
BackendArgs m pd
-> PathI 'TrashHome
-> Timestamp
-> PathI 'TrashEntryOriginalPath
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
Trash.mvOriginalToTrash BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome Timestamp
currTime

      handleEx :: PathI 'TrashEntryOriginalPath -> SomeException -> m ()
handleEx PathI 'TrashEntryOriginalPath
p 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)
        String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn
          (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Error deleting path '",
              OsPath -> String
decodeOsToFpDisplayEx (OsPath -> String) -> OsPath -> String
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryOriginalPath
p PathI 'TrashEntryOriginalPath
-> Optic' An_Iso NoIx (PathI 'TrashEntryOriginalPath) OsPath
-> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx (PathI 'TrashEntryOriginalPath) OsPath
#unPathI,
              String
"': ",
              SomeException -> String
forall e. Exception e => e -> String
displayNoCS SomeException
ex
            ]
        IORef (Maybe SomeException) -> Maybe SomeException -> m ()
forall a. HasCallStack => IORef a -> a -> m ()
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe SomeException)
someExRef (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
ex)

  -- move paths to trash
  UniqueSeqNE (PathI 'TrashEntryOriginalPath)
-> (PathI 'TrashEntryOriginalPath -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ UniqueSeqNE (PathI 'TrashEntryOriginalPath)
paths ((PathI 'TrashEntryOriginalPath -> m ()) -> m ())
-> (PathI 'TrashEntryOriginalPath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PathI 'TrashEntryOriginalPath
p -> do
    m (pd, PathTypeW, PathI 'TrashEntryPath)
-> m (Either SomeException (pd, PathTypeW, PathI 'TrashEntryPath))
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCS (PathI 'TrashEntryOriginalPath
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
deleteAction PathI 'TrashEntryOriginalPath
p) m (Either SomeException (pd, PathTypeW, PathI 'TrashEntryPath))
-> (Either SomeException (pd, PathTypeW, PathI 'TrashEntryPath)
    -> 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
>>= \case
      Left SomeException
ex -> PathI 'TrashEntryOriginalPath -> SomeException -> m ()
handleEx PathI 'TrashEntryOriginalPath
p SomeException
ex
      Right (pd, PathTypeW, PathI 'TrashEntryPath)
pd -> (pd, PathTypeW, PathI 'TrashEntryPath) -> m ()
postHook (pd, PathTypeW, PathI 'TrashEntryPath)
pd

  IORef (Maybe SomeException) -> m ()
forall (m :: * -> *).
(MonadIORef m, MonadThrow m) =>
IORef (Maybe SomeException) -> m ()
Utils.throwIfEx IORef (Maybe SomeException)
someExRef

-- | Permanently deletes the paths from the trash.
permDelete ::
  forall m env pd k.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    HasTrashHome env,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadLoggerNS m,
    MonadReader env m,
    MonadTerminal m,
    Serial pd,
    Show pd
  ) =>
  BackendArgs m pd ->
  Bool ->
  UniqueSeqNE (PathI TrashEntryFileName) ->
  m ()
permDelete :: forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadAsync m, MonadCatch m, MonadFileReader m, MonadHandleWriter m,
 MonadIORef m, MonadPathReader m, MonadPathWriter m,
 MonadLoggerNS m, MonadReader env m, MonadTerminal m, Serial pd,
 Show pd) =>
BackendArgs m pd
-> Bool -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
permDelete BackendArgs m pd
backendArgs = BackendArgs m pd
-> (PathData -> m ())
-> Bool
-> UniqueSeqNE (PathI 'TrashEntryFileName)
-> m ()
forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadAsync m, MonadCatch m, MonadFileReader m, MonadHandleWriter m,
 MonadIORef m, MonadPathReader m, MonadPathWriter m,
 MonadLoggerNS m, MonadReader env m, MonadTerminal m, Serial pd,
 Show pd) =>
BackendArgs m pd
-> (PathData -> m ())
-> Bool
-> UniqueSeqNE (PathI 'TrashEntryFileName)
-> m ()
permDeletePostHook BackendArgs m pd
backendArgs (m () -> PathData -> m ()
forall a b. a -> b -> a
const (m () -> PathData -> m ()) -> m () -> PathData -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Permanently deletes the paths from the trash.
permDeletePostHook ::
  forall m env pd k.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    HasTrashHome env,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadLoggerNS m,
    MonadReader env m,
    MonadTerminal m,
    Serial pd,
    Show pd
  ) =>
  BackendArgs m pd ->
  (PathData -> m ()) ->
  Bool ->
  UniqueSeqNE (PathI TrashEntryFileName) ->
  m ()
permDeletePostHook :: forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadAsync m, MonadCatch m, MonadFileReader m, MonadHandleWriter m,
 MonadIORef m, MonadPathReader m, MonadPathWriter m,
 MonadLoggerNS m, MonadReader env m, MonadTerminal m, Serial pd,
 Show pd) =>
BackendArgs m pd
-> (PathData -> m ())
-> Bool
-> UniqueSeqNE (PathI 'TrashEntryFileName)
-> m ()
permDeletePostHook BackendArgs m pd
backendArgs PathData -> m ()
postHook Bool
force UniqueSeqNE (PathI 'TrashEntryFileName)
paths = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"permDeletePostHook" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Paths: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (PathI 'TrashEntryFileName -> Text)
-> UniqueSeqNE (PathI 'TrashEntryFileName) -> Text
forall a. (a -> Text) -> UniqueSeqNE a -> Text
USeqNE.display PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText UniqueSeqNE (PathI 'TrashEntryFileName)
paths
  PathI 'TrashHome
trashHome <- (env -> PathI 'TrashHome) -> m (PathI 'TrashHome)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> PathI 'TrashHome
forall a. HasTrashHome a => a -> PathI 'TrashHome
getTrashHome

  IORef (Maybe SomeException)
someExRef <- Maybe SomeException -> m (IORef (Maybe SomeException))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing

  -- permanently delete paths
  Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"deleting" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UniqueSeqNE (PathI 'TrashEntryFileName)
-> (PathI 'TrashEntryFileName -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ UniqueSeqNE (PathI 'TrashEntryFileName)
paths ((PathI 'TrashEntryFileName -> m ()) -> m ())
-> (PathI 'TrashEntryFileName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PathI 'TrashEntryFileName
p ->
    -- Record error if any occurred
    (BackendArgs m pd
-> (PathData -> m ())
-> Bool
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m (Maybe SomeException)
forall (m :: * -> *) pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadAsync m, MonadCatch m, MonadFileReader m, MonadHandleWriter m,
 MonadIORef m, MonadLoggerNS m, MonadPathReader m,
 MonadPathWriter m, MonadTerminal m, Serial pd, Show pd) =>
BackendArgs m pd
-> (PathData -> m ())
-> Bool
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m (Maybe SomeException)
Trash.permDeleteFromTrash BackendArgs m pd
backendArgs PathData -> m ()
postHook Bool
force PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
p m (Maybe SomeException) -> (Maybe SomeException -> 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
>>= IORef (Maybe SomeException) -> Maybe SomeException -> m ()
forall (m :: * -> *) a.
MonadIORef m =>
IORef (Maybe a) -> Maybe a -> m ()
Utils.setRefIfJust IORef (Maybe SomeException)
someExRef)
      m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAnyCS` \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)
        String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn
          (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Error permanently deleting path '",
              OsPath -> String
decodeOsToFpDisplayEx (OsPath -> String) -> OsPath -> String
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName
p PathI 'TrashEntryFileName
-> Optic' An_Iso NoIx (PathI 'TrashEntryFileName) OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx (PathI 'TrashEntryFileName) OsPath
#unPathI,
              String
"': ",
              SomeException -> String
forall e. Exception e => e -> String
displayNoCS SomeException
ex
            ]
        -- in case Trash.permDeleteFromTrash throws an exception
        IORef (Maybe SomeException) -> Maybe SomeException -> m ()
forall a. HasCallStack => IORef a -> a -> m ()
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe SomeException)
someExRef (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
ex)

  IORef (Maybe SomeException) -> m ()
forall (m :: * -> *).
(MonadIORef m, MonadThrow m) =>
IORef (Maybe SomeException) -> m ()
Utils.throwIfEx IORef (Maybe SomeException)
someExRef

-- | Reads the index at either the specified or default location. If the
-- file does not exist, returns empty.
getIndex ::
  forall m env pd k.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    HasTrashHome env,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadFileReader m,
    MonadPathReader m,
    MonadLoggerNS m,
    MonadReader env m,
    Serial pd
  ) =>
  BackendArgs m pd ->
  m Index
getIndex :: forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadPathReader m,
 MonadLoggerNS m, MonadReader env m, Serial pd) =>
BackendArgs m pd -> m Index
getIndex BackendArgs m pd
backendArgs = Text -> m Index -> m Index
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"getIndex" (m Index -> m Index) -> m Index -> m Index
forall a b. (a -> b) -> a -> b
$ do
  m Bool
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathReader m, MonadReader env m, MonadThrow m) =>
m Bool
Trash.doesTrashExist m Bool -> (Bool -> m Index) -> m Index
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> BackendArgs m pd -> m Index
forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadFileReader m, MonadCatch m, MonadLoggerNS m,
 MonadReader env m, MonadPathReader m, Serial pd) =>
BackendArgs m pd -> m Index
Default.Index.readIndex BackendArgs m pd
backendArgs
    Bool
False -> do
      $(logTrace) Text
"Trash does not exist."
      Index -> m Index
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Index
Index.empty

-- | Retrieves metadata for the trash directory.
getMetadata ::
  forall m env pd k.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    HasTrashHome env,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadReader env m,
    Serial pd
  ) =>
  BackendArgs m pd ->
  m Metadata
getMetadata :: forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadReader env m, Serial pd) =>
BackendArgs m pd -> m Metadata
getMetadata BackendArgs m pd
backendArgs = Text -> m Metadata -> m Metadata
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"getMetadata" (m Metadata -> m Metadata) -> m Metadata -> m Metadata
forall a b. (a -> b) -> a -> b
$ do
  $(logTrace) Text
"In getMetadata"
  PathI 'TrashHome
trashHome <- (env -> PathI 'TrashHome) -> m (PathI 'TrashHome)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> PathI 'TrashHome
forall a. HasTrashHome a => a -> PathI 'TrashHome
getTrashHome
  PathI 'TrashLog
trashLog <- m (PathI 'TrashLog)
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
m (PathI 'TrashLog)
Env.getTrashLog

  let MkPathI OsPath
trashPathsDir = PathI 'TrashHome -> PathI 'TrashDirFiles
Default.Utils.getTrashPathDir PathI 'TrashHome
trashHome

  m Bool
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathReader m, MonadReader env m, MonadThrow m) =>
m Bool
Trash.doesTrashExist m Bool -> (Bool -> m Metadata) -> m Metadata
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> do
      $(logTrace) Text
"Trash does not exist."
      Metadata -> m Metadata
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Metadata
Metadata.empty
    Bool
True -> do
      -- Index size
      Seq (PathData, PathI 'TrashEntryPath)
index <- Optic' An_Iso NoIx Index (Seq (PathData, PathI 'TrashEntryPath))
-> Index -> Seq (PathData, PathI 'TrashEntryPath)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx Index (Seq (PathData, PathI 'TrashEntryPath))
#unIndex (Index -> Seq (PathData, PathI 'TrashEntryPath))
-> m Index -> m (Seq (PathData, PathI 'TrashEntryPath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendArgs m pd -> PathI 'TrashHome -> m Index
forall (m :: * -> *) pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadFileReader m, MonadCatch m, MonadLoggerNS m,
 MonadPathReader m, Serial pd) =>
BackendArgs m pd -> PathI 'TrashHome -> m Index
Default.Index.readIndexTrashHome BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome
      let numIndex :: Int
numIndex = Seq (PathData, PathI 'TrashEntryPath) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (PathData, PathI 'TrashEntryPath)
index
      $(logDebug) (Text
"Index size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
numIndex)

      -- Num entries
      Int
numEntries <- (Int -> OsPath -> Int) -> Int -> [OsPath] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc OsPath
_ -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 ([OsPath] -> Int) -> m [OsPath] -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
listDirectory OsPath
trashPathsDir
      $(logDebug) (Text
"Num entries: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
numEntries)

      -- Log size
      let logPath :: OsPath
logPath = PathI 'TrashLog
trashLog PathI 'TrashLog
-> Optic' An_Iso NoIx (PathI 'TrashLog) OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx (PathI 'TrashLog) OsPath
#unPathI
      Bool
logExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
logPath
      SomeSize Double
logSize <-
        if Bool
logExists
          then Bytes 'B Double -> Norm (Bytes 'B Double)
Bytes 'B Double -> SomeSize Double
forall a. Normalize a => a -> Norm a
Bytes.normalize (Bytes 'B Double -> SomeSize Double)
-> (Integer -> Bytes 'B Double) -> Integer -> SomeSize Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes 'B Integer -> Bytes 'B Double
forall a (s :: Size). Integral a => Bytes s a -> Bytes s Double
toDouble (Bytes 'B Integer -> Bytes 'B Double)
-> (Integer -> Bytes 'B Integer) -> Integer -> Bytes 'B Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Size) n. n -> Bytes s n
MkBytes @B (Integer -> SomeSize Double) -> m Integer -> m (SomeSize Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m Integer
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Integer
getFileSize OsPath
logPath
          else do
            $(logTrace) Text
"Log does not exist"
            SomeSize Double -> m (SomeSize Double)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> SomeSize Double
forall a. (FromRational a, HasCallStack) => Rational -> a
afromRational Rational
0)

      -- Summed size
      [OsPath]
allFiles <- OsPath -> m [OsPath]
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLoggerNS m, MonadPathReader m) =>
OsPath -> m [OsPath]
Utils.getAllFiles OsPath
trashPathsDir
      let allSizes :: Bytes 'B Natural
allSizes = (Bytes 'B Natural
 -> (PathData, PathI 'TrashEntryPath) -> Bytes 'B Natural)
-> Bytes 'B Natural
-> Seq (PathData, PathI 'TrashEntryPath)
-> Bytes 'B Natural
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bytes 'B Natural
acc (PathData
pd, PathI 'TrashEntryPath
_) -> (PathData
pd PathData
-> Optic' A_Lens NoIx PathData (Bytes 'B Natural)
-> Bytes 'B Natural
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (Bytes 'B Natural)
#size) Bytes 'B Natural -> Bytes 'B Natural -> Bytes 'B Natural
forall s. ASemigroup s => s -> s -> s
.+. Bytes 'B Natural
acc) Bytes 'B Natural
forall m. AMonoid m => m
zero Seq (PathData, PathI 'TrashEntryPath)
index
          numFiles :: Int
numFiles = [OsPath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OsPath]
allFiles
          size :: SomeSize Double
size = Natural -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Double) -> SomeSize Natural -> SomeSize Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bytes 'B Natural -> Norm (Bytes 'B Natural)
forall a. Normalize a => a -> Norm a
Bytes.normalize Bytes 'B Natural
allSizes

      $(logDebug) (Text
"Num all files: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
numFiles)
      $(logDebug) (Text
"Total size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeSize Double -> Text
forall a. Show a => a -> Text
showt SomeSize Double
size)

      -- NOTE: If the index is successfully read then we have verified that
      -- all invariants are preserved i.e. bijection between /files and /info.

      Metadata -> m Metadata
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Metadata -> m Metadata) -> Metadata -> m Metadata
forall a b. (a -> b) -> a -> b
$ MkMetadata
          { $sel:numEntries:MkMetadata :: Natural
numEntries = Int -> Natural
toNat Int
numEntries,
            $sel:numFiles:MkMetadata :: Natural
numFiles = Int -> Natural
toNat Int
numFiles,
            SomeSize Double
logSize :: SomeSize Double
$sel:logSize:MkMetadata :: SomeSize Double
logSize,
            SomeSize Double
size :: SomeSize Double
$sel:size:MkMetadata :: SomeSize Double
size
          }
  where
    toDouble :: (Integral a) => Bytes s a -> Bytes s Double
    toDouble :: forall a (s :: Size). Integral a => Bytes s a -> Bytes s Double
toDouble = (a -> Double) -> Bytes s a -> Bytes s Double
forall a b. (a -> b) -> Bytes s a -> Bytes s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    toNat :: Int -> Natural
    toNat :: Int -> Natural
toNat = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @restore trash p@ restores the trashed path @\<trash\>\/p@ to its original
-- location.
restore ::
  forall m env pd k.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    HasTrashHome env,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadFileReader m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTerminal m,
    Serial pd,
    Show pd
  ) =>
  BackendArgs m pd ->
  UniqueSeqNE (PathI TrashEntryFileName) ->
  m ()
restore :: forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadReader env m,
 MonadTerminal m, Serial pd, Show pd) =>
BackendArgs m pd -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
restore BackendArgs m pd
backendArgs = BackendArgs m pd
-> (PathData -> m ())
-> UniqueSeqNE (PathI 'TrashEntryFileName)
-> m ()
forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadReader env m,
 MonadTerminal m, Serial pd, Show pd) =>
BackendArgs m pd
-> (PathData -> m ())
-> UniqueSeqNE (PathI 'TrashEntryFileName)
-> m ()
restorePostHook BackendArgs m pd
backendArgs (m () -> PathData -> m ()
forall a b. a -> b -> a
const (m () -> PathData -> m ()) -> m () -> PathData -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | @restore trash p@ restores the trashed path @\<trash\>\/p@ to its original
-- location.
restorePostHook ::
  forall m env pd k.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    HasTrashHome env,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadFileReader m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTerminal m,
    Serial pd,
    Show pd
  ) =>
  BackendArgs m pd ->
  (PathData -> m ()) ->
  UniqueSeqNE (PathI TrashEntryFileName) ->
  m ()
restorePostHook :: forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadReader env m,
 MonadTerminal m, Serial pd, Show pd) =>
BackendArgs m pd
-> (PathData -> m ())
-> UniqueSeqNE (PathI 'TrashEntryFileName)
-> m ()
restorePostHook BackendArgs m pd
backendArgs PathData -> m ()
postHook UniqueSeqNE (PathI 'TrashEntryFileName)
paths = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"restorePostHook" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Paths: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (PathI 'TrashEntryFileName -> Text)
-> UniqueSeqNE (PathI 'TrashEntryFileName) -> Text
forall a. (a -> Text) -> UniqueSeqNE a -> Text
USeqNE.display PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText UniqueSeqNE (PathI 'TrashEntryFileName)
paths
  PathI 'TrashHome
trashHome <- (env -> PathI 'TrashHome) -> m (PathI 'TrashHome)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> PathI 'TrashHome
forall a. HasTrashHome a => a -> PathI 'TrashHome
getTrashHome

  IORef (Maybe SomeException)
someExRef <- Maybe SomeException -> m (IORef (Maybe SomeException))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef Maybe SomeException
forall a. Maybe a
Nothing

  -- move trash paths back to original location
  Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"restoring" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UniqueSeqNE (PathI 'TrashEntryFileName)
-> (PathI 'TrashEntryFileName -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ UniqueSeqNE (PathI 'TrashEntryFileName)
paths ((PathI 'TrashEntryFileName -> m ()) -> m ())
-> (PathI 'TrashEntryFileName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PathI 'TrashEntryFileName
p ->
    -- Record error if any occurred
    (BackendArgs m pd
-> (PathData -> m ())
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m (Maybe SomeException)
forall pd k (m :: * -> *).
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadTerminal m, Serial pd,
 Show pd) =>
BackendArgs m pd
-> (PathData -> m ())
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m (Maybe SomeException)
Trash.restoreTrashToOriginal BackendArgs m pd
backendArgs PathData -> m ()
postHook PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
p m (Maybe SomeException) -> (Maybe SomeException -> 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
>>= IORef (Maybe SomeException) -> Maybe SomeException -> m ()
forall (m :: * -> *) a.
MonadIORef m =>
IORef (Maybe a) -> Maybe a -> m ()
Utils.setRefIfJust IORef (Maybe SomeException)
someExRef)
      m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAnyCS` \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)
        String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn
          (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"Error restoring path '",
              OsPath -> String
decodeOsToFpDisplayEx (OsPath -> String) -> OsPath -> String
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName
p PathI 'TrashEntryFileName
-> Optic' An_Iso NoIx (PathI 'TrashEntryFileName) OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx (PathI 'TrashEntryFileName) OsPath
#unPathI,
              String
"': ",
              SomeException -> String
forall e. Exception e => e -> String
displayNoCS SomeException
ex
            ]
        IORef (Maybe SomeException) -> Maybe SomeException -> m ()
forall a. HasCallStack => IORef a -> a -> m ()
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> a -> m ()
writeIORef IORef (Maybe SomeException)
someExRef (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
ex)

  IORef (Maybe SomeException) -> m ()
forall (m :: * -> *).
(MonadIORef m, MonadThrow m) =>
IORef (Maybe SomeException) -> m ()
Utils.throwIfEx IORef (Maybe SomeException)
someExRef

-- | Empties the trash.
emptyTrash ::
  forall m env pd k.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    HasTrashHome env,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadFileReader m,
    MonadHandleWriter m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTerminal m,
    Serial pd
  ) =>
  BackendArgs m pd ->
  Bool ->
  m ()
emptyTrash :: forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadHandleWriter m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadReader env m, MonadTerminal m, Serial pd) =>
BackendArgs m pd -> Bool -> m ()
emptyTrash BackendArgs m pd
backendArgs Bool
force = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"emptyTrash" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  $(logTrace) Text
"In emptyTrash"
  trashHome :: PathI 'TrashHome
trashHome@(MkPathI OsPath
th) <- (env -> PathI 'TrashHome) -> m (PathI 'TrashHome)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> PathI 'TrashHome
forall a. HasTrashHome a => a -> PathI 'TrashHome
getTrashHome

  Bool
exists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
th
  if Bool -> Bool
not Bool
exists
    then do
      $(logTrace) Text
"Trash home does not exist."
      Text -> m ()
forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashHome -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashHome
trashHome Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is empty."
    else
      if Bool
force
        then do
          $(logTrace) Text
"Force on; deleting entire trash."
          OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryRecursive OsPath
th
          m (PathI 'TrashDirFiles, PathI 'TrashDirInfo) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathWriter m, MonadReader env m) =>
m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
Trash.createTrash
        else do
          m ()
forall (m :: * -> *). (HasCallStack, MonadHandleWriter m) => m ()
Utils.noBuffering
          Metadata
metadata <- BackendArgs m pd -> m Metadata
forall (m :: * -> *) env pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 HasTrashHome env, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadReader env m, Serial pd) =>
BackendArgs m pd -> m Metadata
getMetadata BackendArgs m pd
backendArgs
          String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn String
""
          Text -> m ()
forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Metadata -> Text
forall a. Pretty a => a -> Text
Utils.renderPretty Metadata
metadata
          String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStr String
"Permanently delete all contents (y/n)? "
          Char
c <- Char -> Char
Ch.toLower (Char -> Char) -> m Char -> m Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall (m :: * -> *). (MonadTerminal m, HasCallStack) => m Char
Term.getChar
          if
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'y' -> do
                $(logTrace) Text
"Deleting contents."
                OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryRecursive OsPath
th
                m (PathI 'TrashDirFiles, PathI 'TrashDirInfo) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathWriter m, MonadReader env m) =>
m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
Trash.createTrash
                String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn String
""
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'n' -> do
                $(logTrace) Text
"Not deleting contents."
                String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn String
""
            | Bool
otherwise -> String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn (String
"\nUnrecognized: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
c])

merge ::
  ( HasCallStack,
    MonadFileReader m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadMask m,
    MonadPathReader m,
    MonadPathWriter m
  ) =>
  PathI TrashHome ->
  PathI TrashHome ->
  m ()
merge :: forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadMask m, MonadPathReader m, MonadPathWriter m) =>
PathI 'TrashHome -> PathI 'TrashHome -> m ()
merge PathI 'TrashHome
src PathI 'TrashHome
dest = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"merge" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashHome -> PathI 'TrashHome -> m ()
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadMask m, MonadPathReader m, MonadPathWriter m) =>
PathI 'TrashHome -> PathI 'TrashHome -> m ()
Trash.mergeTrashDirs PathI 'TrashHome
src PathI 'TrashHome
dest