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

-- | Provides functionality for distinguishing path types.
module Charon.Data.Paths
  ( -- * Types
    PathI (..),
    PathIndex (..),

    -- * Functions

    -- ** Specific
    isEmpty,
    isRoot,
    isRoot',
    isDots,
    toString,
    toText,

    -- ** General
    -- $general
    showPaths,
    reindex,
    (<//>),
    (<//),
    (//>),
    applyPathI,
    liftPathI,
    liftPathI',
    liftPathIF,
    liftPathIF',
  )
where

import Charon.Class.Serial (Serial (DecodeExtra, decode, encode))
import Charon.Prelude
import Data.List qualified as L
import Data.Text qualified as T
import Data.Text.Encoding qualified as TEnc
import System.OsPath qualified as FP

-- | Types of filepaths used in Charon.
data PathIndex
  = -- TRASH DIRECTORY PATHS

    -- | The trash directory.
    TrashHome
  | -- | The trash log file.
    TrashLog
  | -- | The directory to the trash files themselves i.e. <trash>/files.
    TrashDirFiles
  | -- | The directory to the trash info files i.e. <trash>/info.
    TrashDirInfo
  | -- TRASH ENTRY PATHS

    -- | The full trash path i.e. @\<trash-home\>\/files\/'\<trash-name\>@.
    TrashEntryPath
  | -- | The full trash info path i.e. @\<trash-home\>\/info\/'\<trash-name\>.trashinfo@.
    TrashEntryInfo
  | -- TRASH ENTRY FIELD TYPES

    -- | The name corresponding to some file/directory in the trash directory.
    TrashEntryFileName
  | -- | The original path for some file/directory in the trash directory.
    TrashEntryOriginalPath

-- | Indexed 'OsPath' so that we can prevent mixing up different filepaths.
type PathI :: PathIndex -> Type
newtype PathI (i :: PathIndex) = MkPathI
  { forall (i :: PathIndex). PathI i -> OsPath
unPathI :: OsPath
  }
  deriving stock (PathI i -> PathI i -> Bool
(PathI i -> PathI i -> Bool)
-> (PathI i -> PathI i -> Bool) -> Eq (PathI i)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (i :: PathIndex). PathI i -> PathI i -> Bool
$c== :: forall (i :: PathIndex). PathI i -> PathI i -> Bool
== :: PathI i -> PathI i -> Bool
$c/= :: forall (i :: PathIndex). PathI i -> PathI i -> Bool
/= :: PathI i -> PathI i -> Bool
Eq, Eq (PathI i)
Eq (PathI i) =>
(PathI i -> PathI i -> Ordering)
-> (PathI i -> PathI i -> Bool)
-> (PathI i -> PathI i -> Bool)
-> (PathI i -> PathI i -> Bool)
-> (PathI i -> PathI i -> Bool)
-> (PathI i -> PathI i -> PathI i)
-> (PathI i -> PathI i -> PathI i)
-> Ord (PathI i)
PathI i -> PathI i -> Bool
PathI i -> PathI i -> Ordering
PathI i -> PathI i -> PathI i
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (i :: PathIndex). Eq (PathI i)
forall (i :: PathIndex). PathI i -> PathI i -> Bool
forall (i :: PathIndex). PathI i -> PathI i -> Ordering
forall (i :: PathIndex). PathI i -> PathI i -> PathI i
$ccompare :: forall (i :: PathIndex). PathI i -> PathI i -> Ordering
compare :: PathI i -> PathI i -> Ordering
$c< :: forall (i :: PathIndex). PathI i -> PathI i -> Bool
< :: PathI i -> PathI i -> Bool
$c<= :: forall (i :: PathIndex). PathI i -> PathI i -> Bool
<= :: PathI i -> PathI i -> Bool
$c> :: forall (i :: PathIndex). PathI i -> PathI i -> Bool
> :: PathI i -> PathI i -> Bool
$c>= :: forall (i :: PathIndex). PathI i -> PathI i -> Bool
>= :: PathI i -> PathI i -> Bool
$cmax :: forall (i :: PathIndex). PathI i -> PathI i -> PathI i
max :: PathI i -> PathI i -> PathI i
$cmin :: forall (i :: PathIndex). PathI i -> PathI i -> PathI i
min :: PathI i -> PathI i -> PathI i
Ord, (forall x. PathI i -> Rep (PathI i) x)
-> (forall x. Rep (PathI i) x -> PathI i) -> Generic (PathI i)
forall x. Rep (PathI i) x -> PathI i
forall x. PathI i -> Rep (PathI i) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (i :: PathIndex) x. Rep (PathI i) x -> PathI i
forall (i :: PathIndex) x. PathI i -> Rep (PathI i) x
$cfrom :: forall (i :: PathIndex) x. PathI i -> Rep (PathI i) x
from :: forall x. PathI i -> Rep (PathI i) x
$cto :: forall (i :: PathIndex) x. Rep (PathI i) x -> PathI i
to :: forall x. Rep (PathI i) x -> PathI i
Generic, Int -> PathI i -> ShowS
[PathI i] -> ShowS
PathI i -> String
(Int -> PathI i -> ShowS)
-> (PathI i -> String) -> ([PathI i] -> ShowS) -> Show (PathI i)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (i :: PathIndex). Int -> PathI i -> ShowS
forall (i :: PathIndex). [PathI i] -> ShowS
forall (i :: PathIndex). PathI i -> String
$cshowsPrec :: forall (i :: PathIndex). Int -> PathI i -> ShowS
showsPrec :: Int -> PathI i -> ShowS
$cshow :: forall (i :: PathIndex). PathI i -> String
show :: PathI i -> String
$cshowList :: forall (i :: PathIndex). [PathI i] -> ShowS
showList :: [PathI i] -> ShowS
Show)
  deriving anyclass (Eq (PathI i)
Eq (PathI i) =>
(Int -> PathI i -> Int) -> (PathI i -> Int) -> Hashable (PathI i)
Int -> PathI i -> Int
PathI i -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (i :: PathIndex). Eq (PathI i)
forall (i :: PathIndex). Int -> PathI i -> Int
forall (i :: PathIndex). PathI i -> Int
$chashWithSalt :: forall (i :: PathIndex). Int -> PathI i -> Int
hashWithSalt :: Int -> PathI i -> Int
$chash :: forall (i :: PathIndex). PathI i -> Int
hash :: PathI i -> Int
Hashable, PathI i -> ()
(PathI i -> ()) -> NFData (PathI i)
forall a. (a -> ()) -> NFData a
forall (i :: PathIndex). PathI i -> ()
$crnf :: forall (i :: PathIndex). PathI i -> ()
rnf :: PathI i -> ()
NFData)

makeFieldLabelsNoPrefix ''PathI

-- TODO: If we have a total way to encode 'OsPath -> ByteString' then we can
-- make encode total, which will improve several type signatures. Technically
-- we could do this by utilizing OsPath's underlying ShortByteString, but
-- that requires digging into the internals.
--
-- There is an open issue for a Binary interface: once that lands, we can use
-- the same serialization strategy.
--
-- https://github.com/haskell/filepath/issues/161

instance Serial (PathI i) where
  type DecodeExtra (PathI i) = ()

  encode :: PathI i -> Either String ByteString
encode =
    (EncodingException -> String)
-> (String -> ByteString)
-> Either EncodingException String
-> Either String ByteString
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 EncodingException -> String
forall e. Exception e => e -> String
displayException (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
      (Either EncodingException String -> Either String ByteString)
-> (PathI i -> Either EncodingException String)
-> PathI i
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Either EncodingException String
decodeOsToFp
      (OsPath -> Either EncodingException String)
-> (PathI i -> OsPath)
-> PathI i
-> Either EncodingException String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso NoIx (PathI i) OsPath -> PathI i -> OsPath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx (PathI i) OsPath
#unPathI

  decode :: DecodeExtra (PathI i) -> ByteString -> Either String (PathI i)
decode DecodeExtra (PathI i)
_ ByteString
bs = case ByteString -> Either UnicodeException Text
TEnc.decodeUtf8' ByteString
bs of
    Left UnicodeException
ex -> String -> Either String (PathI i)
forall a b. a -> Either a b
Left (String -> Either String (PathI i))
-> String -> Either String (PathI i)
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
ex
    Right Text
t ->
      (EncodingException -> String)
-> (OsPath -> PathI i)
-> Either EncodingException OsPath
-> Either String (PathI i)
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 EncodingException -> String
forall e. Exception e => e -> String
displayException OsPath -> PathI i
forall (i :: PathIndex). OsPath -> PathI i
MkPathI
        (Either EncodingException OsPath -> Either String (PathI i))
-> (Text -> Either EncodingException OsPath)
-> Text
-> Either String (PathI i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either EncodingException OsPath
encodeFpToOs
        (String -> Either EncodingException OsPath)
-> (Text -> String) -> Text -> Either EncodingException OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
        (Text -> Either String (PathI i))
-> Text -> Either String (PathI i)
forall a b. (a -> b) -> a -> b
$ Text
t

-- | Modifies the index.
reindex :: PathI i -> PathI j
reindex :: forall (i :: PathIndex) (j :: PathIndex). PathI i -> PathI j
reindex = (OsPath -> OsPath) -> PathI i -> PathI j
forall (i :: PathIndex) (j :: PathIndex).
(OsPath -> OsPath) -> PathI i -> PathI j
liftPathI OsPath -> OsPath
forall a. a -> a
id

-- | Lifts an 'OsPath' transformation to 'PathI', allowing for the index to
-- change.
liftPathI :: (OsPath -> OsPath) -> PathI i -> PathI j
liftPathI :: forall (i :: PathIndex) (j :: PathIndex).
(OsPath -> OsPath) -> PathI i -> PathI j
liftPathI OsPath -> OsPath
f (MkPathI OsPath
fp) = OsPath -> PathI j
forall (i :: PathIndex). OsPath -> PathI i
MkPathI (OsPath -> OsPath
f OsPath
fp)

-- | 'liftPathI' specialized to the same index. This should be preferred
-- as the former is easier to use incorrectly.
liftPathI' :: (OsPath -> OsPath) -> PathI i -> PathI i
liftPathI' :: forall (i :: PathIndex). (OsPath -> OsPath) -> PathI i -> PathI i
liftPathI' = (OsPath -> OsPath) -> PathI i -> PathI i
forall (i :: PathIndex) (j :: PathIndex).
(OsPath -> OsPath) -> PathI i -> PathI j
liftPathI

-- | Lifts an effectful 'FilePath' transformation to 'PathI'.
liftPathIF ::
  (Functor f, HasCallStack) =>
  ((HasCallStack) => OsPath -> f OsPath) ->
  PathI i ->
  f (PathI j)
liftPathIF :: forall (f :: * -> *) (i :: PathIndex) (j :: PathIndex).
(Functor f, HasCallStack) =>
(HasCallStack => OsPath -> f OsPath) -> PathI i -> f (PathI j)
liftPathIF HasCallStack => OsPath -> f OsPath
f = (OsPath -> PathI j) -> f OsPath -> f (PathI j)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OsPath -> PathI j
forall (i :: PathIndex). OsPath -> PathI i
MkPathI (f OsPath -> f (PathI j))
-> (PathI i -> f OsPath) -> PathI i -> f (PathI j)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => OsPath -> f OsPath) -> PathI i -> f OsPath
forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
applyPathI HasCallStack => OsPath -> f OsPath
OsPath -> f OsPath
f

-- | 'liftPathIF' specialized to the same index. This should be preferred
-- as the former is easier to use incorrectly.
liftPathIF' ::
  (Functor f) =>
  ((HasCallStack) => OsPath -> f OsPath) ->
  PathI i ->
  f (PathI i)
liftPathIF' :: forall (f :: * -> *) (i :: PathIndex).
Functor f =>
(HasCallStack => OsPath -> f OsPath) -> PathI i -> f (PathI i)
liftPathIF' = (HasCallStack => OsPath -> f OsPath) -> PathI i -> f (PathI i)
forall (f :: * -> *) (i :: PathIndex) (j :: PathIndex).
(Functor f, HasCallStack) =>
(HasCallStack => OsPath -> f OsPath) -> PathI i -> f (PathI j)
liftPathIF

-- | Lifts an 'OsPath' function to 'PathI'.
applyPathI :: (HasCallStack) => ((HasCallStack) => OsPath -> a) -> PathI i -> a
applyPathI :: forall a (i :: PathIndex).
HasCallStack =>
(HasCallStack => OsPath -> a) -> PathI i -> a
applyPathI HasCallStack => OsPath -> a
f = HasCallStack => OsPath -> a
OsPath -> a
f (OsPath -> a) -> (PathI i -> OsPath) -> PathI i -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso NoIx (PathI i) OsPath -> PathI i -> OsPath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx (PathI i) OsPath
#unPathI

-- | '(</>)' lifted to 'PathI'. Notice the index can change, so take care.
(<//>) :: PathI i1 -> PathI i2 -> PathI i3
MkPathI OsPath
x <//> :: forall (i1 :: PathIndex) (i2 :: PathIndex) (i3 :: PathIndex).
PathI i1 -> PathI i2 -> PathI i3
<//> MkPathI OsPath
y = OsPath -> PathI i3
forall (i :: PathIndex). OsPath -> PathI i
MkPathI (OsPath
x OsPath -> OsPath -> OsPath
</> OsPath
y)

infixr 5 <//>

(<//) :: PathI i1 -> OsPath -> PathI i2
MkPathI OsPath
x <// :: forall (i1 :: PathIndex) (i2 :: PathIndex).
PathI i1 -> OsPath -> PathI i2
<// OsPath
y = OsPath -> PathI i2
forall (i :: PathIndex). OsPath -> PathI i
MkPathI (OsPath
x OsPath -> OsPath -> OsPath
</> OsPath
y)

infixl 5 <//

(//>) :: OsPath -> PathI i1 -> PathI i2
//> :: forall (i1 :: PathIndex) (i2 :: PathIndex).
OsPath -> PathI i1 -> PathI i2
(//>) = (PathI i1 -> OsPath -> PathI i2) -> OsPath -> PathI i1 -> PathI i2
forall a b c. (a -> b -> c) -> b -> a -> c
flip PathI i1 -> OsPath -> PathI i2
forall (i1 :: PathIndex) (i2 :: PathIndex).
PathI i1 -> OsPath -> PathI i2
(<//)

infixl 5 //>

--- | Returns true if the paths is empty. Note that whitespace is __not__
--- considered empty as we are trying to prevent deleting "" (which gets
--- turned into the current working directory). But posix filepaths can be
--- whitespace (e.g. " "), and that is fine.
isEmpty :: (MonadThrow m) => PathI i -> m Bool
isEmpty :: forall (m :: * -> *) (i :: PathIndex).
MonadThrow m =>
PathI i -> m Bool
isEmpty (MkPathI OsPath
p) = do
  String
s <- OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM OsPath
p
  -- NOTE: This is NOT redundant as the typical OsPath creation functions
  -- e.g. encodeUtf do NOT check for empty (or other invariants). We need to
  -- use the 'isValid' check instead.
  --
  -- Our optparse-applicative ReadM function osPath does in fact check this,
  -- so hopefully all of our OsPaths are valid. Nevertheless we leave this
  -- check in to be safe.
  Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s

-- | Returns true if the path is the root.
isRoot :: (MonadThrow m) => PathI i -> m Bool
isRoot :: forall (m :: * -> *) (i :: PathIndex).
MonadThrow m =>
PathI i -> m Bool
isRoot = OsPath -> m Bool
forall (m :: * -> *). MonadThrow m => OsPath -> m Bool
isRoot' (OsPath -> m Bool) -> (PathI i -> OsPath) -> PathI i -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso NoIx (PathI i) OsPath -> PathI i -> OsPath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx (PathI i) OsPath
#unPathI

-- | Returns true if the path is the root.
isRoot' :: (MonadThrow m) => OsPath -> m Bool
#if WINDOWS
isRoot' p = do
  fp <- decodeOsToFpThrowM p
  pure $ f . T.unpack . T.strip . T.pack $ fp
  where
    f (_ : ':' : rest) = null rest || rest == "\\" || rest == "\\\\"
    f _ = False
#else
isRoot' :: forall (m :: * -> *). MonadThrow m => OsPath -> m Bool
isRoot' OsPath
p = do
  String
fp <- OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM OsPath
p
  Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"/") (Text -> Bool) -> (String -> Text) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
fp
#endif

-- | Returns true if the path __ends__ in nothing but dots e.g.
-- @/path/to/dots/..@.
isDots :: (MonadThrow m) => PathI i -> m Bool
isDots :: forall (m :: * -> *) (i :: PathIndex).
MonadThrow m =>
PathI i -> m Bool
isDots (MkPathI OsPath
p) = do
  let p' :: OsPath
p' = OsPath -> OsPath
FP.takeFileName OsPath
p
  String
fp <- OsPath -> m String
forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeOsToFpThrowM OsPath
p'
  Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall {t :: * -> *}. Foldable t => t Char -> Bool
isDots' (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
fp
  where
    isDots' :: t Char -> Bool
isDots' t Char
fp = (Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') t Char
fp Bool -> Bool -> Bool
&& Bool -> Bool
not (t Char -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Char
fp)

-- | Pretty-print a list of paths.
--
-- >>> showPaths ["one", "two"]
-- "one, two"
showPaths :: [PathI a] -> String
showPaths :: forall (a :: PathIndex). [PathI a] -> String
showPaths = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
", " ([String] -> String)
-> ([PathI a] -> [String]) -> [PathI a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathI a -> String) -> [PathI a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OsPath -> String
forall a. Show a => a -> String
show (OsPath -> String) -> (PathI a -> OsPath) -> PathI a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso NoIx (PathI a) OsPath -> PathI a -> OsPath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx (PathI a) OsPath
#unPathI)

-- | 'PathI' to 'String'. Attempts decoding for nicer display.
toString :: PathI i -> String
toString :: forall (i :: PathIndex). PathI i -> String
toString (MkPathI OsPath
p) = OsPath -> String
decodeOsToFpDisplayEx OsPath
p

-- | 'PathI' to 'Text' via 'toString'.
toText :: PathI i -> Text
toText :: forall (i :: PathIndex). PathI i -> Text
toText = String -> Text
T.pack (String -> Text) -> (PathI i -> String) -> PathI i -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathI i -> String
forall (i :: PathIndex). PathI i -> String
toString

-- $general
-- These functions allows for lifting arbitrary 'OsPath' functions onto our
-- 'PathI'. Note that this can easily invalidate any invariants we would
-- like to hold (e.g. appending a path can turn a directory into a file),
-- so caution must be exercised.