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

-- | Provides functionality for handling the directorysizes file in the
-- FDO spec.
module Charon.Backend.Fdo.DirectorySizes
  ( -- * Types
    DirectorySizes (..),
    DirectorySizesEntry (..),

    -- * Adding
    appendEntry,
    appendEntryTrashHome,
    writeDirectorySizes,
    writeDirectorySizesTrashHome,

    -- * Removing
    removeEntry,

    -- * Reading
    readDirectorySizes,
    readDirectorySizesTrashHome,
    getDirectorySizesPath,
  )
where

import Charon.Class.Serial
  ( Serial (DecodeExtra, decode, encode),
    decodeUnitThrowM,
    encodeThrowM,
  )
import Charon.Data.Paths (PathI, PathIndex (TrashHome))
import Charon.Env (HasTrashHome (getTrashHome))
import Charon.Prelude
import Charon.Utils qualified as Utils
import Data.ByteString.Char8 qualified as C8
import Data.Foldable (Foldable (fold))
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Effects.FileSystem.FileReader qualified as FR
import Effects.FileSystem.FileWriter qualified as FW
import Effects.FileSystem.PathWriter qualified as PW
import GHC.Read (Read)
import Text.Read qualified as TR

-- | directorysizes entry.
data DirectorySizesEntry = MkDirectorySizesEntry
  { -- | Directory size in bytes. This does __not__ include the size of the
    -- directory itself.
    DirectorySizesEntry -> Bytes 'B Natural
size :: Bytes B Natural,
    -- | The time this directory was deleted. The units are milliseconds since
    -- the unix epoch.
    DirectorySizesEntry -> Natural
time :: Natural,
    -- | Percent encoded filename.
    DirectorySizesEntry -> ByteString
fileName :: ByteString
  }
  deriving stock (DirectorySizesEntry -> DirectorySizesEntry -> Bool
(DirectorySizesEntry -> DirectorySizesEntry -> Bool)
-> (DirectorySizesEntry -> DirectorySizesEntry -> Bool)
-> Eq DirectorySizesEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectorySizesEntry -> DirectorySizesEntry -> Bool
== :: DirectorySizesEntry -> DirectorySizesEntry -> Bool
$c/= :: DirectorySizesEntry -> DirectorySizesEntry -> Bool
/= :: DirectorySizesEntry -> DirectorySizesEntry -> Bool
Eq, (forall x. DirectorySizesEntry -> Rep DirectorySizesEntry x)
-> (forall x. Rep DirectorySizesEntry x -> DirectorySizesEntry)
-> Generic DirectorySizesEntry
forall x. Rep DirectorySizesEntry x -> DirectorySizesEntry
forall x. DirectorySizesEntry -> Rep DirectorySizesEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectorySizesEntry -> Rep DirectorySizesEntry x
from :: forall x. DirectorySizesEntry -> Rep DirectorySizesEntry x
$cto :: forall x. Rep DirectorySizesEntry x -> DirectorySizesEntry
to :: forall x. Rep DirectorySizesEntry x -> DirectorySizesEntry
Generic, Int -> DirectorySizesEntry -> ShowS
[DirectorySizesEntry] -> ShowS
DirectorySizesEntry -> String
(Int -> DirectorySizesEntry -> ShowS)
-> (DirectorySizesEntry -> String)
-> ([DirectorySizesEntry] -> ShowS)
-> Show DirectorySizesEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectorySizesEntry -> ShowS
showsPrec :: Int -> DirectorySizesEntry -> ShowS
$cshow :: DirectorySizesEntry -> String
show :: DirectorySizesEntry -> String
$cshowList :: [DirectorySizesEntry] -> ShowS
showList :: [DirectorySizesEntry] -> ShowS
Show)
  deriving anyclass (DirectorySizesEntry -> ()
(DirectorySizesEntry -> ()) -> NFData DirectorySizesEntry
forall a. (a -> ()) -> NFData a
$crnf :: DirectorySizesEntry -> ()
rnf :: DirectorySizesEntry -> ()
NFData)

makeFieldLabelsNoPrefix ''DirectorySizesEntry

instance Serial DirectorySizesEntry where
  type DecodeExtra DirectorySizesEntry = ()

  encode :: DirectorySizesEntry -> Either String ByteString
encode DirectorySizesEntry
entry = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString]
bsXs
    where
      bsXs :: [ByteString]
bsXs =
        [ Natural -> ByteString
forall a. Show a => a -> ByteString
toBs (Natural -> ByteString) -> Natural -> ByteString
forall a b. (a -> b) -> a -> b
$ 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
  DirectorySizesEntry
  (Bytes 'B Natural)
  (Bytes 'B Natural)
#size Optic
  A_Lens
  NoIx
  DirectorySizesEntry
  DirectorySizesEntry
  (Bytes 'B Natural)
  (Bytes 'B Natural)
-> Optic
     An_Iso NoIx (Bytes 'B Natural) (Bytes 'B Natural) Natural Natural
-> Optic' A_Lens NoIx DirectorySizesEntry Natural
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 (Bytes 'B Natural) (Bytes 'B Natural) Natural Natural
forall (s :: Size) n. Iso' (Bytes s n) n
_MkBytes),
          ByteString
" ",
          Natural -> ByteString
forall a. Show a => a -> ByteString
toBs (Natural -> ByteString) -> Natural -> ByteString
forall a b. (a -> b) -> a -> b
$ 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,
          ByteString
" ",
          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
        ]
      toBs :: (Show a) => a -> ByteString
      toBs :: forall a. Show a => a -> ByteString
toBs = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

  decode :: DecodeExtra DirectorySizesEntry
-> ByteString -> Either String DirectorySizesEntry
decode DecodeExtra DirectorySizesEntry
_ ByteString
bs = do
    (ByteString
sizeBs, ByteString
timeBs, ByteString
fileNameBs) <- case Char -> ByteString -> [ByteString]
C8.split Char
' ' ByteString
bs of
      [ByteString
sizeBs, ByteString
timeBs, ByteString
fileNameBs] -> (ByteString, ByteString, ByteString)
-> Either String (ByteString, ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
sizeBs, ByteString
timeBs, ByteString
fileNameBs)
      [ByteString]
other -> String -> Either String (ByteString, ByteString, ByteString)
forall a b. a -> Either a b
Left (String -> Either String (ByteString, ByteString, ByteString))
-> String -> Either String (ByteString, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ String
"Expected three space-separated sections, received:" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> String
forall a. Show a => a -> String
show [ByteString]
other

    Bytes 'B Natural
size <- Natural -> Bytes 'B Natural
forall (s :: Size) n. n -> Bytes s n
MkBytes (Natural -> Bytes 'B Natural)
-> Either String Natural -> Either String (Bytes 'B Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Natural
forall a. Read a => ByteString -> Either String a
fromBs ByteString
sizeBs
    Natural
time <- ByteString -> Either String Natural
forall a. Read a => ByteString -> Either String a
fromBs ByteString
timeBs

    DirectorySizesEntry -> Either String DirectorySizesEntry
forall a b. b -> Either a b
Right
      (DirectorySizesEntry -> Either String DirectorySizesEntry)
-> DirectorySizesEntry -> Either String DirectorySizesEntry
forall a b. (a -> b) -> a -> b
$ MkDirectorySizesEntry
        { Bytes 'B Natural
$sel:size:MkDirectorySizesEntry :: Bytes 'B Natural
size :: Bytes 'B Natural
size,
          Natural
$sel:time:MkDirectorySizesEntry :: Natural
time :: Natural
time,
          $sel:fileName:MkDirectorySizesEntry :: ByteString
fileName = ByteString
fileNameBs
        }
    where
      fromBs :: (Read a) => ByteString -> Either String a
      fromBs :: forall a. Read a => ByteString -> Either String a
fromBs = String -> Either String a
forall a. Read a => String -> Either String a
TR.readEither (String -> Either String a)
-> (ByteString -> Either String String)
-> ByteString
-> Either String a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ((UnicodeException -> String)
-> (Text -> String)
-> Either UnicodeException Text
-> Either String String
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap UnicodeException -> String
forall e. Exception e => e -> String
displayException Text -> String
T.unpack (Either UnicodeException Text -> Either String String)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8)

-- | Represents the directorysizes contents.
newtype DirectorySizes = MkDirectorySizes
  { DirectorySizes -> Seq DirectorySizesEntry
unDirectorySizes :: Seq DirectorySizesEntry
  }
  deriving stock (DirectorySizes -> DirectorySizes -> Bool
(DirectorySizes -> DirectorySizes -> Bool)
-> (DirectorySizes -> DirectorySizes -> Bool) -> Eq DirectorySizes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectorySizes -> DirectorySizes -> Bool
== :: DirectorySizes -> DirectorySizes -> Bool
$c/= :: DirectorySizes -> DirectorySizes -> Bool
/= :: DirectorySizes -> DirectorySizes -> Bool
Eq, (forall x. DirectorySizes -> Rep DirectorySizes x)
-> (forall x. Rep DirectorySizes x -> DirectorySizes)
-> Generic DirectorySizes
forall x. Rep DirectorySizes x -> DirectorySizes
forall x. DirectorySizes -> Rep DirectorySizes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectorySizes -> Rep DirectorySizes x
from :: forall x. DirectorySizes -> Rep DirectorySizes x
$cto :: forall x. Rep DirectorySizes x -> DirectorySizes
to :: forall x. Rep DirectorySizes x -> DirectorySizes
Generic, Int -> DirectorySizes -> ShowS
[DirectorySizes] -> ShowS
DirectorySizes -> String
(Int -> DirectorySizes -> ShowS)
-> (DirectorySizes -> String)
-> ([DirectorySizes] -> ShowS)
-> Show DirectorySizes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectorySizes -> ShowS
showsPrec :: Int -> DirectorySizes -> ShowS
$cshow :: DirectorySizes -> String
show :: DirectorySizes -> String
$cshowList :: [DirectorySizes] -> ShowS
showList :: [DirectorySizes] -> ShowS
Show)
  deriving anyclass (DirectorySizes -> ()
(DirectorySizes -> ()) -> NFData DirectorySizes
forall a. (a -> ()) -> NFData a
$crnf :: DirectorySizes -> ()
rnf :: DirectorySizes -> ()
NFData)
  deriving (Semigroup DirectorySizes
DirectorySizes
Semigroup DirectorySizes =>
DirectorySizes
-> (DirectorySizes -> DirectorySizes -> DirectorySizes)
-> ([DirectorySizes] -> DirectorySizes)
-> Monoid DirectorySizes
[DirectorySizes] -> DirectorySizes
DirectorySizes -> DirectorySizes -> DirectorySizes
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: DirectorySizes
mempty :: DirectorySizes
$cmappend :: DirectorySizes -> DirectorySizes -> DirectorySizes
mappend :: DirectorySizes -> DirectorySizes -> DirectorySizes
$cmconcat :: [DirectorySizes] -> DirectorySizes
mconcat :: [DirectorySizes] -> DirectorySizes
Monoid, NonEmpty DirectorySizes -> DirectorySizes
DirectorySizes -> DirectorySizes -> DirectorySizes
(DirectorySizes -> DirectorySizes -> DirectorySizes)
-> (NonEmpty DirectorySizes -> DirectorySizes)
-> (forall b. Integral b => b -> DirectorySizes -> DirectorySizes)
-> Semigroup DirectorySizes
forall b. Integral b => b -> DirectorySizes -> DirectorySizes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: DirectorySizes -> DirectorySizes -> DirectorySizes
<> :: DirectorySizes -> DirectorySizes -> DirectorySizes
$csconcat :: NonEmpty DirectorySizes -> DirectorySizes
sconcat :: NonEmpty DirectorySizes -> DirectorySizes
$cstimes :: forall b. Integral b => b -> DirectorySizes -> DirectorySizes
stimes :: forall b. Integral b => b -> DirectorySizes -> DirectorySizes
Semigroup) via (Seq DirectorySizesEntry)

makeFieldLabelsNoPrefix ''DirectorySizes

instance Serial DirectorySizes where
  type DecodeExtra DirectorySizes = ()

  encode :: DirectorySizes -> Either String ByteString
encode (MkDirectorySizes Seq DirectorySizesEntry
dirSizes) =
    (DirectorySizesEntry -> Either String ByteString)
-> Seq DirectorySizesEntry -> Either String (Seq ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse DirectorySizesEntry -> Either String ByteString
forall a. Serial a => a -> Either String ByteString
encode Seq DirectorySizesEntry
dirSizes Either String (Seq ByteString)
-> (Seq ByteString -> ByteString) -> Either String ByteString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Seq ByteString -> ByteString
forall m. Monoid m => Seq m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Seq ByteString -> ByteString)
-> (Seq ByteString -> Seq ByteString)
-> Seq ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seq ByteString -> Seq ByteString
forall a. a -> Seq a -> Seq a
Seq.intersperse ByteString
"\n"
  decode :: DecodeExtra DirectorySizes
-> ByteString -> Either String DirectorySizes
decode DecodeExtra DirectorySizes
_ =
    (Seq DirectorySizesEntry -> DirectorySizes)
-> Either String (Seq DirectorySizesEntry)
-> Either String DirectorySizes
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq DirectorySizesEntry -> DirectorySizes
MkDirectorySizes
      (Either String (Seq DirectorySizesEntry)
 -> Either String DirectorySizes)
-> (ByteString -> Either String (Seq DirectorySizesEntry))
-> ByteString
-> Either String DirectorySizes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either String DirectorySizesEntry)
-> Seq ByteString -> Either String (Seq DirectorySizesEntry)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (DecodeExtra DirectorySizesEntry
-> ByteString -> Either String DirectorySizesEntry
forall a.
Serial a =>
DecodeExtra a -> ByteString -> Either String a
decode ())
      (Seq ByteString -> Either String (Seq DirectorySizesEntry))
-> (ByteString -> Seq ByteString)
-> ByteString
-> Either String (Seq DirectorySizesEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Seq ByteString
forall a. [a] -> Seq a
Seq.fromList
      ([ByteString] -> Seq ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> Seq ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
C8.lines

-- | Appends an entry to directorysizes.
appendEntry ::
  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 ()
appendEntry :: 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 ()
appendEntry DirectorySizesEntry
dirSizeEntry = do
  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
  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 ()
appendEntryTrashHome PathI 'TrashHome
trashHome DirectorySizesEntry
dirSizeEntry

-- | Appends an entry to directorysizes.
appendEntryTrashHome ::
  forall m.
  ( HasCallStack,
    MonadCatch m,
    MonadLoggerNS m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTime m
  ) =>
  PathI TrashHome ->
  DirectorySizesEntry ->
  m ()
appendEntryTrashHome :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadLoggerNS m, MonadFileReader m,
 MonadFileWriter m, MonadPathReader m, MonadPathWriter m,
 MonadTime m) =>
PathI 'TrashHome -> DirectorySizesEntry -> m ()
appendEntryTrashHome PathI 'TrashHome
trashHome DirectorySizesEntry
dirSizeEntry = do
  MkDirectorySizes Seq DirectorySizesEntry
directorySizes <- PathI 'TrashHome -> m DirectorySizes
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadPathReader m,
 MonadThrow m) =>
PathI 'TrashHome -> m DirectorySizes
readDirectorySizesTrashHome PathI 'TrashHome
trashHome
  let directorySizes' :: DirectorySizes
directorySizes' = Seq DirectorySizesEntry -> DirectorySizes
MkDirectorySizes (Seq DirectorySizesEntry
directorySizes Seq DirectorySizesEntry
-> DirectorySizesEntry -> Seq DirectorySizesEntry
forall a. Seq a -> a -> Seq a
:|> DirectorySizesEntry
dirSizeEntry)

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

-- | Writes entries to directorysizes.
writeDirectorySizes ::
  ( HasCallStack,
    HasTrashHome env,
    MonadCatch m,
    MonadFileWriter m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadReader env m,
    MonadTime m
  ) =>
  DirectorySizes ->
  m ()
writeDirectorySizes :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadCatch m, MonadFileWriter m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadReader env m, MonadTime m) =>
DirectorySizes -> m ()
writeDirectorySizes DirectorySizes
directorySizes = do
  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
  PathI 'TrashHome -> DirectorySizes -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadFileWriter m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadTime m) =>
PathI 'TrashHome -> DirectorySizes -> m ()
writeDirectorySizesTrashHome PathI 'TrashHome
trashHome DirectorySizes
directorySizes

-- | Writes entries to directorysizes.
writeDirectorySizesTrashHome ::
  ( HasCallStack,
    MonadCatch m,
    MonadFileWriter m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTime m
  ) =>
  PathI TrashHome ->
  DirectorySizes ->
  m ()
writeDirectorySizesTrashHome :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadFileWriter m, MonadLoggerNS m,
 MonadPathReader m, MonadPathWriter m, MonadTime m) =>
PathI 'TrashHome -> DirectorySizes -> m ()
writeDirectorySizesTrashHome PathI 'TrashHome
trashHome DirectorySizes
directorySizes = Text -> m () -> m ()
forall (m :: * -> *) a. MonadLoggerNS m => Text -> m a -> m a
addNamespace Text
"writeDirectorySizesTrashHome" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  let directorySizesPath :: OsPath
directorySizesPath = PathI 'TrashHome -> OsPath
trashHomeToDirectorySizes PathI 'TrashHome
trashHome

  ByteString
encoded <- DirectorySizes -> m ByteString
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Serial a) =>
a -> m ByteString
encodeThrowM DirectorySizes
directorySizes

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

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

  OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
PW.renameFile OsPath
tmpFile OsPath
directorySizesPath
    m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAnyCS` \SomeException
ex -> do
      $(logError) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Error renaming directorysizes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SomeException -> Text
forall e. Exception e => e -> Text
displayExceptiont SomeException
ex
      OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
PW.removeFile OsPath
tmpFile

-- | Removes an entry from directory sizes.
removeEntry ::
  ( HasCallStack,
    HasTrashHome env,
    MonadCatch m,
    MonadReader env m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadLoggerNS m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTime m
  ) =>
  ByteString ->
  m ()
removeEntry :: 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 ()
removeEntry ByteString
entryName = do
  MkDirectorySizes Seq DirectorySizesEntry
decoded <- m DirectorySizes
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadFileReader m,
 MonadPathReader m, MonadReader env m, MonadThrow m) =>
m DirectorySizes
readDirectorySizes

  let directorySizes' :: Seq DirectorySizesEntry
directorySizes' = (DirectorySizesEntry -> Bool)
-> Seq DirectorySizesEntry -> Seq DirectorySizesEntry
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter DirectorySizesEntry -> Bool
notEntry Seq DirectorySizesEntry
decoded

  DirectorySizes -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadCatch m, MonadFileWriter m,
 MonadLoggerNS m, MonadPathReader m, MonadPathWriter m,
 MonadReader env m, MonadTime m) =>
DirectorySizes -> m ()
writeDirectorySizes (Seq DirectorySizesEntry -> DirectorySizes
MkDirectorySizes Seq DirectorySizesEntry
directorySizes')
  where
    notEntry :: DirectorySizesEntry -> Bool
notEntry = (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
entryName) (ByteString -> Bool)
-> (DirectorySizesEntry -> ByteString)
-> DirectorySizesEntry
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx DirectorySizesEntry ByteString
-> DirectorySizesEntry -> ByteString
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx DirectorySizesEntry ByteString
#fileName

-- | Reads directorysizes.
readDirectorySizes ::
  ( HasCallStack,
    HasTrashHome env,
    MonadFileReader m,
    MonadPathReader m,
    MonadReader env m,
    MonadThrow m
  ) =>
  m DirectorySizes
readDirectorySizes :: forall env (m :: * -> *).
(HasCallStack, HasTrashHome env, MonadFileReader m,
 MonadPathReader m, MonadReader env m, MonadThrow m) =>
m DirectorySizes
readDirectorySizes = (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 DirectorySizes) -> m DirectorySizes
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PathI 'TrashHome -> m DirectorySizes
forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadPathReader m,
 MonadThrow m) =>
PathI 'TrashHome -> m DirectorySizes
readDirectorySizesTrashHome

-- | Reads directorysizes.
readDirectorySizesTrashHome ::
  ( HasCallStack,
    MonadFileReader m,
    MonadPathReader m,
    MonadThrow m
  ) =>
  PathI TrashHome ->
  m DirectorySizes
readDirectorySizesTrashHome :: forall (m :: * -> *).
(HasCallStack, MonadFileReader m, MonadPathReader m,
 MonadThrow m) =>
PathI 'TrashHome -> m DirectorySizes
readDirectorySizesTrashHome PathI 'TrashHome
path = do
  let directorySizesPath :: OsPath
directorySizesPath = PathI 'TrashHome -> OsPath
trashHomeToDirectorySizes PathI 'TrashHome
path
  Bool
exists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
directorySizesPath
  if Bool
exists
    then do
      ByteString
bs <- OsPath -> m ByteString
forall (m :: * -> *).
(MonadFileReader m, HasCallStack) =>
OsPath -> m ByteString
FR.readBinaryFile OsPath
directorySizesPath
      ByteString -> m DirectorySizes
forall a (m :: * -> *).
(DecodeExtra a ~ (), HasCallStack, MonadThrow m, Serial a) =>
ByteString -> m a
decodeUnitThrowM ByteString
bs
    else DirectorySizes -> m DirectorySizes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DirectorySizes
forall a. Monoid a => a
mempty

getDirectorySizesPath ::
  ( HasTrashHome env,
    MonadReader env m
  ) =>
  m OsPath
getDirectorySizesPath :: forall env (m :: * -> *).
(HasTrashHome env, MonadReader env m) =>
m OsPath
getDirectorySizesPath = (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 -> OsPath) -> m OsPath
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> PathI 'TrashHome -> OsPath
trashHomeToDirectorySizes

trashHomeToDirectorySizes :: PathI TrashHome -> OsPath
trashHomeToDirectorySizes :: PathI 'TrashHome -> OsPath
trashHomeToDirectorySizes =
  (OsPath -> OsPath -> OsPath
</> [osp|directorysizes|])
    (OsPath -> OsPath)
-> (PathI 'TrashHome -> OsPath) -> PathI 'TrashHome -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso NoIx (PathI 'TrashHome) OsPath
-> PathI 'TrashHome -> OsPath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx (PathI 'TrashHome) OsPath
#unPathI