{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Core 'PathData'. This intended to be the 'main' type representing path
-- data. Actual backends are transformed to/from this type.
module Charon.Data.PathData
  ( -- * PathData
    PathData (..),
    headerNames,
    originalPathExists,
    isDirectory,
  )
where

import Charon.Data.PathType (PathTypeW)
import Charon.Data.PathType qualified as PathType
import Charon.Data.Paths
  ( PathI,
    PathIndex (TrashEntryFileName, TrashEntryOriginalPath),
  )
import Charon.Data.Timestamp (Timestamp)
import Charon.Prelude
import Charon.Utils qualified as U
import Data.Text qualified as T
import Effects.FileSystem.PathReader (_PathTypeDirectory)
import GHC.Exts (IsList)
import GHC.Exts qualified as Exts

-- | Data for a path. Maintains an invariant that the original path is not
-- the root nor is it empty.
data PathData = UnsafePathData
  { -- | The type of the path.
    PathData -> PathTypeW
pathType :: PathTypeW,
    -- | The path to be used in the trash directory.
    PathData -> PathI 'TrashEntryFileName
fileName :: PathI TrashEntryFileName,
    -- | The original path on the file system.
    PathData -> PathI 'TrashEntryOriginalPath
originalPath :: PathI TrashEntryOriginalPath,
    -- | The size of the file or directory. This is the __total__ size,
    -- i.e. in the case of a directory it is
    --
    --     size := size(dir) + size(dir contents)
    PathData -> Bytes 'B Natural
size :: Bytes B Natural,
    -- | Time this entry was created.
    PathData -> Timestamp
created :: Timestamp
  }
  deriving stock (PathData -> PathData -> Bool
(PathData -> PathData -> Bool)
-> (PathData -> PathData -> Bool) -> Eq PathData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathData -> PathData -> Bool
== :: PathData -> PathData -> Bool
$c/= :: PathData -> PathData -> Bool
/= :: PathData -> PathData -> Bool
Eq, (forall x. PathData -> Rep PathData x)
-> (forall x. Rep PathData x -> PathData) -> Generic PathData
forall x. Rep PathData x -> PathData
forall x. PathData -> Rep PathData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathData -> Rep PathData x
from :: forall x. PathData -> Rep PathData x
$cto :: forall x. Rep PathData x -> PathData
to :: forall x. Rep PathData x -> PathData
Generic, Int -> PathData -> ShowS
[PathData] -> ShowS
PathData -> String
(Int -> PathData -> ShowS)
-> (PathData -> String) -> ([PathData] -> ShowS) -> Show PathData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathData -> ShowS
showsPrec :: Int -> PathData -> ShowS
$cshow :: PathData -> String
show :: PathData -> String
$cshowList :: [PathData] -> ShowS
showList :: [PathData] -> ShowS
Show)
  deriving anyclass (Eq PathData
Eq PathData =>
(Int -> PathData -> Int) -> (PathData -> Int) -> Hashable PathData
Int -> PathData -> Int
PathData -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PathData -> Int
hashWithSalt :: Int -> PathData -> Int
$chash :: PathData -> Int
hash :: PathData -> Int
Hashable, PathData -> ()
(PathData -> ()) -> NFData PathData
forall a. (a -> ()) -> NFData a
$crnf :: PathData -> ()
rnf :: PathData -> ()
NFData)

makeFieldLabelsNoPrefix ''PathData

instance Pretty PathData where
  pretty :: forall ann. PathData -> Doc ann
pretty PathData
pd = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
strs
    where
      strs :: [Doc ann]
strs = (Doc ann -> (Doc ann -> Doc ann) -> Doc ann)
-> [Doc ann] -> [Doc ann -> Doc ann] -> [Doc ann]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Doc ann -> Doc ann) -> Doc ann -> Doc ann)
-> Doc ann -> (Doc ann -> Doc ann) -> Doc ann
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
($)) [Doc ann]
forall a. (IsList a, IsString (Item a)) => a
headerNames [Doc ann -> Doc ann]
labelFn
      labelFn :: [Doc ann -> Doc ann]
labelFn =
        [ \Doc ann
x -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":     " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (OsPath -> Text
displayPath (OsPath -> Text) -> OsPath -> Text
forall a b. (a -> b) -> a -> b
$ PathData
pd 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),
          \Doc ann
x -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (OsPath -> Text
displayPath (OsPath -> Text) -> OsPath -> Text
forall a b. (a -> b) -> a -> b
$ PathData
pd 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 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
#originalPath Optic
  A_Lens
  NoIx
  PathData
  PathData
  (PathI 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
-> Optic
     An_Iso
     NoIx
     (PathI 'TrashEntryOriginalPath)
     (PathI 'TrashEntryOriginalPath)
     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 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
  OsPath
  OsPath
#unPathI),
          \Doc ann
x -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":     " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PathTypeW -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PathTypeW -> Doc ann
pretty (PathData
pd PathData
-> Optic A_Lens NoIx PathData PathData PathTypeW PathTypeW
-> PathTypeW
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx PathData PathData PathTypeW PathTypeW
#pathType),
          \Doc ann
x -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":     " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Bytes 'B Natural -> Text
U.normalizedFormat (Bytes 'B Natural -> Text) -> Bytes 'B Natural -> Text
forall a b. (a -> b) -> a -> b
$ 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),
          \Doc ann
x -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":  " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Timestamp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Timestamp -> Doc ann
pretty (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)
        ]

      displayPath :: OsPath -> Text
displayPath = String -> Text
T.pack (String -> Text) -> (OsPath -> String) -> OsPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> String
decodeOsToFpDisplayEx

-- | Header names.
headerNames :: (IsList a, IsString (Exts.Item a)) => a
headerNames :: forall a. (IsList a, IsString (Item a)) => a
headerNames = [Item a
"Name", Item a
"Original", Item a
"Type", Item a
"Size", Item a
"Created"]

-- | Returns 'True' if the 'PathData'\'s @originalPath@ corresponds to a real
-- path that exists.
originalPathExists ::
  ( HasCallStack,
    MonadCatch m,
    MonadPathReader m
  ) =>
  PathData ->
  m Bool
originalPathExists :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
PathData -> m Bool
originalPathExists PathData
pd =
  PathTypeW -> OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
PathTypeW -> OsPath -> m Bool
PathType.existsFn (PathData
pd PathData
-> Optic A_Lens NoIx PathData PathData PathTypeW PathTypeW
-> PathTypeW
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx PathData PathData PathTypeW PathTypeW
#pathType) (PathData
pd 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 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
#originalPath Optic
  A_Lens
  NoIx
  PathData
  PathData
  (PathI 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
-> Optic
     An_Iso
     NoIx
     (PathI 'TrashEntryOriginalPath)
     (PathI 'TrashEntryOriginalPath)
     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 'TrashEntryOriginalPath)
  (PathI 'TrashEntryOriginalPath)
  OsPath
  OsPath
#unPathI))

isDirectory :: PathData -> Bool
isDirectory :: PathData -> Bool
isDirectory = Optic' An_AffineTraversal NoIx PathData () -> PathData -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
is (Optic A_Lens NoIx PathData PathData PathTypeW PathTypeW
#pathType Optic A_Lens NoIx PathData PathData PathTypeW PathTypeW
-> Optic An_Iso NoIx PathTypeW PathTypeW PathType PathType
-> Optic A_Lens NoIx PathData PathData PathType PathType
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 PathTypeW PathTypeW PathType PathType
#unPathTypeW Optic A_Lens NoIx PathData PathData PathType PathType
-> Optic A_Prism NoIx PathType PathType () ()
-> Optic' An_AffineTraversal NoIx PathData ()
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)