{-# LANGUAGE TemplateHaskell #-}

module Charon.Backend.Default.Index
  ( readIndex,
    readIndexTrashHome,
  )
where

import Charon.Backend.Data qualified as Backend.Data
import Charon.Backend.Default.BackendArgs (BackendArgs)
import Charon.Backend.Default.Utils qualified as Default.Utils
import Charon.Class.Serial (Serial (DecodeExtra))
import Charon.Class.Serial qualified as Serial
import Charon.Data.Index (Index (MkIndex))
import Charon.Data.PathData (PathData)
import Charon.Data.Paths
  ( PathI (MkPathI),
    PathIndex
      ( TrashEntryFileName,
        TrashEntryPath,
        TrashHome
      ),
    (<//>),
  )
import Charon.Env (HasTrashHome (getTrashHome))
import Charon.Exception
  ( InfoDecodeE (MkInfoDecodeE),
    TrashEntryFileNotFoundE (MkTrashEntryFileNotFoundE),
    TrashEntryInfoBadExtE (MkTrashEntryInfoBadExtE),
    TrashEntryInfoNotFoundE (MkTrashEntryInfoNotFoundE),
  )
import Charon.Prelude
import Data.HashSet qualified as HSet
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import System.OsPath qualified as FP

type Acc = (Seq (PathData, PathI TrashEntryPath), HashSet (PathI TrashEntryFileName))

-- | Reads the trash directory into the 'Index'. If this succeeds then
-- everything is 'well-formed' i.e. there is a bijection between trash/files
-- and trash/info.
readIndex ::
  forall m env (pd :: Type) 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
readIndex :: 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
readIndex BackendArgs m pd
backendArgs =
  (env -> PathI 'TrashHome) -> m (PathI 'TrashHome)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks env -> PathI 'TrashHome
forall a. HasTrashHome a => a -> PathI 'TrashHome
getTrashHome m (PathI 'TrashHome) -> (PathI 'TrashHome -> m 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
>>= BackendArgs m pd -> PathI 'TrashHome -> m Index
forall (m :: * -> *) pd k.
(DecodeExtra pd ~ PathI 'TrashEntryFileName, HasCallStack,
 Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadFileReader m, MonadCatch m, MonadLoggerNS m,
 MonadPathReader m, Serial pd) =>
BackendArgs m pd -> PathI 'TrashHome -> m Index
readIndexTrashHome BackendArgs m pd
backendArgs

-- | Reads the trash directory into the 'Index'. If this succeeds then
-- everything is 'well-formed' i.e. there is a bijection between trash/files
-- and trash/info.
readIndexTrashHome ::
  forall m (pd :: Type) 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
readIndexTrashHome :: 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
readIndexTrashHome BackendArgs m pd
backendArgs PathI 'TrashHome
trashHome = Text -> m Index -> m Index
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"readIndexTrashHome" (m Index -> m Index) -> m Index -> m Index
forall a b. (a -> b) -> a -> b
$ do
  [OsString]
paths <- OsString -> m [OsString]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsString -> m [OsString]
listDirectory OsString
trashInfoDir'
  $(logDebug) (Text
"Trash info: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OsString -> Text
decodeOsToFpDisplayExT OsString
trashInfoDir')
  $(logDebug) (Text
"Info: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (OsString -> Text
decodeOsToFpDisplayExT (OsString -> Text) -> [OsString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsString]
paths))

  let seqify :: OsPath -> m Acc -> m Acc
      seqify :: OsString -> m Acc -> m Acc
seqify OsString
p m Acc
macc = do
        let actualExt :: OsString
actualExt = OsString -> OsString
FP.takeExtension OsString
p
            expectedExt :: OsString
expectedExt = Backend -> OsString
Backend.Data.backendExt (BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic' A_Lens NoIx (BackendArgs m pd) Backend -> Backend
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (BackendArgs m pd) Backend
#backend)
            toCorePathData :: PathI 'TrashHome -> pd -> m PathData
toCorePathData = BackendArgs m pd
backendArgs BackendArgs m pd
-> Optic'
     A_Lens
     NoIx
     (BackendArgs m pd)
     (PathI 'TrashHome -> pd -> m PathData)
-> PathI 'TrashHome
-> pd
-> m PathData
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (BackendArgs m pd)
  (PathI 'TrashHome -> pd -> m PathData)
#toCorePathData

        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OsString
actualExt OsString -> OsString -> Bool
forall a. Eq a => a -> a -> Bool
/= OsString
expectedExt)
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ TrashEntryInfoBadExtE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS
          (TrashEntryInfoBadExtE -> m ()) -> TrashEntryInfoBadExtE -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryFileName
-> OsString -> OsString -> TrashEntryInfoBadExtE
MkTrashEntryInfoBadExtE (OsString -> PathI 'TrashEntryFileName
forall (i :: PathIndex). OsString -> PathI i
MkPathI OsString
p) OsString
actualExt OsString
expectedExt

        let path :: OsString
path = OsString
trashInfoDir' OsString -> OsString -> OsString
</> OsString
p
        $(logDebug) (Text
"Path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OsString -> Text
decodeOsToFpDisplayExT OsString
path)

        ByteString
contents <- OsString -> m ByteString
forall (m :: * -> *).
(MonadFileReader m, HasCallStack) =>
OsString -> m ByteString
readBinaryFile OsString
path
        let -- NOTE: We want the name without the suffix
            fileName :: OsString
fileName = OsString -> OsString
FP.dropExtension (OsString -> OsString) -> OsString -> OsString
forall a b. (a -> b) -> a -> b
$ OsString -> OsString
FP.takeFileName OsString
path
            decoded :: Either String pd
decoded = forall a.
Serial a =>
DecodeExtra a -> ByteString -> Either String a
Serial.decode @pd (OsString -> PathI 'TrashEntryFileName
forall (i :: PathIndex). OsString -> PathI i
MkPathI OsString
fileName) ByteString
contents
        case Either String pd
decoded of
          Left String
err -> InfoDecodeE -> m Acc
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS (InfoDecodeE -> m Acc) -> InfoDecodeE -> m Acc
forall a b. (a -> b) -> a -> b
$ PathI 'TrashEntryInfo -> ByteString -> String -> InfoDecodeE
MkInfoDecodeE (OsString -> PathI 'TrashEntryInfo
forall (i :: PathIndex). OsString -> PathI i
MkPathI OsString
path) ByteString
contents String
err
          Right pd
pd -> do
            PathI 'TrashEntryPath
trashEntryPath <- forall (m :: * -> *) pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadLoggerNS m, MonadPathReader m) =>
PathI 'TrashHome -> pd -> m (PathI 'TrashEntryPath)
getTrashEntryPath @_ @pd PathI 'TrashHome
trashHome pd
pd
            (Seq (PathData, PathI 'TrashEntryPath)
accSeq, HashSet (PathI 'TrashEntryFileName)
accSet) <- m Acc
macc
            PathData
corePathData <- PathI 'TrashHome -> pd -> m PathData
toCorePathData PathI 'TrashHome
trashHome pd
pd
            Acc -> m Acc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PathData
corePathData, PathI 'TrashEntryPath
trashEntryPath) (PathData, PathI 'TrashEntryPath)
-> Seq (PathData, PathI 'TrashEntryPath)
-> Seq (PathData, PathI 'TrashEntryPath)
forall a. a -> Seq a -> Seq a
:<| Seq (PathData, PathI 'TrashEntryPath)
accSeq, PathI 'TrashEntryFileName
-> HashSet (PathI 'TrashEntryFileName)
-> HashSet (PathI 'TrashEntryFileName)
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HSet.insert (PathData
corePathData PathData
-> Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx PathData (PathI 'TrashEntryFileName)
#fileName) HashSet (PathI 'TrashEntryFileName)
accSet)

  (Seq (PathData, PathI 'TrashEntryPath)
indexSeq, HashSet (PathI 'TrashEntryFileName)
pathSet) <- (OsString -> m Acc -> m Acc) -> m Acc -> [OsString] -> m Acc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OsString -> m Acc -> m Acc
seqify (Acc -> m Acc
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq (PathData, PathI 'TrashEntryPath)
forall a. Seq a
Seq.empty, HashSet (PathI 'TrashEntryFileName)
forall a. HashSet a
HSet.empty)) [OsString]
paths

  -- NOTE: Check that all files in /files exist in the index.
  [OsString]
allTrashPaths <- OsString -> m [OsString]
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsString -> m [OsString]
listDirectory OsString
trashPathsDir'
  $(logDebug) (Text
"Paths: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (OsString -> Text
decodeOsToFpDisplayExT (OsString -> Text) -> [OsString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsString]
allTrashPaths))
  [OsString] -> (OsString -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [OsString]
allTrashPaths ((OsString -> m ()) -> m ()) -> (OsString -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \OsString
p -> do
    let pName :: PathI 'TrashEntryFileName
pName = OsString -> PathI 'TrashEntryFileName
forall (i :: PathIndex). OsString -> PathI i
MkPathI (OsString -> PathI 'TrashEntryFileName)
-> OsString -> PathI 'TrashEntryFileName
forall a b. (a -> b) -> a -> b
$ OsString -> OsString
FP.takeFileName OsString
p
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PathI 'TrashEntryFileName
pName PathI 'TrashEntryFileName
-> HashSet (PathI 'TrashEntryFileName) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HSet.member` HashSet (PathI 'TrashEntryFileName)
pathSet)
      (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ TrashEntryInfoNotFoundE -> m ()
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS
      (TrashEntryInfoNotFoundE -> m ())
-> TrashEntryInfoNotFoundE -> m ()
forall a b. (a -> b) -> a -> b
$ PathI 'TrashHome
-> PathI 'TrashEntryFileName -> TrashEntryInfoNotFoundE
MkTrashEntryInfoNotFoundE PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
pName

  Index -> m Index
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Index -> m Index) -> Index -> m Index
forall a b. (a -> b) -> a -> b
$ Seq (PathData, PathI 'TrashEntryPath) -> Index
MkIndex Seq (PathData, PathI 'TrashEntryPath)
indexSeq
  where
    MkPathI OsString
trashPathsDir' = PathI 'TrashHome -> PathI 'TrashDirFiles
Default.Utils.getTrashPathDir PathI 'TrashHome
trashHome
    MkPathI OsString
trashInfoDir' = PathI 'TrashHome -> PathI 'TrashDirInfo
Default.Utils.getTrashInfoDir PathI 'TrashHome
trashHome

-- | Like 'throwIfTrashNonExtant' except returns the path if it exists.
getTrashEntryPath ::
  forall m pd k.
  ( HasCallStack,
    Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    MonadCatch m,
    MonadLoggerNS m,
    MonadPathReader m
  ) =>
  PathI TrashHome ->
  pd ->
  m (PathI TrashEntryPath)
getTrashEntryPath :: forall (m :: * -> *) pd k.
(HasCallStack, Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 MonadCatch m, MonadLoggerNS m, MonadPathReader m) =>
PathI 'TrashHome -> pd -> m (PathI 'TrashEntryPath)
getTrashEntryPath PathI 'TrashHome
trashHome pd
pd = Text -> m (PathI 'TrashEntryPath) -> m (PathI 'TrashEntryPath)
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"getTrashEntryPath" (m (PathI 'TrashEntryPath) -> m (PathI 'TrashEntryPath))
-> m (PathI 'TrashEntryPath) -> m (PathI 'TrashEntryPath)
forall a b. (a -> b) -> a -> b
$ do
  PathI 'TrashHome -> pd -> m (Maybe (PathI 'TrashEntryPath))
forall (m :: * -> *) pd k.
(Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 HasCallStack, MonadCatch m, MonadPathReader m) =>
PathI 'TrashHome -> pd -> m (Maybe (PathI 'TrashEntryPath))
lookupTrashPath PathI 'TrashHome
trashHome pd
pd m (Maybe (PathI 'TrashEntryPath))
-> (Maybe (PathI 'TrashEntryPath) -> m (PathI 'TrashEntryPath))
-> m (PathI 'TrashEntryPath)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just PathI 'TrashEntryPath
trashPath -> PathI 'TrashEntryPath -> m (PathI 'TrashEntryPath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PathI 'TrashEntryPath
trashPath
    Maybe (PathI 'TrashEntryPath)
Nothing ->
      TrashEntryFileNotFoundE -> m (PathI 'TrashEntryPath)
forall (m :: * -> *) e a.
(Exception e, HasCallStack, MonadThrow m) =>
e -> m a
throwCS
        (TrashEntryFileNotFoundE -> m (PathI 'TrashEntryPath))
-> TrashEntryFileNotFoundE -> m (PathI 'TrashEntryPath)
forall a b. (a -> b) -> a -> b
$ PathI 'TrashHome
-> PathI 'TrashEntryFileName -> TrashEntryFileNotFoundE
MkTrashEntryFileNotFoundE PathI 'TrashHome
trashHome PathI 'TrashEntryFileName
filePath
  where
    filePath :: PathI 'TrashEntryFileName
filePath = pd
pd pd
-> Optic' k NoIx pd (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx pd (PathI 'TrashEntryFileName)
#fileName

-- | Like 'trashPathExists' except returns the path if it exists.
lookupTrashPath ::
  forall m pd k.
  ( Is k A_Getter,
    LabelOptic' "fileName" k pd (PathI TrashEntryFileName),
    HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  PathI TrashHome ->
  pd ->
  m (Maybe (PathI TrashEntryPath))
lookupTrashPath :: forall (m :: * -> *) pd k.
(Is k A_Getter,
 LabelOptic' "fileName" k pd (PathI 'TrashEntryFileName),
 HasCallStack, MonadCatch m, MonadPathReader m) =>
PathI 'TrashHome -> pd -> m (Maybe (PathI 'TrashEntryPath))
lookupTrashPath PathI 'TrashHome
trashHome pd
pd = do
  -- Unfortunately we don't know the path type, as we could be dealing with
  -- a backend that does not have it on its PathData (e.g. fdo). Thus we
  -- have to check symlinks first, then doesPathExist for files/dirs.
  Bool
exists <- OsString -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsString -> m Bool
doesAnyPathExist OsString
trashPath'
  Maybe (PathI 'TrashEntryPath) -> m (Maybe (PathI 'TrashEntryPath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe (PathI 'TrashEntryPath)
 -> m (Maybe (PathI 'TrashEntryPath)))
-> Maybe (PathI 'TrashEntryPath)
-> m (Maybe (PathI 'TrashEntryPath))
forall a b. (a -> b) -> a -> b
$ if Bool
exists
      then PathI 'TrashEntryPath -> Maybe (PathI 'TrashEntryPath)
forall a. a -> Maybe a
Just PathI 'TrashEntryPath
trashPath
      else Maybe (PathI 'TrashEntryPath)
forall a. Maybe a
Nothing
  where
    -- NOTE: doesPathExist rather than doesFile/Dir... as that requires knowing
    -- the path type. See Note [PathData PathType conditions].
    trashPath :: PathI 'TrashEntryPath
    trashPath :: PathI 'TrashEntryPath
trashPath@(MkPathI OsString
trashPath') =
      PathI 'TrashHome
trashHome PathI 'TrashHome -> PathI Any -> PathI 'TrashEntryPath
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> OsString -> PathI Any
forall (i :: PathIndex). OsString -> PathI i
MkPathI OsString
Default.Utils.pathFiles PathI Any -> PathI 'TrashEntryFileName -> PathI Any
forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> (pd
pd pd
-> Optic' k NoIx pd (PathI 'TrashEntryFileName)
-> PathI 'TrashEntryFileName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' k NoIx pd (PathI 'TrashEntryFileName)
#fileName)