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

module Charon.Backend.Default.Utils
  ( -- * Trash paths
    getTrashPathDir,
    getTrashInfoDir,
    getTrashPath,

    -- * Paths
    pathFiles,
    pathInfo,

    -- * Misc
    getPathInfo,
    parseTrashInfoMap,
    pathDataToType,
    lookup,
  )
where

import Charon.Data.PathType (PathTypeW (MkPathTypeW))
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex
      ( TrashDirFiles,
        TrashDirInfo,
        TrashEntryFileName,
        TrashEntryOriginalPath,
        TrashEntryPath,
        TrashHome
      ),
    (<//>),
  )
import Charon.Data.Paths qualified as Paths
import Charon.Exception
  ( DotsPathE (MkDotsPathE),
    EmptyPathE (MkEmptyPathE),
    FileNameEmptyE (MkFileNameEmptyE),
    RenameDuplicateE (MkRenameDuplicateE),
    RootE (MkRootE),
    UniquePathNotPrefixE (MkUniquePathNotPrefixE),
  )
import Charon.Prelude
import Charon.Utils qualified as U
import Data.ByteString.Char8 qualified as C8
import Data.HashMap.Strict qualified as Map
import Data.HashSet qualified as Set
import Data.List qualified as L
import Effects.FileSystem.PathReader qualified as PR
import Effects.FileSystem.Utils qualified as FsUtils
import System.OsPath qualified as FP

-- | Retrieves the trash path dir.
getTrashPathDir :: PathI TrashHome -> PathI TrashDirFiles
getTrashPathDir :: PathI 'TrashHome -> PathI 'TrashDirFiles
getTrashPathDir PathI 'TrashHome
trashHome = PathI 'TrashHome
trashHome PathI 'TrashHome -> PathI Any -> PathI 'TrashDirFiles
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> OsPath -> PathI Any
forall (i :: PathIndex). OsPath -> PathI i
MkPathI OsPath
pathFiles

-- | Retrieves the trash info dir.
getTrashInfoDir :: PathI TrashHome -> PathI TrashDirInfo
getTrashInfoDir :: PathI 'TrashHome -> PathI 'TrashDirInfo
getTrashInfoDir PathI 'TrashHome
trashHome = PathI 'TrashHome
trashHome PathI 'TrashHome -> PathI Any -> PathI 'TrashDirInfo
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> OsPath -> PathI Any
forall (i :: PathIndex). OsPath -> PathI i
MkPathI OsPath
pathInfo

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
pathFiles PathI Any -> PathI 'TrashEntryFileName -> PathI Any
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> PathI 'TrashEntryFileName
name

-- | For a given path, retrieves its unique trash entry file name,
-- original path, and type.
--
-- NOTE: This function is __almost__ backend agnostic. AFAICT the only
-- part that uses internal knowledge is the call to getTrashPath.
-- If we ever write a non-default backend then we should extract that logic
-- to a function and move this fn to Utils, as the rest of the logic is
-- something we will want to use everywhere (e.g. throwIfIllegal).
getPathInfo ::
  ( HasCallStack,
    MonadCatch m,
    MonadLoggerNS m,
    MonadPathReader m
  ) =>
  PathI TrashHome ->
  PathI TrashEntryOriginalPath ->
  m (PathI TrashEntryFileName, PathI TrashEntryOriginalPath, PathTypeW)
getPathInfo :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLoggerNS m, MonadPathReader m) =>
PathI 'TrashHome
-> PathI 'TrashEntryOriginalPath
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
getPathInfo PathI 'TrashHome
trashHome PathI 'TrashEntryOriginalPath
origPath = Text
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"getPathInfo" (m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
    PathTypeW)
 -> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
       PathTypeW))
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
forall a b. (a -> b) -> a -> b
$ do
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Retrieving path data: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryOriginalPath -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryOriginalPath
origPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

  -- It is VERY important that this check is first i.e. we perform it
  -- on the original given path, before any processing. As an example of
  -- what can go wrong, if someone attempts to delete a blank path
  -- (i.e. charon d ""), then canonicalizePath will turn this into the current
  -- directory, as in, will delete the entire working directory. This is
  -- not what we want!
  PathI 'TrashEntryOriginalPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadThrow m) =>
PathI 'TrashEntryOriginalPath -> m ()
throwIfIllegal PathI 'TrashEntryOriginalPath
origPath

  (PathI 'TrashEntryOriginalPath
origAbsolute, PathI 'TrashEntryFileName
fileName) <- PathI 'TrashEntryOriginalPath
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m) =>
PathI 'TrashEntryOriginalPath
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
mkAbsoluteAndGetName PathI 'TrashEntryOriginalPath
origPath

  PathI 'TrashEntryFileName
uniqName <- PathI 'TrashHome
-> PathI 'TrashEntryFileName -> m (PathI 'TrashEntryFileName)
forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m) =>
PathI 'TrashHome
-> PathI 'TrashEntryFileName -> m (PathI 'TrashEntryFileName)
mkUniqName PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
fileName

  -- see NOTE: [getPathType]
  (PathI 'TrashEntryFileName
uniqName,PathI 'TrashEntryOriginalPath
origAbsolute,)
    (PathTypeW
 -> (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
     PathTypeW))
-> (PathType -> PathTypeW)
-> PathType
-> (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
    PathTypeW)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathType -> PathTypeW
MkPathTypeW
    (PathType
 -> (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
     PathTypeW))
-> m PathType
-> m (PathI 'TrashEntryFileName, PathI 'TrashEntryOriginalPath,
      PathTypeW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HasCallStack => OsPath -> m PathType)
-> PathI 'TrashEntryOriginalPath -> m PathType
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI HasCallStack => OsPath -> m PathType
OsPath -> m PathType
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m PathType
PR.getPathType PathI 'TrashEntryOriginalPath
origAbsolute

mkAbsoluteAndGetName ::
  ( HasCallStack,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  PathI TrashEntryOriginalPath ->
  m (PathI TrashEntryOriginalPath, PathI TrashEntryFileName)
mkAbsoluteAndGetName :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m) =>
PathI 'TrashEntryOriginalPath
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
mkAbsoluteAndGetName PathI 'TrashEntryOriginalPath
origPath = Text
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"mkAbsoluteAndGetName" (m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
 -> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName))
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
forall a b. (a -> b) -> a -> b
$ do
  -- Previously we used canonicalizePath instead of makeAbsolute.
  -- This had the problem of turning symlinks into their targets, which
  -- is not what we want. makeAbsolute seems to do what we want.
  --
  -- Note that we now have to manually call dropTrailingPathSeparator.
  -- Previously this was part of canonicalizePath.
  PathI 'TrashEntryOriginalPath
origAbsolute <- (HasCallStack => OsPath -> m OsPath)
-> PathI 'TrashEntryOriginalPath
-> m (PathI 'TrashEntryOriginalPath)
forall (f :: * -> *) (i :: PathIndex).
Functor f =>
(HasCallStack => OsPath -> f OsPath) -> PathI i -> f (PathI i)
Paths.liftPathIF' HasCallStack => OsPath -> m OsPath
OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
PR.makeAbsolute PathI 'TrashEntryOriginalPath
origPath
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Absolute: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryOriginalPath -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryOriginalPath
origAbsolute Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

  -- Have to dropTrailingPathSeparator here because a trailing slash will
  -- make takeFileName give us the wrong path. We also need this so that
  -- later lookups succeed (requires string equality)
  let origAbsoluteNoSlash :: PathI 'TrashEntryOriginalPath
origAbsoluteNoSlash = (OsPath -> OsPath)
-> PathI 'TrashEntryOriginalPath -> PathI 'TrashEntryOriginalPath
forall (i :: PathIndex). (OsPath -> OsPath) -> PathI i -> PathI i
Paths.liftPathI' OsPath -> OsPath
FP.dropTrailingPathSeparator PathI 'TrashEntryOriginalPath
origAbsolute

  -- Need to get the file name here because fp could refer to an
  -- absolute path. In this case, </> returns the 2nd arg which is absolutely
  -- not what we want.
  let fileName :: PathI TrashEntryFileName
      fileName :: PathI 'TrashEntryFileName
fileName = (OsPath -> OsPath)
-> PathI 'TrashEntryOriginalPath -> PathI 'TrashEntryFileName
forall (i :: PathIndex) (j :: PathIndex).
(OsPath -> OsPath) -> PathI i -> PathI j
Paths.liftPathI OsPath -> OsPath
FP.takeFileName PathI 'TrashEntryOriginalPath
origAbsoluteNoSlash
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"File name: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
fileName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

  -- Paranoia check for previous bug: check that derived name is not empty.
  Bool
isEmpty <- (HasCallStack => OsPath -> m Bool)
-> PathI 'TrashEntryFileName -> m Bool
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI ((String -> Bool) -> m String -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (m String -> m Bool) -> (OsPath -> m String) -> OsPath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM) PathI 'TrashEntryFileName
fileName
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isEmpty (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    $(logError) Text
"Decoded filename is empty"
    FileNameEmptyE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (FileNameEmptyE -> m ()) -> FileNameEmptyE -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryOriginalPath -> FileNameEmptyE
MkFileNameEmptyE PathI 'TrashEntryOriginalPath
origPath

  (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
-> m (PathI 'TrashEntryOriginalPath, PathI 'TrashEntryFileName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathI 'TrashEntryOriginalPath
origAbsoluteNoSlash, PathI 'TrashEntryFileName
fileName)

mkUniqName ::
  ( HasCallStack,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  PathI TrashHome ->
  PathI TrashEntryFileName ->
  m (PathI TrashEntryFileName)
mkUniqName :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadPathReader m, MonadThrow m) =>
PathI 'TrashHome
-> PathI 'TrashEntryFileName -> m (PathI 'TrashEntryFileName)
mkUniqName PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
fileName = Text
-> m (PathI 'TrashEntryFileName) -> m (PathI 'TrashEntryFileName)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"getUniqueName" (m (PathI 'TrashEntryFileName) -> m (PathI 'TrashEntryFileName))
-> m (PathI 'TrashEntryFileName) -> m (PathI 'TrashEntryFileName)
forall a b. (a -> b) -> a -> b
$ do
  PathI 'TrashEntryPath
uniqPath <- PathI 'TrashEntryPath -> m (PathI 'TrashEntryPath)
forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadThrow m) =>
PathI 'TrashEntryPath -> m (PathI 'TrashEntryPath)
mkUniqPath (PathI 'TrashHome
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryPath
getTrashPath PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
fileName)
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Unique path: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryPath -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryPath
uniqPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

  let uniqName :: PathI 'TrashEntryFileName
uniqName = (OsPath -> OsPath)
-> PathI 'TrashEntryPath -> PathI 'TrashEntryFileName
forall (i :: PathIndex) (j :: PathIndex).
(OsPath -> OsPath) -> PathI i -> PathI j
Paths.liftPathI (OsPath -> OsPath
FP.takeFileName (OsPath -> OsPath) -> (OsPath -> OsPath) -> OsPath -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath
FP.dropTrailingPathSeparator) PathI 'TrashEntryPath
uniqPath
  $(logDebug) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Unique name: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PathI 'TrashEntryFileName -> Text
forall (i :: PathIndex). PathI i -> Text
Paths.toText PathI 'TrashEntryFileName
uniqName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

  -- Paranoia check for previous bug: check that derived unique name is suffix
  -- of the original name (e.g. foo -> foo (1)).
  PathI 'TrashEntryFileName -> PathI 'TrashEntryFileName -> m ()
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
PathI 'TrashEntryFileName -> PathI 'TrashEntryFileName -> m ()
throwIfNotPrefix PathI 'TrashEntryFileName
fileName PathI 'TrashEntryFileName
uniqName

  PathI 'TrashEntryFileName -> m (PathI 'TrashEntryFileName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathI 'TrashEntryFileName
uniqName

-- | Ensures the filepath @p@ is unique. If @p@ collides with another path,
-- we iteratively try appending numbers, stopping once we find a unique path.
-- For example, for duplicate "file", we will try
--
-- @
-- "file (1)", "file (2)", "file (3)", ...
-- @
mkUniqPath ::
  forall m.
  ( HasCallStack,
    MonadPathReader m,
    MonadThrow m
  ) =>
  PathI TrashEntryPath ->
  m (PathI TrashEntryPath)
mkUniqPath :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadThrow m) =>
PathI 'TrashEntryPath -> m (PathI 'TrashEntryPath)
mkUniqPath PathI 'TrashEntryPath
fp = do
  Bool
b <- (HasCallStack => OsPath -> m Bool)
-> PathI 'TrashEntryPath -> m Bool
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI HasCallStack => OsPath -> m Bool
OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesPathExist PathI 'TrashEntryPath
fp
  if Bool
b
    then HasCallStack => Word16 -> m (PathI 'TrashEntryPath)
Word16 -> m (PathI 'TrashEntryPath)
go Word16
1
    else PathI 'TrashEntryPath -> m (PathI 'TrashEntryPath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathI 'TrashEntryPath
fp
  where
    go :: (HasCallStack) => Word16 -> m (PathI TrashEntryPath)
    go :: HasCallStack => Word16 -> m (PathI 'TrashEntryPath)
go !Word16
counter
      | Word16
counter Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
forall a. Bounded a => a
maxBound =
          RenameDuplicateE -> m (PathI 'TrashEntryPath)
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (RenameDuplicateE -> m (PathI 'TrashEntryPath))
-> RenameDuplicateE -> m (PathI 'TrashEntryPath)
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryPath -> RenameDuplicateE
MkRenameDuplicateE PathI 'TrashEntryPath
fp
      | Bool
otherwise = do
          OsPath
counterStr <- Word16 -> m OsPath
forall {m :: * -> *} {a}. (MonadThrow m, Show a) => a -> m OsPath
mkSuffix Word16
counter
          let fp' :: PathI 'TrashEntryPath
fp' = (OsPath -> OsPath)
-> PathI 'TrashEntryPath -> PathI 'TrashEntryPath
forall (i :: PathIndex). (OsPath -> OsPath) -> PathI i -> PathI i
Paths.liftPathI' (OsPath -> OsPath -> OsPath
forall a. Semigroup a => a -> a -> a
<> OsPath
counterStr) PathI 'TrashEntryPath
fp
          Bool
b <- (HasCallStack => OsPath -> m Bool)
-> PathI 'TrashEntryPath -> m Bool
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI HasCallStack => OsPath -> m Bool
OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesPathExist PathI 'TrashEntryPath
fp'
          if Bool
b
            then HasCallStack => Word16 -> m (PathI 'TrashEntryPath)
Word16 -> m (PathI 'TrashEntryPath)
go (Word16
counter Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1)
            else PathI 'TrashEntryPath -> m (PathI 'TrashEntryPath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathI 'TrashEntryPath
fp'
    mkSuffix :: a -> m OsPath
mkSuffix a
i = String -> m OsPath
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
String -> m OsPath
FsUtils.encodeFpToOsThrowM (String -> m OsPath) -> String -> m OsPath
forall a b. (a -> b) -> a -> b
$ String
" (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

throwIfNotPrefix ::
  ( HasCallStack,
    MonadThrow m
  ) =>
  PathI TrashEntryFileName ->
  PathI TrashEntryFileName ->
  m ()
throwIfNotPrefix :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
PathI 'TrashEntryFileName -> PathI 'TrashEntryFileName -> m ()
throwIfNotPrefix PathI 'TrashEntryFileName
origName PathI 'TrashEntryFileName
newName = do
  String
origNameStr <- (HasCallStack => OsPath -> m String)
-> PathI 'TrashEntryFileName -> m String
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI HasCallStack => OsPath -> m String
OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM PathI 'TrashEntryFileName
origName
  String
newNameStr <- (HasCallStack => OsPath -> m String)
-> PathI 'TrashEntryFileName -> m String
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
Paths.applyPathI HasCallStack => OsPath -> m String
OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM PathI 'TrashEntryFileName
newName

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (String
origNameStr String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
newNameStr)
    (UniquePathNotPrefixE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (UniquePathNotPrefixE -> m ()) -> UniquePathNotPrefixE -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName
-> PathI 'TrashEntryFileName -> UniquePathNotPrefixE
MkUniquePathNotPrefixE PathI 'TrashEntryFileName
origName PathI 'TrashEntryFileName
newName)

throwIfIllegal ::
  ( HasCallStack,
    MonadLoggerNS m,
    MonadThrow m
  ) =>
  PathI TrashEntryOriginalPath ->
  m ()
throwIfIllegal :: forall (m :: * -> *).
(HasCallStack, MonadLoggerNS m, MonadThrow m) =>
PathI 'TrashEntryOriginalPath -> m ()
throwIfIllegal PathI 'TrashEntryOriginalPath
p = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"throwIfIllegal" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
U.whenM (PathI 'TrashEntryOriginalPath -> m Bool
forall (m :: * -> *) (i :: PathIndex).
MonadThrow m =>
PathI i -> m Bool
Paths.isRoot PathI 'TrashEntryOriginalPath
p) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ $(logError) Text
"Path is root!" m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RootE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS RootE
MkRootE
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
U.whenM (PathI 'TrashEntryOriginalPath -> m Bool
forall (m :: * -> *) (i :: PathIndex).
MonadThrow m =>
PathI i -> m Bool
Paths.isEmpty PathI 'TrashEntryOriginalPath
p) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ $(logError) Text
"Path is empty!" m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> EmptyPathE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS EmptyPathE
MkEmptyPathE
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
U.whenM (PathI 'TrashEntryOriginalPath -> m Bool
forall (m :: * -> *) (i :: PathIndex).
MonadThrow m =>
PathI i -> m Bool
Paths.isDots PathI 'TrashEntryOriginalPath
p) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ $(logError) Text
"Path is dots!" m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> DotsPathE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (PathI 'TrashEntryOriginalPath -> DotsPathE
MkDotsPathE PathI 'TrashEntryOriginalPath
p)

-- | Parses a ByteString like:
--
-- @
-- [Trash Info]
-- k1=v1
-- k2=v2
-- ...
-- @
--
-- into a map of @{ ki => vi }@.
--
-- Verifies that the parameter key set is exactly the key set in the map.
parseTrashInfoMap ::
  -- | Expected keys
  HashSet ByteString ->
  -- | ByteString
  ByteString ->
  Either String (HashMap ByteString ByteString)
parseTrashInfoMap :: HashSet ByteString
-> ByteString -> Either String (HashMap ByteString ByteString)
parseTrashInfoMap HashSet ByteString
expectedKeys ByteString
bs =
  case ByteString -> [ByteString]
C8.lines ByteString
bs of
    [] -> String -> Either String (HashMap ByteString ByteString)
forall a b. a -> Either a b
Left String
"Received empty pathdata"
    (ByteString
h : [ByteString]
rest) | ByteString -> Bool
isHeader ByteString
h -> do
      let mp :: HashMap ByteString ByteString
mp = [(ByteString, ByteString)] -> HashMap ByteString ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ((ByteString -> (ByteString, ByteString))
-> [ByteString] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> (ByteString, ByteString)
U.breakEqBS [ByteString]
rest)
          keys :: HashSet ByteString
keys = HashMap ByteString ByteString -> HashSet ByteString
forall k a. HashMap k a -> HashSet k
Map.keysSet HashMap ByteString ByteString
mp
          missingKeys :: HashSet ByteString
missingKeys = HashSet ByteString -> HashSet ByteString -> HashSet ByteString
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
Set.difference HashSet ByteString
expectedKeys HashSet ByteString
keys
          missingKeysStr :: ByteString
missingKeysStr = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
", " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ HashSet ByteString -> [ByteString]
forall a. HashSet a -> [a]
Set.toList HashSet ByteString
missingKeys
          unexpectedKeys :: HashSet ByteString
unexpectedKeys = HashSet ByteString -> HashSet ByteString -> HashSet ByteString
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
Set.difference HashSet ByteString
keys HashSet ByteString
expectedKeys
          unexpectedKeysStr :: ByteString
unexpectedKeysStr = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
", " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ HashSet ByteString -> [ByteString]
forall a. HashSet a -> [a]
Set.toList HashSet ByteString
unexpectedKeys

      Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet ByteString -> Bool
forall a. HashSet a -> Bool
Set.null HashSet ByteString
unexpectedKeys)
        (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left
        (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected keys: '"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
bsToStrLenient ByteString
unexpectedKeysStr
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"

      Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet ByteString -> Bool
forall a. HashSet a -> Bool
Set.null HashSet ByteString
missingKeys)
        (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left
        (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"Missing keys: '"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
bsToStrLenient ByteString
missingKeysStr
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"

      HashMap ByteString ByteString
-> Either String (HashMap ByteString ByteString)
forall a b. b -> Either a b
Right HashMap ByteString ByteString
mp
    [ByteString]
_ -> String -> Either String (HashMap ByteString ByteString)
forall a b. a -> Either a b
Left (String -> Either String (HashMap ByteString ByteString))
-> String -> Either String (HashMap ByteString ByteString)
forall a b. (a -> b) -> a -> b
$ String
"Did not receive header [Trash Info]: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
bsToStr ByteString
bs
  where
    isHeader :: ByteString -> Bool
isHeader = (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"[Trash Info]")

lookup :: ByteString -> HashMap ByteString b -> Either String b
lookup :: forall b. ByteString -> HashMap ByteString b -> Either String b
lookup ByteString
k HashMap ByteString b
mp = case ByteString -> HashMap ByteString b -> Maybe b
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup ByteString
k HashMap ByteString b
mp of
  Maybe b
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"Could not find key: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
bsToStr ByteString
k
  Just b
v -> b -> Either String b
forall a b. b -> Either a b
Right b
v

-- | Derives the 'PathType' from the 'PathData'.
--
-- __IMPORTANT:__ This function is only guaranteed to work if the 'PathData'
-- corresponds to an extant trash entry. In particular, if the 'PathData' has
-- not been created yet, this can fail.
pathDataToType ::
  ( Is k A_Getter,
    LabelOptic' "fileName" k a (PathI TrashEntryFileName),
    HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  PathI TrashHome ->
  a ->
  m PathTypeW
pathDataToType :: forall k a (m :: * -> *).
(Is k A_Getter,
 LabelOptic' "fileName" k a (PathI 'TrashEntryFileName),
 HasCallStack, MonadCatch m, MonadPathReader m) =>
PathI 'TrashHome -> a -> m PathTypeW
pathDataToType PathI 'TrashHome
trashHome a
pd = PathType -> PathTypeW
MkPathTypeW (PathType -> PathTypeW) -> m PathType -> m PathTypeW
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m PathType
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m PathType
PR.getPathType OsPath
path
  where
    -- see NOTE: [getPathType]
    MkPathI OsPath
path = PathI 'TrashHome
-> PathI 'TrashEntryFileName -> PathI 'TrashEntryPath
getTrashPath PathI 'TrashHome
trashHome (a
pd a
-> Optic' k NoIx a (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx a (PathI 'TrashEntryFileName)
#fileName)

pathFiles :: OsPath
pathFiles :: OsPath
pathFiles = [osp|files|]

pathInfo :: OsPath
pathInfo :: OsPath
pathInfo = [osp|info|]