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

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

    -- * Restore
    restore,

    -- * Information
    getIndex,
    getMetadata,

    -- * Transformations
    merge,

    -- * Rosetta
    toRosetta,
    fromRosetta,

    -- * Existence
    isFdo,
  )
where

import Charon.Backend.Data (Backend (BackendFdo))
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.Fdo.BackendArgs qualified as BackendArgs
import Charon.Backend.Fdo.DirectorySizes
  ( DirectorySizes (MkDirectorySizes),
    DirectorySizesEntry
      ( MkDirectorySizesEntry,
        fileName,
        size,
        time
      ),
  )
import Charon.Backend.Fdo.DirectorySizes qualified as DirectorySizes
import Charon.Backend.Fdo.PathData qualified as Fdo.PathData
import Charon.Backend.Fdo.Utils qualified as Fdo.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.PathData (PathData)
import Charon.Data.PathData qualified as PathData
import Charon.Data.PathType (PathTypeW)
import Charon.Data.PathType qualified as PathType
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.Env (HasTrashHome (getTrashHome))
import Charon.Prelude
import Charon.Utils qualified as Utils
import Data.HashMap.Strict qualified as HMap
import Data.Sequence qualified as Seq
import Data.Traversable (for)
import Effects.FileSystem.PathReader qualified as PR
import Effects.FileSystem.PathWriter
  ( CopyDirConfig (MkCopyDirConfig, overwrite, targetName),
    Overwrite (OverwriteDirectories),
    TargetName (TargetNameDest),
  )
import Effects.FileSystem.PathWriter qualified as PW
import Effects.System.PosixCompat (_PathTypeDirectory)
import GHC.Exts (IsList (toList))
import Numeric.Algebra (AMonoid (zero), ASemigroup ((.+.)))
import Numeric.Literal.Integer (FromInteger (afromInteger))
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,
    MonadFileReader m,
    MonadFileWriter m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m,
    MonadTime m
  ) =>
  UniqueSeqNE (PathI TrashEntryOriginalPath) ->
  m ()
delete :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadFileReader m, MonadFileWriter m, MonadIORef m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m,
 MonadTime m) =>
UniqueSeqNE (PathI 'TrashEntryOriginalPath) -> m ()
delete UniqueSeqNE (PathI 'TrashEntryOriginalPath)
paths = do
  let appendDirectorySize :: (Fdo.PathData.PathData, PathTypeW, PathI TrashEntryPath) -> m ()
      appendDirectorySize :: (PathData, PathTypeW, PathI 'TrashEntryPath) -> m ()
appendDirectorySize (PathData
pd, PathTypeW
pathType, MkPathI OsPath
newPath) = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"appendDirectorySize"
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Optic' A_Prism NoIx PathTypeW () -> PathTypeW -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
is (Optic An_Iso NoIx PathTypeW PathTypeW PathType PathType
#unPathTypeW Optic An_Iso NoIx PathTypeW PathTypeW PathType PathType
-> Optic A_Prism NoIx PathType PathType () ()
-> Optic' A_Prism NoIx PathTypeW ()
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 A_Prism NoIx PathType PathType () ()
_PathTypeDirectory) PathTypeW
pathType)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          -- In FDO's directorysizes spec, the listed size does not include
          -- the directory itself. That is, while getPathSize calculates
          --
          --     size := size(dir) + size(dir contents)
          --
          -- We actually want
          --
          --     size := size(dir contents)
          --
          -- Thus we remove the dir size after performing the calculation.
          Bytes 'B Natural
size <- OsPath -> m (Bytes 'B Natural)
forall (m :: * -> *).
(HasCallStack, MonadAsync m, MonadCatch m, MonadLoggerNS m,
 MonadPathReader m, MonadPosixCompat m, MonadTerminal m) =>
OsPath -> m (Bytes 'B Natural)
Utils.getPathSize OsPath
newPath
          $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Size: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bytes 'B Natural -> Text
forall a. Show a => a -> Text
showt Bytes 'B Natural
size
          Bytes 'B Natural
sizeWithoutDir <- Bytes 'B Natural -> OsPath -> m (Bytes 'B Natural)
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m) =>
Bytes 'B Natural -> OsPath -> m (Bytes 'B Natural)
sizeMinusDir Bytes 'B Natural
size OsPath
newPath

          let MkTimestamp LocalTime
localTime = PathData
pd PathData -> Optic' A_Lens NoIx PathData Timestamp -> Timestamp
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData Timestamp
#created
              posixMillis :: Natural
posixMillis = Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ LocalTime -> Integer
Utils.localTimeToMillis LocalTime
localTime

          ByteString
fileNameEncoded <- PathData -> m ByteString
forall (m :: * -> *) pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadThrow m) =>
pd -> m ByteString
Fdo.Utils.percentEncodeFileName PathData
pd

          let entry :: DirectorySizesEntry
entry =
                MkDirectorySizesEntry
                  { $sel:size:MkDirectorySizesEntry :: Bytes 'B Natural
size = Bytes 'B Natural
sizeWithoutDir,
                    $sel:time:MkDirectorySizesEntry :: Natural
time = Natural
posixMillis,
                    $sel:fileName:MkDirectorySizesEntry :: ByteString
fileName = ByteString
fileNameEncoded
                  }

          $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"DirSize entry: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DirectorySizesEntry -> Text
forall a. Show a => a -> Text
showt DirectorySizesEntry
entry
          DirectorySizesEntry -> m ()
forall (m :: * -> *) env.
(HasCallStack, HasTrashHome env, MonadCatch m, MonadLoggerNS m,
 MonadReader env m, MonadFileReader m, MonadFileWriter m,
 MonadPathReader m, MonadPathWriter m, MonadTime m) =>
DirectorySizesEntry -> m ()
DirectorySizes.appendEntry DirectorySizesEntry
entry

  BackendArgs m PathData
-> ((PathData, 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 ()
Default.deletePostHook BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
BackendArgs.backendArgs (PathData, PathTypeW, PathI 'TrashEntryPath) -> m ()
appendDirectorySize UniqueSeqNE (PathI 'TrashEntryOriginalPath)
paths

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

-- | 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"

  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 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 -> do
      MkDirectorySizes Seq DirectorySizesEntry
directorySizes <- PathI 'TrashHome -> m DirectorySizes
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadPathReader m,
 MonadThrow m) =>
PathI 'TrashHome -> m DirectorySizes
DirectorySizes.readDirectorySizesTrashHome PathI 'TrashHome
trashHome
      let dirSizesMap :: HashMap ByteString DirectorySizesEntry
dirSizesMap = [(ByteString, DirectorySizesEntry)]
-> HashMap ByteString DirectorySizesEntry
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList ([(ByteString, DirectorySizesEntry)]
 -> HashMap ByteString DirectorySizesEntry)
-> [(ByteString, DirectorySizesEntry)]
-> HashMap ByteString DirectorySizesEntry
forall a b. (a -> b) -> a -> b
$ (DirectorySizesEntry -> (ByteString, DirectorySizesEntry))
-> [DirectorySizesEntry] -> [(ByteString, DirectorySizesEntry)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DirectorySizesEntry
e -> (DirectorySizesEntry
e DirectorySizesEntry
-> Optic' A_Lens NoIx DirectorySizesEntry ByteString -> ByteString
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DirectorySizesEntry ByteString
#fileName, DirectorySizesEntry
e)) (Seq DirectorySizesEntry -> [Item (Seq DirectorySizesEntry)]
forall l. IsList l => l -> [Item l]
toList Seq DirectorySizesEntry
directorySizes)
          backendArgs' :: BackendArgs m PathData
backendArgs' = HashMap ByteString DirectorySizesEntry -> BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
HashMap ByteString DirectorySizesEntry -> BackendArgs m PathData
BackendArgs.backendArgsDirectorySizes HashMap ByteString DirectorySizesEntry
dirSizesMap
      BackendArgs m PathData -> 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 PathData
backendArgs' PathI 'TrashHome
trashHome

-- | 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 = 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"

  MkDirectorySizes Seq DirectorySizesEntry
directorySizes <- m DirectorySizes
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadFileReader m,
 MonadPathReader m, MonadReader env m, MonadThrow m) =>
m DirectorySizes
DirectorySizes.readDirectorySizes
  let dirSizesMap :: HashMap ByteString DirectorySizesEntry
dirSizesMap = [(ByteString, DirectorySizesEntry)]
-> HashMap ByteString DirectorySizesEntry
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList ([(ByteString, DirectorySizesEntry)]
 -> HashMap ByteString DirectorySizesEntry)
-> [(ByteString, DirectorySizesEntry)]
-> HashMap ByteString DirectorySizesEntry
forall a b. (a -> b) -> a -> b
$ (DirectorySizesEntry -> (ByteString, DirectorySizesEntry))
-> [DirectorySizesEntry] -> [(ByteString, DirectorySizesEntry)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DirectorySizesEntry
e -> (DirectorySizesEntry
e DirectorySizesEntry
-> Optic' A_Lens NoIx DirectorySizesEntry ByteString -> ByteString
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DirectorySizesEntry ByteString
#fileName, DirectorySizesEntry
e)) (Seq DirectorySizesEntry -> [Item (Seq DirectorySizesEntry)]
forall l. IsList l => l -> [Item l]
toList Seq DirectorySizesEntry
directorySizes)
      backendArgs' :: BackendArgs m PathData
backendArgs' = HashMap ByteString DirectorySizesEntry -> BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
HashMap ByteString DirectorySizesEntry -> BackendArgs m PathData
BackendArgs.backendArgsDirectorySizes HashMap ByteString DirectorySizesEntry
dirSizesMap

  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
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,
    MonadFileWriter m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixCompat m,
    MonadReader env m,
    MonadTerminal m,
    MonadTime m
  ) =>
  UniqueSeqNE (PathI TrashEntryFileName) ->
  m ()
restore :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadAsync m, MonadCatch m,
 MonadIORef m, MonadFileReader m, MonadFileWriter m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadPosixCompat m, MonadReader env m, MonadTerminal m,
 MonadTime m) =>
UniqueSeqNE (PathI 'TrashEntryFileName) -> m ()
restore =
  BackendArgs m PathData
-> (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 ()
Default.restorePostHook
    BackendArgs m PathData
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadLoggerNS m, MonadPathReader m,
 MonadPosixCompat m, MonadTerminal m) =>
BackendArgs m PathData
BackendArgs.backendArgs
    (Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"removeDirectorySize" (m () -> m ()) -> (PathData -> m ()) -> PathData -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathData -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadCatch m, MonadFileReader m,
 MonadFileWriter m, MonadLoggerNS m, MonadPathReader m,
 MonadPathWriter m, MonadReader env m, MonadTime m) =>
PathData -> m ()
removeDirectorySize)

-- | 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.backendArgs

merge ::
  ( HasCallStack,
    HasTrashHome env,
    MonadFileReader m,
    MonadFileWriter m,
    MonadIORef m,
    MonadLoggerNS m,
    MonadMask m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTime m
  ) =>
  PathI TrashHome ->
  PathI TrashHome ->
  m ()
merge :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadFileReader m,
 MonadFileWriter m, MonadIORef m, MonadLoggerNS m, MonadMask m,
 MonadPathReader m, MonadPathWriter m, MonadReader env m,
 MonadTime 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
$ do
  $(logTrace) Text
"In merge"
  DirectorySizes
srcDirectorySizes <- PathI 'TrashHome -> m DirectorySizes
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadPathReader m,
 MonadThrow m) =>
PathI 'TrashHome -> m DirectorySizes
DirectorySizes.readDirectorySizesTrashHome PathI 'TrashHome
src
  DirectorySizes
destDirectorySizes <- PathI 'TrashHome -> m DirectorySizes
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadPathReader m,
 MonadThrow m) =>
PathI 'TrashHome -> m DirectorySizes
DirectorySizes.readDirectorySizesTrashHome PathI 'TrashHome
dest
  OsPath
directorySizesPath <- m OsPath
forall env (m :: * -> *).
(HasTrashHome env, MonadReader env m) =>
m OsPath
DirectorySizes.getDirectorySizesPath

  OsPath
tmpDirSizesPath <- OsPath -> m OsPath
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m,
 MonadTime m) =>
OsPath -> m OsPath
Utils.getRandomTmpFile [osp|directorysizes|]

  OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
PW.renameFile OsPath
directorySizesPath OsPath
tmpDirSizesPath

  CopyDirConfig -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
 MonadPathWriter m) =>
CopyDirConfig -> OsPath -> OsPath -> m ()
PW.copyDirectoryRecursiveConfig CopyDirConfig
config OsPath
src' OsPath
dest'
    m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAnyCS` \SomeException
ex -> do
      OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
PW.renameFile OsPath
tmpDirSizesPath OsPath
directorySizesPath
      $(logError) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Error merging directories: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
displayExceptiont SomeException
ex
      SomeException -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS SomeException
ex

  -- If we reach here then we know the copy succeeded, hence src and dest
  -- have no clashes. Thus it is safe to combine the directorysizes
  let mergedDirectorySizes :: DirectorySizes
mergedDirectorySizes = DirectorySizes
srcDirectorySizes DirectorySizes -> DirectorySizes -> DirectorySizes
forall a. Semigroup a => a -> a -> a
<> DirectorySizes
destDirectorySizes

  PathI 'TrashHome -> DirectorySizes -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadFileWriter m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadTime m) =>
PathI 'TrashHome -> DirectorySizes -> m ()
DirectorySizes.writeDirectorySizesTrashHome PathI 'TrashHome
dest DirectorySizes
mergedDirectorySizes
  where
    src' :: OsPath
src' = PathI 'TrashHome
src 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
    dest' :: OsPath
dest' = PathI 'TrashHome
dest 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
    config :: CopyDirConfig
config =
      MkCopyDirConfig
        { overwrite :: Overwrite
overwrite = Overwrite
OverwriteDirectories,
          targetName :: TargetName
targetName = TargetName
TargetNameDest
        }

toRosetta ::
  ( 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 :: * -> *).
(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
 -> (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
_) -> Bytes 'B Natural
acc Bytes 'B Natural -> Bytes 'B Natural -> Bytes 'B Natural
forall s. ASemigroup s => s -> s -> s
.+. 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
forall m. AMonoid m => m
zero (Index
index Index
-> Optic' An_Iso NoIx Index (Seq (PathData, PathI 'TrashEntryPath))
-> Seq (PathData, 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 (PathData, 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,
    MonadTime m
  ) =>
  PathI TrashHome ->
  Rosetta ->
  m ()
fromRosetta :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadFileReader m,
 MonadFileWriter m, MonadIORef m, MonadMask m, MonadPathReader m,
 MonadPathWriter m, MonadTime 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 (Maybe DirectorySizesEntry)
mdirectorySizes <- Seq (PathData, PathI 'TrashEntryPath)
-> ((PathData, PathI 'TrashEntryPath)
    -> m (Maybe DirectorySizesEntry))
-> m (Seq (Maybe DirectorySizesEntry))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Rosetta
rosetta Rosetta
-> Optic'
     A_Lens NoIx Rosetta (Seq (PathData, PathI 'TrashEntryPath))
-> Seq (PathData, 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 (PathData, PathI 'TrashEntryPath))
-> Optic'
     A_Lens NoIx Rosetta (Seq (PathData, 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 (PathData, PathI 'TrashEntryPath))
#unIndex)) (((PathData, PathI 'TrashEntryPath)
  -> m (Maybe DirectorySizesEntry))
 -> m (Seq (Maybe DirectorySizesEntry)))
-> ((PathData, PathI 'TrashEntryPath)
    -> m (Maybe DirectorySizesEntry))
-> m (Seq (Maybe DirectorySizesEntry))
forall a b. (a -> b) -> a -> b
$ \(PathData
pd, MkPathI OsPath
oldTrashPath) -> do
    -- transform core path data to fdo
    let fdoPathData :: PathData
fdoPathData = PathData -> PathData
Fdo.PathData.fromCorePathData PathData
pd
        newTrashPath :: OsPath
newTrashPath =
          OsPath
trashPathDir
            OsPath -> OsPath -> OsPath
</> (PathData
fdoPathData 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 (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
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
fdoPathData
    let filePath :: OsPath
filePath =
          OsPath
trashInfoDir
            OsPath -> OsPath -> OsPath
</> (PathData
fdoPathData 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|.trashinfo|]

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

    -- build directorysizes
    if PathData -> Bool
PathData.isDirectory PathData
pd
      then do
        ByteString
entryFileName <- PathData -> m ByteString
forall (m :: * -> *) pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadThrow m) =>
pd -> m ByteString
Fdo.Utils.percentEncodeFileName PathData
pd

        Bytes 'B Natural
sizeWithoutDir <- Bytes 'B Natural -> OsPath -> m (Bytes 'B Natural)
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m) =>
Bytes 'B Natural -> OsPath -> m (Bytes 'B Natural)
sizeMinusDir (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) OsPath
oldTrashPath

        let time :: Integer
time = LocalTime -> Integer
Utils.localTimeToMillis (LocalTime -> Integer) -> LocalTime -> Integer
forall a b. (a -> b) -> a -> b
$ PathData
pd PathData -> Optic' A_Lens NoIx PathData LocalTime -> LocalTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. (Optic A_Lens NoIx PathData PathData Timestamp Timestamp
#created Optic A_Lens NoIx PathData PathData Timestamp Timestamp
-> Optic An_Iso NoIx Timestamp Timestamp LocalTime LocalTime
-> Optic' A_Lens NoIx PathData LocalTime
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 Timestamp Timestamp LocalTime LocalTime
#unTimestamp)
            entry :: DirectorySizesEntry
entry =
              MkDirectorySizesEntry
                { $sel:size:MkDirectorySizesEntry :: Bytes 'B Natural
size = Bytes 'B Natural
sizeWithoutDir,
                  $sel:time:MkDirectorySizesEntry :: Natural
time = Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
time,
                  $sel:fileName:MkDirectorySizesEntry :: ByteString
fileName = ByteString
entryFileName
                }
        PathI 'TrashHome -> DirectorySizesEntry -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLoggerNS m, MonadFileReader m,
 MonadFileWriter m, MonadPathReader m, MonadPathWriter m,
 MonadTime m) =>
PathI 'TrashHome -> DirectorySizesEntry -> m ()
DirectorySizes.appendEntryTrashHome PathI 'TrashHome
tmpDir DirectorySizesEntry
entry
        Maybe DirectorySizesEntry -> m (Maybe DirectorySizesEntry)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DirectorySizesEntry -> m (Maybe DirectorySizesEntry))
-> Maybe DirectorySizesEntry -> m (Maybe DirectorySizesEntry)
forall a b. (a -> b) -> a -> b
$ DirectorySizesEntry -> Maybe DirectorySizesEntry
forall a. a -> Maybe a
Just DirectorySizesEntry
entry
      else Maybe DirectorySizesEntry -> m (Maybe DirectorySizesEntry)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DirectorySizesEntry
forall a. Maybe a
Nothing

  -- write directorysizes
  let catMaybes :: Seq a -> Maybe a -> Seq a
catMaybes Seq a
acc Maybe a
Nothing = Seq a
acc
      catMaybes Seq a
acc (Just a
x) = Seq a
acc Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
x

      directorySizes :: Seq DirectorySizesEntry
directorySizes =
        (DirectorySizesEntry -> (Natural, ByteString))
-> Seq DirectorySizesEntry -> Seq DirectorySizesEntry
forall b a. Ord b => (a -> b) -> Seq a -> Seq a
Seq.sortOn (\DirectorySizesEntry
entry -> (DirectorySizesEntry
entry DirectorySizesEntry
-> Optic' A_Lens NoIx DirectorySizesEntry Natural -> Natural
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DirectorySizesEntry Natural
#time, DirectorySizesEntry
entry DirectorySizesEntry
-> Optic' A_Lens NoIx DirectorySizesEntry ByteString -> ByteString
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DirectorySizesEntry ByteString
#fileName))
          (Seq DirectorySizesEntry -> Seq DirectorySizesEntry)
-> Seq DirectorySizesEntry -> Seq DirectorySizesEntry
forall a b. (a -> b) -> a -> b
$ (Seq DirectorySizesEntry
 -> Maybe DirectorySizesEntry -> Seq DirectorySizesEntry)
-> Seq DirectorySizesEntry
-> Seq (Maybe DirectorySizesEntry)
-> Seq DirectorySizesEntry
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq DirectorySizesEntry
-> Maybe DirectorySizesEntry -> Seq DirectorySizesEntry
forall {a}. Seq a -> Maybe a -> Seq a
catMaybes Seq DirectorySizesEntry
forall a. Seq a
Seq.empty Seq (Maybe DirectorySizesEntry)
mdirectorySizes

  PathI 'TrashHome -> DirectorySizes -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadFileWriter m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadTime m) =>
PathI 'TrashHome -> DirectorySizes -> m ()
DirectorySizes.writeDirectorySizesTrashHome PathI 'TrashHome
tmpDir (Seq DirectorySizesEntry -> DirectorySizes
MkDirectorySizes Seq DirectorySizesEntry
directorySizes)

removeDirectorySize ::
  ( HasCallStack,
    HasTrashHome env,
    MonadCatch m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTime m
  ) =>
  PathData ->
  m ()
removeDirectorySize :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadCatch m, MonadFileReader m,
 MonadFileWriter m, MonadLoggerNS m, MonadPathReader m,
 MonadPathWriter m, MonadReader env m, MonadTime m) =>
PathData -> m ()
removeDirectorySize PathData
pd = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PathData -> Bool
PathData.isDirectory PathData
pd) (PathData -> m ()
removeEntry PathData
pd)
  where
    removeEntry :: PathData -> m ()
removeEntry = PathData -> m ByteString
forall (m :: * -> *) pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadThrow m) =>
pd -> m ByteString
Fdo.Utils.percentEncodeFileName (PathData -> m ByteString)
-> (ByteString -> m ()) -> PathData -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadCatch m, MonadReader env m,
 MonadFileReader m, MonadFileWriter m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadTime m) =>
ByteString -> m ()
DirectorySizes.removeEntry

-- | Determines if the backend is Fdo. The semantics are if the trash is
-- a well-formed fdo backend __and__ it has at least one file with the
-- fdo extension, 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 fdo 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 fdo.
isFdo ::
  ( HasCallStack,
    MonadCatch m,
    MonadLoggerNS m,
    MonadPathReader m
  ) =>
  PathI TrashHome ->
  m (Maybe Bool)
isFdo :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLoggerNS m, MonadPathReader m) =>
PathI 'TrashHome -> m (Maybe Bool)
isFdo 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
"isFdo" (m (Maybe Bool) -> m (Maybe Bool))
-> m (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ do
  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 true.
          $(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
True)
        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 fdo.
            (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
BackendFdo 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 fdo backend: Definitely
      -- false.
      $(logTrace) Text
"Unknown, not fdo"
      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

sizeMinusDir ::
  ( HasCallStack,
    MonadLoggerNS m,
    MonadPathReader m
  ) =>
  -- | The base size b
  Bytes B Natural ->
  -- | The directory path d
  OsPath ->
  -- | b - dir_size(d), clamped at 0.
  m (Bytes B Natural)
sizeMinusDir :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m) =>
Bytes 'B Natural -> OsPath -> m (Bytes 'B Natural)
sizeMinusDir size :: Bytes 'B Natural
size@(MkBytes Natural
sz) OsPath
path = Text -> m (Bytes 'B Natural) -> m (Bytes 'B Natural)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"sizeMinusDir" (m (Bytes 'B Natural) -> m (Bytes 'B Natural))
-> m (Bytes 'B Natural) -> m (Bytes 'B Natural)
forall a b. (a -> b) -> a -> b
$ do
  Natural
dirIntrisicSize <- Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> m Integer -> m Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m Integer
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Integer
PR.getFileSize OsPath
path

  if Bytes 'B Natural
size Bytes 'B Natural -> Bytes 'B Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural -> Bytes 'B Natural
forall (s :: Size) n. n -> Bytes s n
MkBytes Natural
dirIntrisicSize
    then Bytes 'B Natural -> m (Bytes 'B Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes 'B Natural -> m (Bytes 'B Natural))
-> Bytes 'B Natural -> m (Bytes 'B Natural)
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural) -> Bytes 'B Natural -> Bytes 'B Natural
forall a b. (a -> b) -> Bytes 'B a -> Bytes 'B b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Natural
s -> Natural
s Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
dirIntrisicSize) Bytes 'B Natural
size
    else do
      let msg :: Text
msg =
            [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
              [ Text
"Directory intrinsic size (",
                Natural -> Text
forall a. Show a => a -> Text
showt Natural
dirIntrisicSize,
                Text
" bytes) is somehow greater than its combined size (",
                Natural -> Text
forall a. Show a => a -> Text
showt Natural
sz,
                Text
" bytes). Clamping to 0."
              ]
      $(logWarn) Text
msg
      Bytes 'B Natural -> m (Bytes 'B Natural)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes 'B Natural -> m (Bytes 'B Natural))
-> Bytes 'B Natural -> m (Bytes 'B Natural)
forall a b. (a -> b) -> a -> b
$ Integer -> Bytes 'B Natural
forall a. (FromInteger a, HasCallStack) => Integer -> a
afromInteger Integer
0