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

-- | Interface for the default trash directory
module Charon.Backend.Default.Trash
  ( -- * Trash directory
    createTrash,
    createTrashDir,
    doesTrashExist,
    doesTrashExistPath,

    -- * Main actions
    mvOriginalToTrash,
    mvOriginalToTrash_,
    restoreTrashToOriginal,
    permDeleteFromTrash,

    -- * Transformations
    mergeTrashDirs,

    -- * Utils
    PathDataSearchResult (..),
    findPathData,
    getTrashPath,
  )
where

import Charon.Backend.Data (Backend)
import Charon.Backend.Data qualified as Backend.Data
import Charon.Backend.Default.BackendArgs (BackendArgs)
import Charon.Backend.Default.Exception
  ( TrashDirFilesNotFoundE (MkTrashDirFilesNotFoundE),
    TrashDirInfoNotFoundE (MkTrashDirInfoNotFoundE),
  )
import Charon.Backend.Default.Index qualified as Default.Index
import Charon.Backend.Default.Utils qualified as Default.Utils
import Charon.Class.Serial (Serial (DecodeExtra, decode), encodeThrowM)
import Charon.Data.PathData (PathData)
import Charon.Data.PathData qualified as PathData.Core
import Charon.Data.PathType (PathTypeW)
import Charon.Data.PathType qualified as PathType
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex
      ( TrashDirFiles,
        TrashDirInfo,
        TrashEntryFileName,
        TrashEntryInfo,
        TrashEntryOriginalPath,
        TrashEntryPath,
        TrashHome
      ),
    (<//>),
  )
import Charon.Data.Paths qualified as Paths
import Charon.Data.Timestamp (Timestamp)
import Charon.Env (HasTrashHome (getTrashHome))
import Charon.Exception
  ( InfoDecodeE (MkInfoDecodeE),
    RestoreCollisionE (MkRestoreCollisionE),
    TrashEntryFileNotFoundE (MkTrashEntryFileNotFoundE),
    TrashEntryNotFoundE (MkTrashEntryNotFoundE),
    TrashEntryWildcardNotFoundE (MkTrashEntryWildcardNotFoundE),
  )
import Charon.Prelude
import Charon.Utils qualified as Utils
import Data.Char qualified as Ch
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Effects.FileSystem.PathWriter
  ( CopyDirConfig (MkCopyDirConfig),
    Overwrite (OverwriteDirectories),
    TargetName (TargetNameDest),
  )
import Effects.FileSystem.PathWriter qualified as PW
import Effects.FileSystem.PathWriter qualified as WDir
import Effects.System.Terminal qualified as Term

-- | Creates the trash directory if it does not exist.
createTrash ::
  ( HasCallStack,
    HasTrashHome env,
    MonadLoggerNS m,
    MonadPathWriter m,
    MonadReader env m
  ) =>
  m (PathI TrashDirFiles, PathI TrashDirInfo)
createTrash :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathWriter m, MonadReader env m) =>
m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
createTrash = Text
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"createTrash" (m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
 -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo))
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall a b. (a -> b) -> a -> b
$ (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 'TrashHome)
-> (PathI 'TrashHome
    -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo))
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PathI 'TrashHome -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathWriter m) =>
PathI 'TrashHome -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
createTrashDir

-- | Creates the trash directory if it does not exist.
createTrashDir ::
  ( HasCallStack,
    MonadLoggerNS m,
    MonadPathWriter m
  ) =>
  PathI TrashHome ->
  m (PathI TrashDirFiles, PathI TrashDirInfo)
createTrashDir :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathWriter m) =>
PathI 'TrashHome -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
createTrashDir PathI 'TrashHome
trashHome = Text
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"createTrashDir" (m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
 -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo))
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall a b. (a -> b) -> a -> b
$ do
  $(logTrace) Text
"Creating trash if it does not exist"

  let trashPathDir :: PathI 'TrashDirFiles
trashPathDir = PathI 'TrashHome -> PathI 'TrashDirFiles
Default.Utils.getTrashPathDir PathI 'TrashHome
trashHome
      trashInfoDir :: PathI 'TrashDirInfo
trashInfoDir = PathI 'TrashHome -> PathI 'TrashDirInfo
Default.Utils.getTrashInfoDir PathI 'TrashHome
trashHome

  (HasCallStack => OsPath -> m ()) -> PathI 'TrashHome -> m ()
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI (Bool -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
False) PathI 'TrashHome
trashHome
  (HasCallStack => OsPath -> m ()) -> PathI 'TrashDirFiles -> m ()
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI (Bool -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
False) PathI 'TrashDirFiles
trashPathDir
  (HasCallStack => OsPath -> m ()) -> PathI 'TrashDirInfo -> m ()
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI (Bool -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
False) PathI 'TrashDirInfo
trashInfoDir

  (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
-> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathI 'TrashDirFiles
trashPathDir, PathI 'TrashDirInfo
trashInfoDir)

-- | Returns 'False' if @\<trash-home\>@ does not exist. If @\<trash-home\>@
-- /does/ exist but is "badly-formed" i.e. one of
--
-- * \<trash-home\>/files
-- * \<trash-home\>/info
--
-- does not, throws 'TrashDirFilesNotFoundE' or 'TrashDirInfoNotFoundE'.
--
-- If all three dirs exist, returns 'True'.
doesTrashExist ::
  ( HasCallStack,
    HasTrashHome env,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadReader env m,
    MonadThrow m
  ) =>
  m Bool
doesTrashExist :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathReader m, MonadReader env m, MonadThrow m) =>
m Bool
doesTrashExist = Text -> m Bool -> m Bool
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"doesTrashExist" (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (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 'TrashHome) -> (PathI 'TrashHome -> m Bool) -> m Bool
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PathI 'TrashHome -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m) =>
PathI 'TrashHome -> m Bool
doesTrashExistPath

-- | Returns 'False' if @\<trash-home\>@ does not exist. If @\<trash-home\>@
-- /does/ exist but is "badly-formed" i.e. one of
--
-- * \<trash-home\>/files
-- * \<trash-home\>/info
--
-- does not, throws 'TrashDirFilesNotFoundE' or 'TrashDirInfoNotFoundE'.
--
-- If all three dirs exist, returns 'True'.
doesTrashExistPath ::
  ( HasCallStack,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  PathI TrashHome ->
  m Bool
doesTrashExistPath :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m) =>
PathI 'TrashHome -> m Bool
doesTrashExistPath PathI 'TrashHome
trashHome = Text -> m Bool -> m Bool
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"doesTrashExistPath" (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
  let MkPathI OsPath
trashPathDir' = PathI 'TrashHome -> PathI 'TrashDirFiles
Default.Utils.getTrashPathDir PathI 'TrashHome
trashHome
      MkPathI OsPath
trashInfoDir' = PathI 'TrashHome -> PathI 'TrashDirInfo
Default.Utils.getTrashInfoDir PathI 'TrashHome
trashHome

  Bool
homeExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist (PathI 'TrashHome
trashHome PathI 'TrashHome
-> Optic' An_Iso NoIx (PathI 'TrashHome) OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx (PathI 'TrashHome) OsPath
#unPathI)
  if Bool -> Bool
not Bool
homeExists
    then do
      $(logTrace) Text
"Trash does not exist"
      Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    else do
      Bool
pathExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
trashPathDir'
      Bool
infoExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
trashInfoDir'

      case (Bool
pathExists, Bool
infoExists) of
        -- Everything exists -> true
        (Bool
True, Bool
True) -> do
          $(logTrace) Text
"Trash exists"
          Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        -- Info and Path both do not exist -> false
        (Bool
False, Bool
False) -> do
          $(logTrace) Text
"Trash/ exists but info/ and files/ do not"
          Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        -- Path exists; info does not -> Badly formed, throw exception
        (Bool
True, Bool
False) -> do
          $(logError) Text
"Trash/files exists but info/ does not"
          TrashDirInfoNotFoundE -> m Bool
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS
            (TrashDirInfoNotFoundE -> m Bool)
-> TrashDirInfoNotFoundE -> m Bool
forall a b. (a -> b) -> a -> b
$ PathI 'TrashHome -> TrashDirInfoNotFoundE
MkTrashDirInfoNotFoundE PathI 'TrashHome
trashHome
        -- Info exists; path does not -> Badly formed, throw exception
        (Bool
False, Bool
True) -> do
          $(logError) Text
"Trash/info exists but files/ does not"
          TrashDirFilesNotFoundE -> m Bool
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS
            (TrashDirFilesNotFoundE -> m Bool)
-> TrashDirFilesNotFoundE -> m Bool
forall a b. (a -> b) -> a -> b
$ PathI 'TrashHome -> TrashDirFilesNotFoundE
MkTrashDirFilesNotFoundE PathI 'TrashHome
trashHome

-- | Moves the 'PathData'\'s @originalPath@ to the trash.
mvOriginalToTrash_ ::
  ( 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 ()
mvOriginalToTrash_ :: 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 ()
mvOriginalToTrash_ BackendArgs m pd
backendArgs PathI 'TrashHome
th Timestamp
ts =
  Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"mvOriginalToTrash_"
    (m () -> m ())
-> (PathI 'TrashEntryOriginalPath -> m ())
-> PathI 'TrashEntryOriginalPath
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (pd, PathTypeW, PathI 'TrashEntryPath) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (m (pd, PathTypeW, PathI 'TrashEntryPath) -> m ())
-> (PathI 'TrashEntryOriginalPath
    -> m (pd, PathTypeW, PathI 'TrashEntryPath))
-> PathI 'TrashEntryOriginalPath
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
mvOriginalToTrash BackendArgs m pd
backendArgs PathI 'TrashHome
th Timestamp
ts

-- | Moves the 'PathData'\'s @originalPath@ to the trash. Returns the
-- created pd.
mvOriginalToTrash ::
  ( 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)
mvOriginalToTrash :: 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)
mvOriginalToTrash BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome Timestamp
currTime PathI 'TrashEntryOriginalPath
path = Text
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"mvOriginalToTrash" (m (pd, PathTypeW, PathI 'TrashEntryPath)
 -> m (pd, PathTypeW, PathI 'TrashEntryPath))
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryOriginalPath -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryOriginalPath
path
  let backend :: Backend
backend = BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic' A_Lens NoIx (BackendArgs m pd) Backend -> Backend
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (BackendArgs m pd) Backend
#backend
  (pd
pd, PathTypeW
pathType) <- (BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic'
     A_Lens
     NoIx
     (BackendArgs m pd)
     (Timestamp
      -> PathI 'TrashHome
      -> PathI 'TrashEntryOriginalPath
      -> m (pd, PathTypeW))
-> Timestamp
-> PathI 'TrashHome
-> PathI 'TrashEntryOriginalPath
-> m (pd, PathTypeW)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (BackendArgs m pd)
  (Timestamp
   -> PathI 'TrashHome
   -> PathI 'TrashEntryOriginalPath
   -> m (pd, PathTypeW))
#makePathData) Timestamp
currTime PathI 'TrashHome
trashHome PathI 'TrashEntryOriginalPath
path
  $(logDebug) (Text
"Deleting: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> pd -> Text
forall a. Show a => a -> Text
showt pd
pd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathTypeW -> Text
forall a. Show a => a -> Text
showt PathTypeW
pathType)

  let fileName :: PathI 'TrashEntryFileName
fileName = pd
pd pd
-> Optic' k NoIx pd (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx pd (PathI 'TrashEntryFileName)
#fileName
      trashPathI :: PathI 'TrashEntryPath
trashPathI@(MkPathI OsPath
trashPath) = PathI 'TrashHome
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryPath
getTrashPath PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
fileName
      MkPathI OsPath
trashInfoPath = Backend
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> PathI 'TrashEntryInfo
getTrashInfoPath Backend
backend PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
fileName

  -- 2. Write info file
  --
  -- Perform this before the actual move to be safe i.e. path is only moved
  -- if info is already created.
  ByteString
encoded <- pd -> m ByteString
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Serial a) =>
a -> m ByteString
encodeThrowM pd
pd
  OsPath -> ByteString -> m ()
forall (m :: * -> *).
(MonadFileWriter m, HasCallStack) =>
OsPath -> ByteString -> m ()
writeBinaryFile OsPath
trashInfoPath ByteString
encoded

  $(logDebug) (Text
"Wrote to file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. Show a => a -> Text
showt ByteString
encoded)

  -- 4. Move file to trash
  let MkPathI OsPath
opath = pd
pd pd
-> Optic' k NoIx pd (PathI 'TrashEntryOriginalPath)
-> PathI 'TrashEntryOriginalPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx pd (PathI 'TrashEntryOriginalPath)
#originalPath
      moveFn :: m ()
moveFn = PathTypeW -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadPathWriter m) =>
PathTypeW -> OsPath -> OsPath -> m ()
PathType.renameFn PathTypeW
pathType OsPath
opath OsPath
trashPath

  -- 5. If move failed, roll back info file
  m ()
moveFn m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
ex -> do
    $(logError) (Text
"Error moving file to trash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
displayExceptiont SomeException
ex)
    OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
PW.removeFile OsPath
trashInfoPath
    SomeException -> m ()
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM SomeException
ex

  $(logInfo) (Text
"Moved to trash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> pd -> Text
forall a. Show a => a -> Text
showt pd
pd)

  (pd, PathTypeW, PathI 'TrashEntryPath)
-> m (pd, PathTypeW, PathI 'TrashEntryPath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (pd
pd, PathTypeW
pathType, PathI 'TrashEntryPath
trashPathI)

-- | Permanently deletes the trash path. Returns 'True' if any deletes fail.
-- In this case, the error has already been reported, so this is purely for
-- signaling (i.e. should we exit with an error).
permDeleteFromTrash ::
  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)
permDeleteFromTrash :: 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)
permDeleteFromTrash BackendArgs m pd
backendArgs PathData -> m ()
postHook Bool
force PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName = Text -> m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"permDeleteFromTrash" (m (Maybe SomeException) -> m (Maybe SomeException))
-> m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
pathName
  NESeq PathData
pathDatas <-
    BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m PathDataSearchResult
forall pd k (m :: * -> *).
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd, Show pd) =>
BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m PathDataSearchResult
findPathData BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName m PathDataSearchResult
-> (PathDataSearchResult -> m (NESeq PathData))
-> m (NESeq PathData)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      SearchSuccess NESeq PathData
pds -> do
        $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Found path data: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NESeq PathData -> Text
forall a. Show a => a -> Text
showt NESeq PathData
pds
        NESeq PathData -> m (NESeq PathData)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NESeq PathData
pds
      SearchSingleFailure PathI 'TrashEntryFileName
path -> do
        $(logError) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Single search failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
path
        TrashEntryNotFoundE -> m (NESeq PathData)
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (TrashEntryNotFoundE -> m (NESeq PathData))
-> TrashEntryNotFoundE -> m (NESeq PathData)
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName -> TrashEntryNotFoundE
MkTrashEntryNotFoundE PathI 'TrashEntryFileName
path
      SearchWildcardFailure PathI 'TrashEntryFileName
path -> do
        $(logError) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Wildcard search failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
path
        TrashEntryWildcardNotFoundE -> m (NESeq PathData)
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (TrashEntryWildcardNotFoundE -> m (NESeq PathData))
-> TrashEntryWildcardNotFoundE -> m (NESeq PathData)
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName -> TrashEntryWildcardNotFoundE
MkTrashEntryWildcardNotFoundE PathI 'TrashEntryFileName
path

  let backend :: Backend
backend = BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic' A_Lens NoIx (BackendArgs m pd) Backend -> Backend
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (BackendArgs m pd) Backend
#backend

  IORef (Maybe SomeException)
anyExRef <- 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
  let deleteFn :: PathData -> m ()
      deleteFn :: PathData -> m ()
deleteFn PathData
pathData = do
        $(logDebug) (Text
"Deleting: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText (PathData
pathData PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName))
        if Bool
force
          then -- NOTE: Technically don't need the pathdata if force is on, since we have
          -- the path and can just delete it. Nevertheless, we retrieve the pathData
          -- so that force does not change the semantics i.e. can only delete
          -- "well-behaved" files, and we don't have to do a redundant file/directory
          -- check.
            Backend -> PathData -> m ()
deleteFn' Backend
backend PathData
pathData
          else do
            -- NOTE:
            -- - No buffering on input so we can read a single char w/o requiring a
            --   newline to end the input (which then gets passed to getChar, which
            --   interferes with subsequent calls).
            --
            -- - No buffering on output so the "Permanently delete..." string gets
            --   printed w/o the newline.
            m ()
forall (m :: * -> *). (HasCallStack, MonadHandleWriter m) => m ()
Utils.noBuffering

            let pdStr :: Text
pdStr = PathData -> Text
forall a. Pretty a => a -> Text
Utils.renderPretty PathData
pathData
            Text -> m ()
forall (m :: * -> *).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn Text
pdStr
            String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStr String
"\nPermanently delete (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' -> Backend -> PathData -> m ()
deleteFn' Backend
backend PathData
pathData m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn String
"\n"
              | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'n' -> String -> m ()
forall (m :: * -> *).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn String
"\n"
              | 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])

      handleEx :: PathData -> SomeException -> m ()
handleEx PathData
pathData SomeException
ex = do
        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)
anyExRef (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
ex)
        $(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
forall a. Show a => a -> String
show (OsPath -> String) -> OsPath -> String
forall a b. (a -> b) -> a -> b
$ PathData
pathData PathData -> Optic' A_Lens NoIx PathData OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. (Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> Optic
     An_Iso
     NoIx
     (PathI 'TrashEntryFileName)
     (PathI 'TrashEntryFileName)
     OsPath
     OsPath
-> Optic' A_Lens NoIx PathData OsPath
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso
  NoIx
  (PathI 'TrashEntryFileName)
  (PathI 'TrashEntryFileName)
  OsPath
  OsPath
#unPathI),
              String
": ",
              SomeException -> String
forall e. Exception e => e -> String
displayNoCS SomeException
ex
            ]

  -- Need our own error handling here since if we are deleting multiple
  -- wildcard matches we want success/failure to be independent.
  NESeq PathData -> (PathData -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NESeq PathData
pathDatas ((PathData -> m ()) -> m ()) -> (PathData -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PathData
pathData ->
    m () -> m (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCS (PathData -> m ()
deleteFn PathData
pathData) m (Either SomeException ())
-> (Either 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
>>= \case
      Left SomeException
ex -> PathData -> SomeException -> m ()
handleEx PathData
pathData SomeException
ex
      Right ()
_ -> PathData -> m ()
postHook PathData
pathData

  IORef (Maybe SomeException) -> m (Maybe SomeException)
forall a. HasCallStack => IORef a -> m a
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe SomeException)
anyExRef
  where
    deleteFn' :: Backend -> PathData -> m ()
deleteFn' Backend
b PathData
pd = do
      let MkPathI OsPath
trashInfoPath' = Backend
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> PathI 'TrashEntryInfo
getTrashInfoPath Backend
b PathI 'TrashHome
trashHome (PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName)

      PathI 'TrashHome -> PathData -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
 MonadPathWriter m) =>
PathI 'TrashHome -> PathData -> m ()
deleteFileName PathI 'TrashHome
trashHome PathData
pd
      $(logInfo) (Text
"Permanently deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathData -> Text
forall a. Show a => a -> Text
showt PathData
pd)
      OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
PW.removeFile OsPath
trashInfoPath'

-- | Moves the 'PathData'\'s @fileName@ back to its @originalPath@.
-- Returns 'True' if any failed. In this case, the error has already been
-- reported, so this is purely for signaling (i.e. should we exit with
-- an error).
restoreTrashToOriginal ::
  ( 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)
restoreTrashToOriginal :: 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)
restoreTrashToOriginal BackendArgs m pd
backendArgs PathData -> m ()
postHook PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName = Text -> m (Maybe SomeException) -> m (Maybe SomeException)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"restoreTrashToOriginal" (m (Maybe SomeException) -> m (Maybe SomeException))
-> m (Maybe SomeException) -> m (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
pathName
  -- 1. Get path info
  NESeq PathData
pathDatas <-
    BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m PathDataSearchResult
forall pd k (m :: * -> *).
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd, Show pd) =>
BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m PathDataSearchResult
findPathData BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName m PathDataSearchResult
-> (PathDataSearchResult -> m (NESeq PathData))
-> m (NESeq PathData)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      SearchSuccess NESeq PathData
pds -> NESeq PathData -> m (NESeq PathData)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NESeq PathData
pds
      SearchSingleFailure PathI 'TrashEntryFileName
path -> TrashEntryNotFoundE -> m (NESeq PathData)
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (TrashEntryNotFoundE -> m (NESeq PathData))
-> TrashEntryNotFoundE -> m (NESeq PathData)
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName -> TrashEntryNotFoundE
MkTrashEntryNotFoundE PathI 'TrashEntryFileName
path
      SearchWildcardFailure PathI 'TrashEntryFileName
path -> TrashEntryWildcardNotFoundE -> m (NESeq PathData)
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (TrashEntryWildcardNotFoundE -> m (NESeq PathData))
-> TrashEntryWildcardNotFoundE -> m (NESeq PathData)
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName -> TrashEntryWildcardNotFoundE
MkTrashEntryWildcardNotFoundE PathI 'TrashEntryFileName
path

  let backend :: Backend
backend = BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic' A_Lens NoIx (BackendArgs m pd) Backend -> Backend
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (BackendArgs m pd) Backend
#backend

  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
  let restoreFn :: PathData -> m ()
restoreFn PathData
pd = do
        let originalPath :: PathI 'TrashEntryOriginalPath
originalPath = PathData
pd PathData
-> Optic
     A_Lens
     NoIx
     PathData
     PathData
     (PathI 'TrashEntryOriginalPath)
     (PathI 'TrashEntryOriginalPath)
-> PathI 'TrashEntryOriginalPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  PathData
  PathData
  (PathI 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
#originalPath
            fileName :: PathI 'TrashEntryFileName
fileName = PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName

        $(logDebug) (Text
"Restoring: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
fileName)

        -- 2. Verify original path is empty
        Bool
exists <- PathData -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
PathData -> m Bool
PathData.Core.originalPathExists PathData
pd
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RestoreCollisionE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS
          (RestoreCollisionE -> m ()) -> RestoreCollisionE -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName
-> PathI 'TrashEntryOriginalPath -> RestoreCollisionE
MkRestoreCollisionE PathI 'TrashEntryFileName
fileName PathI 'TrashEntryOriginalPath
originalPath

        let pathType :: PathTypeW
pathType = PathData
pd PathData -> Optic' A_Lens NoIx PathData PathTypeW -> PathTypeW
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData PathTypeW
#pathType
        Backend -> PathTypeW -> PathData -> m ()
restoreFn' Backend
backend PathTypeW
pathType PathData
pd

      handleEx :: PathData -> SomeException -> m ()
handleEx PathData
pathData SomeException
ex = do
        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)
        $(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
forall a. Show a => a -> String
show (OsPath -> String) -> OsPath -> String
forall a b. (a -> b) -> a -> b
$ PathData
pathData PathData -> Optic' A_Lens NoIx PathData OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. (Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> Optic
     An_Iso
     NoIx
     (PathI 'TrashEntryFileName)
     (PathI 'TrashEntryFileName)
     OsPath
     OsPath
-> Optic' A_Lens NoIx PathData OsPath
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso
  NoIx
  (PathI 'TrashEntryFileName)
  (PathI 'TrashEntryFileName)
  OsPath
  OsPath
#unPathI),
              String
": ",
              SomeException -> String
forall e. Exception e => e -> String
displayNoCS SomeException
ex
            ]

  -- Need our own error handling here since if we are restoring multiple
  -- wildcard matches we want success/failure to be independent.
  NESeq PathData -> (PathData -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ NESeq PathData
pathDatas ((PathData -> m ()) -> m ()) -> (PathData -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \PathData
pathData ->
    m () -> m (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCS (PathData -> m ()
restoreFn PathData
pathData) m (Either SomeException ())
-> (Either 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
>>= \case
      Left SomeException
ex -> PathData -> SomeException -> m ()
handleEx PathData
pathData SomeException
ex
      Right ()
_ -> PathData -> m ()
postHook PathData
pathData

  IORef (Maybe SomeException) -> m (Maybe SomeException)
forall a. HasCallStack => IORef a -> m a
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef (Maybe SomeException)
someExRef
  where
    restoreFn' :: Backend -> PathTypeW -> PathData -> m ()
restoreFn' Backend
b PathTypeW
pt PathData
pd = do
      let MkPathI OsPath
trashPath' = PathI 'TrashHome
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryPath
getTrashPath PathI 'TrashHome
trashHome (PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName)
          MkPathI OsPath
trashInfoPath' = Backend
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> PathI 'TrashEntryInfo
getTrashInfoPath Backend
b PathI 'TrashHome
trashHome (PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName)

      -- 3. Attempt restore
      let original :: OsPath
original = PathData
pd PathData -> Optic' A_Lens NoIx PathData OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  PathData
  PathData
  (PathI 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
#originalPath Optic
  A_Lens
  NoIx
  PathData
  PathData
  (PathI 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
-> Optic
     An_Iso
     NoIx
     (PathI 'TrashEntryOriginalPath)
     (PathI 'TrashEntryOriginalPath)
     OsPath
     OsPath
-> Optic' A_Lens NoIx PathData OsPath
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  An_Iso
  NoIx
  (PathI 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
  OsPath
  OsPath
#unPathI
      PathTypeW -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadPathWriter m) =>
PathTypeW -> OsPath -> OsPath -> m ()
PathType.renameFn PathTypeW
pt OsPath
trashPath' OsPath
original
      $(logInfo) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Restored: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OsPath -> Text
decodeOsToFpDisplayExT OsPath
original

      -- 4. Delete info
      --
      -- NOTE: We do not do any error handling here as at this point we have
      -- accomplished our goal: restore the file. That the trash is now out of sync
      -- is bad, but there isn't anything we can do other than alert the user.
      OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
PW.removeFile OsPath
trashInfoPath'

-- | Searches for a single result. Throws exceptions for decode errors or if
-- the info file exists, yet the path itself does not.
findOnePathData ::
  forall m pd.
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    MonadCatch m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    Serial pd,
    Show pd
  ) =>
  PathI TrashHome ->
  PathI TrashEntryFileName ->
  BackendArgs m pd ->
  m (Maybe PathData)
findOnePathData :: forall (m :: * -> *) pd.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd, Show pd) =>
PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> BackendArgs m pd
-> m (Maybe PathData)
findOnePathData PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName BackendArgs m pd
backendArgs = Text -> m (Maybe PathData) -> m (Maybe PathData)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"findOnePathData" (m (Maybe PathData) -> m (Maybe PathData))
-> m (Maybe PathData) -> m (Maybe PathData)
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Searching for: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
pathName
  let backend :: Backend
backend = BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic' A_Lens NoIx (BackendArgs m pd) Backend -> Backend
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (BackendArgs m pd) Backend
#backend
      trashInfoPath :: PathI 'TrashEntryInfo
trashInfoPath@(MkPathI OsPath
trashInfoPath') =
        Backend
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> PathI 'TrashEntryInfo
getTrashInfoPath Backend
backend PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName

  Bool
pathInfoExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
trashInfoPath'
  if Bool -> Bool
not Bool
pathInfoExists
    then do
      $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"File does not exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryInfo -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryInfo
trashInfoPath
      Maybe PathData -> m (Maybe PathData)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PathData
forall a. Maybe a
Nothing
    else do
      ByteString
contents <- OsPath -> m ByteString
forall (m :: * -> *).
(MonadFileReader m, HasCallStack) =>
OsPath -> m ByteString
readBinaryFile OsPath
trashInfoPath'
      PathData
pathData <- case forall a.
Serial a =>
DecodeExtra a -> ByteString -> Either String a
decode @pd DecodeExtra pd
PathI 'TrashEntryFileName
pathName ByteString
contents of
        Left String
err -> do
          $(logError) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Decode error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a. Show a => a -> Text
showt ByteString
contents
          InfoDecodeE -> m PathData
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (InfoDecodeE -> m PathData) -> InfoDecodeE -> m PathData
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryInfo -> ByteString -> String -> InfoDecodeE
MkInfoDecodeE PathI 'TrashEntryInfo
trashInfoPath ByteString
contents String
err
        Right pd
pd -> do
          $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Search successful: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> pd -> Text
forall a. Show a => a -> Text
showt pd
pd
          (BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic'
     A_Lens
     NoIx
     (BackendArgs m pd)
     (PathI 'TrashHome -> pd -> m PathData)
-> PathI 'TrashHome
-> pd
-> m PathData
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (BackendArgs m pd)
  (PathI 'TrashHome -> pd -> m PathData)
#toCorePathData) PathI 'TrashHome
trashHome pd
pd

      -- if we get here then we know the trash path info exists, so the path
      -- itself better exist.
      Bool
pathExists <- PathI 'TrashHome -> PathData -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
PathI 'TrashHome -> PathData -> m Bool
trashPathExists PathI 'TrashHome
trashHome PathData
pathData
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pathExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        $(logError) Text
"Path does not exist"
        TrashEntryFileNotFoundE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (TrashEntryFileNotFoundE -> m ())
-> TrashEntryFileNotFoundE -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashHome
-> PathI 'TrashEntryFileName -> TrashEntryFileNotFoundE
MkTrashEntryFileNotFoundE PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName

      Maybe PathData -> m (Maybe PathData)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PathData -> m (Maybe PathData))
-> Maybe PathData -> m (Maybe PathData)
forall a b. (a -> b) -> a -> b
$ PathData -> Maybe PathData
forall a. a -> Maybe a
Just PathData
pathData

-- | Performs a wildcard search. Can throw exceptions if paths fail to decode,
-- or if the index fails to read (i.e. anything malformed).
findManyPathData ::
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    Serial pd
  ) =>
  BackendArgs m pd ->
  PathI TrashHome ->
  PathI TrashEntryFileName ->
  m (Seq PathData)
findManyPathData :: forall pd k (m :: * -> *).
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd) =>
BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m (Seq PathData)
findManyPathData BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName = Text -> m (Seq PathData) -> m (Seq PathData)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"findManyPathData" (m (Seq PathData) -> m (Seq PathData))
-> m (Seq PathData) -> m (Seq PathData)
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Searching for: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
pathName
  Seq PathData
index <- ((PathData, PathI 'TrashEntryPath) -> PathData)
-> Seq (PathData, PathI 'TrashEntryPath) -> Seq PathData
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic' A_Lens NoIx (PathData, PathI 'TrashEntryPath) PathData
-> (PathData, PathI 'TrashEntryPath) -> PathData
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (PathData, PathI 'TrashEntryPath) PathData
forall s t a b. Field1 s t a b => Lens s t a b
_1) (Seq (PathData, PathI 'TrashEntryPath) -> Seq PathData)
-> (Index -> Seq (PathData, PathI 'TrashEntryPath))
-> Index
-> Seq PathData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) -> m Index -> m (Seq PathData)
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
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Index: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Seq PathData -> Text
forall a. Show a => a -> Text
showt Seq PathData
index

  Text
pathNameText <- String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM (PathI 'TrashEntryFileName
pathName PathI 'TrashEntryFileName
-> Optic
     An_Iso
     NoIx
     (PathI 'TrashEntryFileName)
     (PathI 'TrashEntryFileName)
     OsPath
     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)
  (PathI 'TrashEntryFileName)
  OsPath
  OsPath
#unPathI)

  (PathData -> m Bool) -> Seq PathData -> m (Seq PathData)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Seq a -> m (Seq a)
Utils.filterSeqM (Text -> PathData -> m Bool
forall {k} {l} {k} {m :: * -> *} {a} {u} {v}.
(JoinKinds k l k, Is k A_Getter, MonadThrow m,
 LabelOptic "fileName" k a a u v,
 LabelOptic "unPathI" l u v OsPath OsPath, MonadLogger m, Show a) =>
Text -> a -> m Bool
pdMatchesWildcard Text
pathNameText) Seq PathData
index
  where
    pdMatchesWildcard :: Text -> a -> m Bool
pdMatchesWildcard Text
pathNameText' a
pd = do
      String
fp <- OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM (a
pd a -> Optic' k NoIx a OsPath -> OsPath
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. (Optic k NoIx a a u v
#fileName Optic k NoIx a a u v
-> Optic l NoIx u v OsPath OsPath -> Optic' k NoIx a OsPath
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic l NoIx u v OsPath OsPath
#unPathI))
      let fpTxt :: Text
fpTxt = String -> Text
T.pack String
fp
          matches :: Bool
matches = Text -> Text -> Bool
Utils.matchesWildcards Text
pathNameText' Text
fpTxt

      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
matches
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ $(logDebug)
        (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Found a match: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showt a
pd

      Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
matches

-- | The result of searching for a trash entry.
data PathDataSearchResult
  = SearchSuccess (NESeq PathData)
  | SearchSingleFailure (PathI TrashEntryFileName)
  | SearchWildcardFailure (PathI TrashEntryFileName)
  deriving stock (PathDataSearchResult -> PathDataSearchResult -> Bool
(PathDataSearchResult -> PathDataSearchResult -> Bool)
-> (PathDataSearchResult -> PathDataSearchResult -> Bool)
-> Eq PathDataSearchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathDataSearchResult -> PathDataSearchResult -> Bool
== :: PathDataSearchResult -> PathDataSearchResult -> Bool
$c/= :: PathDataSearchResult -> PathDataSearchResult -> Bool
/= :: PathDataSearchResult -> PathDataSearchResult -> Bool
Eq, Int -> PathDataSearchResult -> String -> String
[PathDataSearchResult] -> String -> String
PathDataSearchResult -> String
(Int -> PathDataSearchResult -> String -> String)
-> (PathDataSearchResult -> String)
-> ([PathDataSearchResult] -> String -> String)
-> Show PathDataSearchResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PathDataSearchResult -> String -> String
showsPrec :: Int -> PathDataSearchResult -> String -> String
$cshow :: PathDataSearchResult -> String
show :: PathDataSearchResult -> String
$cshowList :: [PathDataSearchResult] -> String -> String
showList :: [PathDataSearchResult] -> String -> String
Show)

-- | Searches for the given trash name in the trash.
findPathData ::
  ( DecodeExtra pd ~ PathI TrashEntryFileName,
    HasCallStack,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    Serial pd,
    Show pd
  ) =>
  BackendArgs m pd ->
  PathI TrashHome ->
  PathI TrashEntryFileName ->
  m PathDataSearchResult
findPathData :: forall pd k (m :: * -> *).
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd, Show pd) =>
BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m PathDataSearchResult
findPathData BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome pathName :: PathI 'TrashEntryFileName
pathName@(MkPathI OsPath
pathName') = Text -> m PathDataSearchResult -> m PathDataSearchResult
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"findPathData" (m PathDataSearchResult -> m PathDataSearchResult)
-> m PathDataSearchResult -> m PathDataSearchResult
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Searching for: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
pathName

  String
pathNameStr <- OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM OsPath
pathName'
  let pathNameTxt :: Text
pathNameTxt = String -> Text
T.pack String
pathNameStr

  if
    -- 1. Found a (n unescaped) wildcard; findMany (findMany handles the case
    -- where pathName also includes the sequence \\*).
    | String -> Bool
hasWildcard String
pathNameStr -> do
        BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m (Seq PathData)
forall pd k (m :: * -> *).
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd) =>
BackendArgs m pd
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> m (Seq PathData)
findManyPathData BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName m (Seq PathData)
-> (Seq PathData -> PathDataSearchResult) -> m PathDataSearchResult
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Seq PathData
Seq.Empty -> PathI 'TrashEntryFileName -> PathDataSearchResult
SearchWildcardFailure PathI 'TrashEntryFileName
pathName
          (PathData
x :<| Seq PathData
xs) -> NESeq PathData -> PathDataSearchResult
SearchSuccess (PathData
x PathData -> Seq PathData -> NESeq PathData
forall a. a -> Seq a -> NESeq a
:<|| Seq PathData
xs)
    -- 2. Found the sequence \\*. As we have confirmed there are no unescaped
    -- wildcards by this point, we can simply findOne as normal, after removing
    -- the escape.
    | Text
"\\*" Text -> Text -> Bool
`T.isInfixOf` Text
pathNameTxt -> do
        $(logDebug)
          (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Found escape sequence \\* in path '",
              Text
pathNameTxt,
              Text
"'. Treating as the literal *."
            ]
        let literal :: Text
literal = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\*" Text
"*" Text
pathNameTxt
        OsPath
literalPath <- String -> m OsPath
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
String -> m OsPath
encodeFpToOsThrowM (String -> m OsPath) -> String -> m OsPath
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
literal
        PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> BackendArgs m pd
-> m (Maybe PathData)
forall (m :: * -> *) pd.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd, Show pd) =>
PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> BackendArgs m pd
-> m (Maybe PathData)
findOnePathData PathI 'TrashHome
trashHome (OsPath -> PathI 'TrashEntryFileName
forall (i :: PathIndex). OsPath -> PathI i
MkPathI OsPath
literalPath) BackendArgs m pd
backendArgs m (Maybe PathData)
-> (Maybe PathData -> PathDataSearchResult)
-> m PathDataSearchResult
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Maybe PathData
Nothing -> PathI 'TrashEntryFileName -> PathDataSearchResult
SearchSingleFailure PathI 'TrashEntryFileName
pathName
          Just PathData
pd -> NESeq PathData -> PathDataSearchResult
SearchSuccess (PathData
pd PathData -> Seq PathData -> NESeq PathData
forall a. a -> Seq a -> NESeq a
:<|| Seq PathData
forall a. Seq a
Seq.empty)

    -- 3. No * at all; normal
    | Bool
otherwise -> do
        PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> BackendArgs m pd
-> m (Maybe PathData)
forall (m :: * -> *) pd.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 MonadCatch m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, Serial pd, Show pd) =>
PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> BackendArgs m pd
-> m (Maybe PathData)
findOnePathData PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pathName BackendArgs m pd
backendArgs m (Maybe PathData)
-> (Maybe PathData -> PathDataSearchResult)
-> m PathDataSearchResult
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Maybe PathData
Nothing -> PathI 'TrashEntryFileName -> PathDataSearchResult
SearchSingleFailure PathI 'TrashEntryFileName
pathName
          Just PathData
pd -> NESeq PathData -> PathDataSearchResult
SearchSuccess (PathData
pd PathData -> Seq PathData -> NESeq PathData
forall a. a -> Seq a -> NESeq a
:<|| Seq PathData
forall a. Seq a
Seq.empty)
  where
    hasWildcard :: String -> Bool
hasWildcard [] = Bool
False
    -- escaped; ignore
    hasWildcard (Char
'\\' : Char
'*' : String
xs) = String -> Bool
hasWildcard String
xs
    hasWildcard (Char
'*' : String
_) = Bool
True
    hasWildcard (Char
_ : String
xs) = String -> Bool
hasWildcard String
xs

-- | Merges source into dest, failing if there are any collisions.
mergeTrashDirs ::
  ( HasCallStack,
    MonadFileReader m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadMask m,
    MonadPathReader m,
    MonadPathWriter m
  ) =>
  -- | src
  PathI TrashHome ->
  -- | dest
  PathI TrashHome ->
  m ()
mergeTrashDirs :: forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadMask m, MonadPathReader m, MonadPathWriter m) =>
PathI 'TrashHome -> PathI 'TrashHome -> m ()
mergeTrashDirs (MkPathI OsPath
src) (MkPathI OsPath
dest) = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"mergeTrashDirs" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  $(logTrace) Text
"Merging attempt"
  CopyDirConfig -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
 MonadPathWriter m) =>
CopyDirConfig -> OsPath -> OsPath -> m ()
WDir.copyDirectoryRecursiveConfig CopyDirConfig
config OsPath
src OsPath
dest
  $(logInfo) Text
"Merge successful"
  where
    config :: CopyDirConfig
config =
      MkCopyDirConfig
        { overwrite :: Overwrite
overwrite = Overwrite
OverwriteDirectories,
          targetName :: TargetName
targetName = TargetName
TargetNameDest
        }

deleteFileName ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m,
    MonadPathWriter m
  ) =>
  PathI TrashHome ->
  PathData ->
  m ()
deleteFileName :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
 MonadPathWriter m) =>
PathI 'TrashHome -> PathData -> m ()
deleteFileName PathI 'TrashHome
trashHome PathData
pd = PathTypeW -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
 MonadPathWriter m) =>
PathTypeW -> OsPath -> m ()
PathType.deleteFn (PathData
pd PathData -> Optic' A_Lens NoIx PathData PathTypeW -> PathTypeW
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData PathTypeW
#pathType) OsPath
trashPath'
  where
    MkPathI OsPath
trashPath' = PathI 'TrashHome
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryPath
getTrashPath PathI 'TrashHome
trashHome (PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName)

-- | Returns 'True' if the 'PathData'\'s @fileName@ corresponds to a real path
-- that exists in 'TrashHome'.
trashPathExists ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  PathI TrashHome ->
  PathData ->
  m Bool
trashPathExists :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
PathI 'TrashHome -> PathData -> m Bool
trashPathExists PathI 'TrashHome
th PathData
pd = OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m Bool
doesAnyPathExist OsPath
trashPath'
  where
    -- NOTE: doesPathExist rather than doesFile/Dir... as that requires knowing
    -- the path type. See Note [PathData PathType conditions].

    MkPathI OsPath
trashPath' = PathI 'TrashHome
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryPath
getTrashPath PathI 'TrashHome
th (PathData
pd PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName)

getTrashPath :: PathI TrashHome -> PathI TrashEntryFileName -> PathI TrashEntryPath
getTrashPath :: PathI 'TrashHome
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryPath
getTrashPath PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
name = PathI 'TrashHome
trashHome PathI 'TrashHome -> PathI Any -> PathI 'TrashEntryPath
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> OsPath -> PathI Any
forall (i :: PathIndex). OsPath -> PathI i
MkPathI OsPath
Default.Utils.pathFiles PathI Any -> PathI 'TrashEntryFileName -> PathI Any
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> PathI 'TrashEntryFileName
name

getTrashInfoPath ::
  Backend ->
  PathI TrashHome ->
  PathI TrashEntryFileName ->
  PathI TrashEntryInfo
getTrashInfoPath :: Backend
-> PathI 'TrashHome
-> PathI 'TrashEntryFileName
-> PathI 'TrashEntryInfo
getTrashInfoPath Backend
backend PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
name =
  PathI 'TrashHome
trashHome
    PathI 'TrashHome -> PathI Any -> PathI 'TrashEntryInfo
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> OsPath -> PathI Any
forall (i :: PathIndex). OsPath -> PathI i
MkPathI OsPath
Default.Utils.pathInfo
    PathI Any -> PathI 'TrashEntryFileName -> PathI Any
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> (OsPath -> OsPath)
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryFileName
forall (i :: PathIndex). (OsPath -> OsPath) -> PathI i -> PathI i
Paths.liftPathI' (OsPath -> OsPath -> OsPath
<.> Backend -> OsPath
Backend.Data.backendExt Backend
backend) PathI 'TrashEntryFileName
name