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

-- | The Cbor backend.
module Charon.Backend.Cbor
  ( -- * Delete
    delete,
    permDelete,
    emptyTrash,

    -- * Restore
    restore,

    -- * Information
    getIndex,
    getMetadata,

    -- * Transformations
    merge,

    -- * Rosetta
    toRosetta,
    fromRosetta,

    -- * Existence
    isCbor,
  )
where

import Charon.Backend.Cbor.BackendArgs (backendArgs)
import Charon.Backend.Cbor.PathData qualified as Cbor.PathData
import Charon.Backend.Data (Backend (BackendCbor))
import Charon.Backend.Data qualified as Backend
import Charon.Backend.Default qualified as Default
import Charon.Backend.Default.Index qualified as Default.Index
import Charon.Backend.Default.Trash qualified as Default.Trash
import Charon.Backend.Default.Utils qualified as Default.Utils
import Charon.Backend.Rosetta (Rosetta (MkRosetta, index, size))
import Charon.Class.Serial qualified as Serial
import Charon.Data.Index (Index)
import Charon.Data.Index qualified as Index
import Charon.Data.Metadata (Metadata)
import Charon.Data.PathType qualified as PathType
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex (TrashEntryFileName, TrashEntryOriginalPath, TrashHome),
  )
import Charon.Data.Paths qualified as Paths
import Charon.Data.UniqueSeqNE (UniqueSeqNE)
import Charon.Env (HasTrashHome)
import Charon.Prelude
import Effects.FileSystem.PathReader qualified as PR
import Numeric.Algebra (AMonoid (zero), ASemigroup ((.+.)))
import System.OsPath qualified as OsP

-- 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 env m.
  ( HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadFileWriter m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m,
    MonadTime m
  ) =>
  UniqueSeqNE (PathI TrashEntryOriginalPath) ->
  m ()
delete :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadFileWriter m, MonadIORef m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadPosixCompat m,
 MonadReader env m, MonadTerminal m, MonadTime m) =>
UniqueSeqNE (PathI 'TrashEntryOriginalPath) -> m ()
delete = BackendArgs m PathData
-> 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
-> UniqueSeqNE (PathI 'TrashEntryOriginalPath) -> m ()
Default.delete BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
backendArgs

-- | Permanently deletes the paths from the trash.
permDelete ::
  forall env m.
  ( HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadLoggerNS m,
    MonadReader env m,
    MonadPosixCompat m,
    MonadTerminal m
  ) =>
  Bool ->
  UniqueSeqNE (PathI TrashEntryFileName) ->
  m ()
permDelete :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadFileReader m, MonadHandleWriter m, MonadIORef m,
 MonadPathReader m, MonadPathWriter m, MonadLoggerNS m,
 MonadReader env m, MonadPosixCompat m, MonadTerminal m) =>
Bool -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
permDelete = BackendArgs m PathData
-> 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
-> Bool -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
Default.permDelete BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
backendArgs

-- | Reads the index at either the specified or default location. If the
-- file does not exist, returns empty.
getIndex ::
  forall env m.
  ( HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadPathReader m,
    MonadLoggerNS m,
    MonadReader env m,
    MonadPosixCompat m,
    MonadTerminal m
  ) =>
  m Index
getIndex :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadFileReader m, MonadPathReader m, MonadLoggerNS m,
 MonadReader env m, MonadPosixCompat m, MonadTerminal m) =>
m Index
getIndex = 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
  $(logTrace) Text
"In getIndex"

  m Bool
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadLoggerNS m,
 MonadPathReader m, MonadReader env m, MonadThrow m) =>
m Bool
Default.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
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
    Bool
True -> BackendArgs m PathData -> 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 PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
backendArgs

-- | Retrieves metadata for the trash directory.
getMetadata ::
  forall m env.
  ( HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m
  ) =>
  m Metadata
getMetadata :: forall (m :: * -> *) env.
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadFileReader m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m) =>
m Metadata
getMetadata = BackendArgs m PathData -> 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
Default.getMetadata BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
backendArgs

-- | @restore trash p@ restores the trashed path @\<trash\>\/p@ to its original
-- location.
restore ::
  forall env m.
  ( HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadIORef m,
    MonadFileReader m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m
  ) =>
  UniqueSeqNE (PathI TrashEntryFileName) ->
  m ()
restore :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadIORef m, MonadFileReader m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadPosixCompat m,
 MonadReader env m, MonadTerminal m) =>
UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
restore = BackendArgs m PathData
-> 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 -> UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
Default.restore BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
backendArgs

-- | Empties the trash.
emptyTrash ::
  forall m env.
  ( HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadFileReader m,
    MonadHandleWriter m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m
  ) =>
  Bool ->
  m ()
emptyTrash :: forall (m :: * -> *) env.
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadFileReader m, MonadHandleWriter m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadPosixCompat m,
 MonadReader env m, MonadTerminal m) =>
Bool -> m ()
emptyTrash = BackendArgs m PathData -> Bool -> 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, MonadHandleWriter m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadReader env m, MonadTerminal m, Serial pd) =>
BackendArgs m pd -> Bool -> m ()
Default.emptyTrash BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
backendArgs

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 -> PathI 'TrashHome -> m ()
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadIORef m, MonadLoggerNS m,
 MonadMask m, MonadPathReader m, MonadPathWriter m) =>
PathI 'TrashHome -> PathI 'TrashHome -> m ()
Default.merge

toRosetta ::
  ( HasCallStack,
    HasTrashHome env,
    MonadAsync m,
    MonadCatch m,
    MonadLoggerNS m,
    MonadFileReader m,
    MonadPathReader m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m
  ) =>
  m Rosetta
toRosetta :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadLoggerNS m, MonadFileReader m, MonadPathReader m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m) =>
m Rosetta
toRosetta = Text -> m Rosetta -> m Rosetta
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"toRosetta" (m Rosetta -> m Rosetta) -> m Rosetta -> m Rosetta
forall a b. (a -> b) -> a -> b
$ do
  $(logTrace) Text
"In toRosetta"

  Index
index <- m Index
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadFileReader m, MonadPathReader m, MonadLoggerNS m,
 MonadReader env m, MonadPosixCompat m, MonadTerminal m) =>
m Index
getIndex
  $(logDebug) (Text
"Index: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Index -> Text
forall a. Show a => a -> Text
showt Index
index)

  let size :: Bytes 'B Natural
size = (Bytes 'B Natural
 -> (PathDataCore, PathI 'TrashEntryPath) -> Bytes 'B Natural)
-> Bytes 'B Natural
-> Seq (PathDataCore, 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 (PathDataCore
pd, PathI 'TrashEntryPath
_) -> Bytes 'B Natural
acc Bytes 'B Natural -> Bytes 'B Natural -> Bytes 'B Natural
forall s. ASemigroup s => s -> s -> s
.+. PathDataCore
pd PathDataCore
-> Optic' A_Lens NoIx PathDataCore (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 PathDataCore (Bytes 'B Natural)
#size) Bytes 'B Natural
forall m. AMonoid m => m
zero (Index
index Index
-> Optic'
     An_Iso NoIx Index (Seq (PathDataCore, PathI 'TrashEntryPath))
-> Seq (PathDataCore, PathI 'TrashEntryPath)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso NoIx Index (Seq (PathDataCore, PathI 'TrashEntryPath))
#unIndex)

  Rosetta -> m Rosetta
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Rosetta -> m Rosetta) -> Rosetta -> m Rosetta
forall a b. (a -> b) -> a -> b
$ MkRosetta
      { Index
$sel:index:MkRosetta :: Index
index :: Index
index,
        Bytes 'B Natural
$sel:size:MkRosetta :: Bytes 'B Natural
size :: Bytes 'B Natural
size
      }

fromRosetta ::
  ( HasCallStack,
    MonadLoggerNS m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadIORef m,
    MonadMask m,
    MonadPathReader m,
    MonadPathWriter m
  ) =>
  PathI TrashHome ->
  Rosetta ->
  m ()
fromRosetta :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadFileReader m,
 MonadFileWriter m, MonadIORef m, MonadMask m, MonadPathReader m,
 MonadPathWriter m) =>
PathI 'TrashHome -> Rosetta -> m ()
fromRosetta PathI 'TrashHome
tmpDir Rosetta
rosetta = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"fromRosetta" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  $(logTrace) Text
"In fromRosetta"
  $(logDebug) (Text
"Temp dir: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashHome -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashHome
tmpDir)

  -- create tmp trash
  (MkPathI OsPath
trashPathDir, MkPathI OsPath
trashInfoDir) <-
    PathI 'TrashHome -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathWriter m) =>
PathI 'TrashHome -> m (PathI 'TrashDirFiles, PathI 'TrashDirInfo)
Default.Trash.createTrashDir PathI 'TrashHome
tmpDir

  Seq (PathDataCore, PathI 'TrashEntryPath)
-> ((PathDataCore, PathI 'TrashEntryPath) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Rosetta
rosetta Rosetta
-> Optic'
     A_Lens NoIx Rosetta (Seq (PathDataCore, PathI 'TrashEntryPath))
-> Seq (PathDataCore, PathI 'TrashEntryPath)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. (Optic A_Lens NoIx Rosetta Rosetta Index Index
#index Optic A_Lens NoIx Rosetta Rosetta Index Index
-> Optic'
     An_Iso NoIx Index (Seq (PathDataCore, PathI 'TrashEntryPath))
-> Optic'
     A_Lens NoIx Rosetta (Seq (PathDataCore, PathI 'TrashEntryPath))
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 Index (Seq (PathDataCore, PathI 'TrashEntryPath))
#unIndex)) (((PathDataCore, PathI 'TrashEntryPath) -> m ()) -> m ())
-> ((PathDataCore, PathI 'TrashEntryPath) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(PathDataCore
pd, MkPathI OsPath
oldTrashPath) -> do
    -- transform core path data to cbor
    let cborPathData :: PathData
cborPathData = PathDataCore -> PathData
Cbor.PathData.fromCorePathData PathDataCore
pd
        newTrashPath :: OsPath
newTrashPath =
          OsPath
trashPathDir
            OsPath -> OsPath -> OsPath
</> (PathData
cborPathData 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 'TrashEntryFileName)
  (PathI 'TrashEntryFileName)
#fileName Optic
  A_Lens
  NoIx
  PathData
  PathData
  (PathI 'TrashEntryFileName)
  (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))

    -- copy dir
    PathTypeW -> OsPath -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
 MonadPathWriter m) =>
PathTypeW -> OsPath -> OsPath -> OsPath -> m ()
PathType.copyPath (PathDataCore
pd PathDataCore
-> Optic' A_Lens NoIx PathDataCore PathTypeW -> PathTypeW
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathDataCore PathTypeW
#pathType) OsPath
oldTrashPath OsPath
newTrashPath OsPath
trashPathDir
    let msg :: Text
msg =
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Copying '",
              OsPath -> Text
decodeOsToFpDisplayExT OsPath
oldTrashPath,
              Text
"' to '",
              OsPath -> Text
decodeOsToFpDisplayExT OsPath
newTrashPath
            ]
    $(logDebug) Text
msg

    -- create info files
    ByteString
encoded <- PathData -> m ByteString
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Serial a) =>
a -> m ByteString
Serial.encodeThrowM PathData
cborPathData
    let filePath :: OsPath
filePath =
          OsPath
trashInfoDir
            OsPath -> OsPath -> OsPath
</> (PathData
cborPathData 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 'TrashEntryFileName)
  (PathI 'TrashEntryFileName)
#fileName Optic
  A_Lens
  NoIx
  PathData
  PathData
  (PathI 'TrashEntryFileName)
  (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))
            OsPath -> OsPath -> OsPath
<.> [osp|.cbor|]

    OsPath -> ByteString -> m ()
forall (m :: * -> *).
(MonadFileWriter m, HasCallStack) =>
OsPath -> ByteString -> m ()
writeBinaryFile OsPath
filePath ByteString
encoded

-- | Determines if the backend is Cbor. The semantics are if the trash is
-- a well-formed cbor backend __and__ it has at least one file with the
-- extension .cbor, then we return @Just True@ (definitely true).
--
-- If the trash does not exist or is not well-formed, we return @Just False@
-- (definitely false).
--
-- If the trash __is__ a well-formed cbor backend but we do not have any files
-- we return Nothing (maybe), because we cannot tell. It __could__ be any
-- backend that shares the same trash structure, including cbor.
isCbor ::
  ( HasCallStack,
    MonadCatch m,
    MonadLoggerNS m,
    MonadPathReader m
  ) =>
  PathI TrashHome ->
  m (Maybe Bool)
isCbor :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLoggerNS m, MonadPathReader m) =>
PathI 'TrashHome -> m (Maybe Bool)
isCbor trashHome :: PathI 'TrashHome
trashHome@(MkPathI OsPath
th) = Text -> m (Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"isCbor" (m (Maybe Bool) -> m (Maybe Bool))
-> m (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ do
  $(logTrace) Text
"In isCbor"
  Bool
exists <-
    PathI 'TrashHome -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m) =>
PathI 'TrashHome -> m Bool
Default.Trash.doesTrashExistPath PathI 'TrashHome
trashHome
      m Bool -> (SomeException -> m Bool) -> m Bool
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAnyCS` \SomeException
_ -> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  if Bool
exists
    then do
      let directorysizesPath :: OsPath
directorysizesPath = OsPath
th OsPath -> OsPath -> OsPath
</> [osp|directorysizes|]

      Bool
isDefinitelyFdo <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
directorysizesPath
      if Bool
isDefinitelyFdo
        then do
          -- Trash dir contains directorysizes (fdo): Definitely false.
          $(logTrace) Text
"Found fdo"
          Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
        else do
          OsPath -> m [OsPath]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m [OsPath]
PR.listDirectory OsPath
trashPath m [OsPath] -> ([OsPath] -> m (Maybe Bool)) -> m (Maybe Bool)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            -- Trash dir is well-formed but contains no files: Maybe.
            [] -> do
              $(logTrace) Text
"Trash dir is well-formed but empty: Maybe"
              Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
            -- Trash dir has at least one file: iff ext matches cbor.
            (OsPath
f : [OsPath]
_) -> do
              let ext :: OsPath
ext = OsPath -> OsPath
OsP.takeExtension OsPath
f
              $(logTrace) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Found file with extension " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OsPath -> Text
decodeOsToFpDisplayExT OsPath
ext
              Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> m (Maybe Bool)) -> Maybe Bool -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Backend -> OsPath
Backend.backendExt Backend
BackendCbor OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath
ext
    else do
      -- Trash does not exist or it is not a well-formed cbor backend: Definitely
      -- false.
      $(logTrace) Text
"Unknown, not cbor"
      Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> m (Maybe Bool)) -> Maybe Bool -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  where
    MkPathI OsPath
trashPath = PathI 'TrashHome -> PathI 'TrashDirInfo
Default.Utils.getTrashInfoDir PathI 'TrashHome
trashHome