{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Provides utilities for working with 'OsPath'.
--
-- @since 0.1
module FileSystem.OsPath
  ( -- * Types
    OsPath,

    -- * Encoding

    -- ** Total
    encode,
    encodeLenient,

    -- ** Partial
    encodeThrowM,
    encodeFail,
    unsafeEncode,

    -- * Encoding + Validation

    -- ** Total
    osp,
    ospPathSep,
    encodeValid,
    encodeValidLenient,

    -- ** Partial
    encodeValidThrowM,
    encodeValidFail,
    unsafeEncodeValid,

    -- * Decoding

    -- ** Total
    decode,
    decodeLenient,
    decodeDisplayEx,
    decodeShow,

    -- ** Partial
    decodeThrowM,
    decodeFail,
    unsafeDecode,

    -- * OsString
    toOsString,
    fromOsString,
    fromOsStringThrowM,
    fromOsStringFail,
    unsafeFromOsString,
    reallyUnsafeFromOsString,

    -- * Functions
    (</>),
    (<.>),
    (-<.>),

    -- * Legacy
    (</>!),
    (!</>),
    combineFilePaths,

    -- * Errors
    EncodingException (..),

    -- * Tildes
    toTildeState,
    TildeState (..),
    OsPathNE (..),
    TildeException (..),
  )
where

import Control.Category ((>>>))
import Control.DeepSeq (NFData)
import Control.Exception (Exception (displayException))
import Control.Monad.Catch (MonadThrow, throwM)
import FileSystem.Internal (TildePrefixes)
import FileSystem.Internal qualified as Internal
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Language.Haskell.TH.Quote
  ( QuasiQuoter
      ( QuasiQuoter,
        quoteDec,
        quoteExp,
        quotePat,
        quoteType
      ),
  )
import System.FilePath qualified as FP
import System.OsPath (OsPath, osp, (-<.>), (<.>), (</>))
import System.OsPath qualified as OsP
import System.OsPath.Encoding (EncodingException (EncodingError))
import System.OsString (OsString)

-- NOTE: -Wno-redundant-constraints is because the HasCallStack is redundant
-- on some of these functions when the exceptions library is too old.
-- Disabling the warning is easier than trying to get it right with cpp.

-- | Like 'osp', except it runs paths through a "replace function" first.
-- On unix, replaces @\\@ with @/@. On windows, does the opposite.
--
-- This is convenient for writing paths in a platform-agnostic way i.e. we
-- are expecting a path
--
-- @
--   "path\/to\/foo" -- unix
--   "path\\to\\foo" -- windows
-- @
--
-- The normal way to handle this would be to use the combine function '(</>)'
-- i.e.
--
-- @
--   [osp|path|] '</>' [osp|to|] '</>' [osp|foo|]
-- @
--
-- This can be quite cumbersome for long paths, so we provide this alternative,
-- allowing:
--
-- @
--   [ospPathSep|path\/to\/foo]
-- @
--
-- Which will automatically convert slashes.
ospPathSep :: QuasiQuoter
ospPathSep :: QuasiQuoter
ospPathSep =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = QuasiQuoter
osp.quoteExp (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
Internal.replaceSlashes,
      quotePat :: String -> Q Pat
quotePat = QuasiQuoter
osp.quotePat (String -> Q Pat) -> (String -> String) -> String -> Q Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
Internal.replaceSlashes,
      quoteType :: String -> Q Type
quoteType = QuasiQuoter
osp.quoteType (String -> Q Type) -> (String -> String) -> String -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
Internal.replaceSlashes,
      quoteDec :: String -> Q [Dec]
quoteDec = QuasiQuoter
osp.quoteDec (String -> Q [Dec]) -> (String -> String) -> String -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
Internal.replaceSlashes
    }

-- | Encodes a 'FilePath' to an 'OsPath'. This is a pure version of filepath's
-- 'OsP.encodeUtf' that returns the 'EncodingException' in the event of an
-- error.
--
-- @since 0.1
encode :: FilePath -> Either EncodingException OsPath
encode :: String -> Either EncodingException OsString
encode = TextEncoding
-> TextEncoding -> String -> Either EncodingException OsString
OsP.encodeWith TextEncoding
utf8Encoder TextEncoding
utf16Encoder
  where
    (TextEncoding
utf8Encoder, TextEncoding
utf16Encoder) = (TextEncoding, TextEncoding)
Internal.utfEncodings

-- | Total conversion from 'FilePath' to 'OsPath', replacing encode failures
-- with the closest visual match.
--
-- @since 0.1
encodeLenient :: FilePath -> OsPath
encodeLenient :: String -> OsString
encodeLenient = Either EncodingException OsString -> OsString
forall {a}. Either EncodingException a -> a
elimEx (Either EncodingException OsString -> OsString)
-> (String -> Either EncodingException OsString)
-> String
-> OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding
-> TextEncoding -> String -> Either EncodingException OsString
OsP.encodeWith TextEncoding
uft8Encoding TextEncoding
utf16Encoding
  where
    (TextEncoding
uft8Encoding, TextEncoding
utf16Encoding, Either EncodingException a -> a
elimEx) = (TextEncoding, TextEncoding, Either EncodingException a -> a)
forall a.
(TextEncoding, TextEncoding, Either EncodingException a -> a)
Internal.utfEncodingsLenient

-- | 'encode' that __also__ checks 'OsP.isValid' i.e. 'encode'
-- only succeeds if the 'FilePath' can be encoded /and/ passes expected
-- invariants.
--
-- @since 0.1
encodeValid :: FilePath -> Either EncodingException OsPath
encodeValid :: String -> Either EncodingException OsString
encodeValid String
fp = case String -> Either EncodingException OsString
encode String
fp of
  Left EncodingException
ex -> EncodingException -> Either EncodingException OsString
forall a b. a -> Either a b
Left EncodingException
ex
  Right OsString
op ->
    if OsString -> Bool
OsP.isValid OsString
op
      then OsString -> Either EncodingException OsString
forall a b. b -> Either a b
Right OsString
op
      else EncodingException -> Either EncodingException OsString
forall a b. a -> Either a b
Left (EncodingException -> Either EncodingException OsString)
-> EncodingException -> Either EncodingException OsString
forall a b. (a -> b) -> a -> b
$ String -> Maybe Word8 -> EncodingException
EncodingError (String -> OsString -> String
validFpErr String
fp OsString
op) Maybe Word8
forall a. Maybe a
Nothing

-- | Total conversion from 'FilePath' to 'OsPath', replacing encode failures
-- with the closest visual match. If the result is not valid, makes it valid.
--
-- @since 0.1
encodeValidLenient :: FilePath -> OsPath
encodeValidLenient :: String -> OsString
encodeValidLenient = OsString -> OsString
OsP.makeValid (OsString -> OsString)
-> (String -> OsString) -> String -> OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OsString
encodeLenient

-- | 'encode' that throws 'EncodingException'.
--
-- @since 0.1
encodeThrowM :: (HasCallStack, MonadThrow m) => FilePath -> m OsPath
encodeThrowM :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
String -> m OsString
encodeThrowM =
  String -> Either EncodingException OsString
encode (String -> Either EncodingException OsString)
-> (Either EncodingException OsString -> m OsString)
-> String
-> m OsString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Right OsString
txt -> OsString -> m OsString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
txt
    Left EncodingException
ex -> EncodingException -> m OsString
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM EncodingException
ex
{-# INLINEABLE encodeThrowM #-}

-- | 'encodeValid' that throws 'EncodingException'.
--
-- @since 0.1
encodeValidThrowM :: (HasCallStack, MonadThrow m) => FilePath -> m OsPath
encodeValidThrowM :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
String -> m OsString
encodeValidThrowM =
  String -> Either EncodingException OsString
encodeValid (String -> Either EncodingException OsString)
-> (Either EncodingException OsString -> m OsString)
-> String
-> m OsString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Left EncodingException
ex -> EncodingException -> m OsString
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM EncodingException
ex
    Right OsString
op -> OsString -> m OsString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
op
{-# INLINEABLE encodeValidThrowM #-}

-- | 'encodeThrowM' with 'MonadFail'.
--
-- @since 0.1
encodeFail :: (HasCallStack, MonadFail m) => FilePath -> m OsPath
encodeFail :: forall (m :: * -> *).
(HasCallStack, MonadFail m) =>
String -> m OsString
encodeFail String
fp = case String -> Either EncodingException OsString
encode String
fp of
  Right OsString
txt -> OsString -> m OsString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
txt
  Left EncodingException
ex -> String -> m OsString
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex)
{-# INLINEABLE encodeFail #-}

-- | 'encodeValid' with 'MonadFail'.
--
-- @since 0.1
encodeValidFail :: (HasCallStack, MonadFail m) => FilePath -> m OsPath
encodeValidFail :: forall (m :: * -> *).
(HasCallStack, MonadFail m) =>
String -> m OsString
encodeValidFail String
fp = case String -> Either EncodingException OsString
encodeValid String
fp of
  Left EncodingException
ex -> String -> m OsString
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex)
  Right OsString
op -> OsString -> m OsString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
op
{-# INLINEABLE encodeValidFail #-}

-- | Unsafely converts a 'FilePath' to 'OsPath' falling back to 'error'.
--
-- __WARNING: Partial__
--
-- @since 0.1
unsafeEncode :: (HasCallStack) => FilePath -> OsPath
unsafeEncode :: HasCallStack => String -> OsString
unsafeEncode String
fp = case String -> Either EncodingException OsString
encode String
fp of
  Left EncodingException
ex -> String -> OsString
forall a. HasCallStack => String -> a
error (EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex)
  Right OsString
p -> OsString
p

-- | Unsafely converts a 'FilePath' to 'OsPath' falling back to 'error'.
--
-- __WARNING: Partial__
--
-- @since 0.1
unsafeEncodeValid :: (HasCallStack) => FilePath -> OsPath
unsafeEncodeValid :: HasCallStack => String -> OsString
unsafeEncodeValid String
fp = case String -> Either EncodingException OsString
encodeValid String
fp of
  Left EncodingException
ex -> String -> OsString
forall a. HasCallStack => String -> a
error (EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex)
  Right OsString
op -> OsString
op

-- | Decodes an 'OsPath' to a 'FilePath'. This is a pure version of filepath's
-- 'OsP.decodeUtf'.
--
-- @since 0.1
decode :: OsPath -> Either EncodingException FilePath
decode :: OsString -> Either EncodingException String
decode = TextEncoding
-> TextEncoding -> OsString -> Either EncodingException String
OsP.decodeWith TextEncoding
utf8Encoder TextEncoding
utf16Encoder
  where
    (TextEncoding
utf8Encoder, TextEncoding
utf16Encoder) = (TextEncoding, TextEncoding)
Internal.utfEncodings

-- | Total conversion from 'OsPath' to 'FilePath', replacing decode failures
-- with the closest visual match.
--
-- @since 0.1
decodeLenient :: OsPath -> FilePath
decodeLenient :: OsString -> String
decodeLenient = Either EncodingException String -> String
forall {a}. Either EncodingException a -> a
elimEx (Either EncodingException String -> String)
-> (OsString -> Either EncodingException String)
-> OsString
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding
-> TextEncoding -> OsString -> Either EncodingException String
OsP.decodeWith TextEncoding
uft8Encoding TextEncoding
utf16Encoding
  where
    (TextEncoding
uft8Encoding, TextEncoding
utf16Encoding, Either EncodingException a -> a
elimEx) = (TextEncoding, TextEncoding, Either EncodingException a -> a)
forall a.
(TextEncoding, TextEncoding, Either EncodingException a -> a)
Internal.utfEncodingsLenient

-- | 'decode' that throws 'EncodingException'.
--
-- @since 0.1
decodeThrowM :: (HasCallStack, MonadThrow m) => OsPath -> m FilePath
decodeThrowM :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsString -> m String
decodeThrowM =
  OsString -> Either EncodingException String
decode (OsString -> Either EncodingException String)
-> (Either EncodingException String -> m String)
-> OsString
-> m String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Right String
txt -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
txt
    Left EncodingException
ex -> EncodingException -> m String
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM EncodingException
ex
{-# INLINEABLE decodeThrowM #-}

-- | 'decode' with 'MonadFail'.
--
-- @since 0.1
decodeFail :: (HasCallStack, MonadFail m) => OsPath -> m FilePath
decodeFail :: forall (m :: * -> *).
(HasCallStack, MonadFail m) =>
OsString -> m String
decodeFail OsString
p = case OsString -> Either EncodingException String
decode OsString
p of
  Right String
txt -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
txt
  Left EncodingException
ex -> String -> m String
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex)
{-# INLINEABLE decodeFail #-}

-- | Total conversion from 'OsPath' to 'String'. If decoding fails, displays
-- the exception.
--
-- @since 0.1
decodeDisplayEx :: OsPath -> String
decodeDisplayEx :: OsString -> String
decodeDisplayEx OsString
p = case OsString -> Either EncodingException String
decode OsString
p of
  Left EncodingException
ex -> EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex
  Right String
s -> String
s

-- | Total conversion from 'OsPath' to 'String'. If decoding fails, falls back
-- to its 'Show' instance.
--
-- @since 0.1
decodeShow :: OsPath -> String
decodeShow :: OsString -> String
decodeShow OsString
p = case OsString -> Either EncodingException String
decode OsString
p of
  Left EncodingException
_ -> OsString -> String
forall a. Show a => a -> String
show OsString
p
  Right String
s -> String
s

-- | Unsafely converts an 'OsPath' to a 'FilePath' falling back to 'error'.
--
-- __WARNING: Partial__
--
-- @since 0.1
unsafeDecode :: (HasCallStack) => OsPath -> FilePath
unsafeDecode :: HasCallStack => OsString -> String
unsafeDecode OsString
p = case OsString -> Either EncodingException String
decode OsString
p of
  Left EncodingException
ex -> String -> String
forall a. HasCallStack => String -> a
error (EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex)
  Right String
fp -> String
fp

validFpErr :: String -> OsPath -> String
validFpErr :: String -> OsString -> String
validFpErr String
fp OsString
x =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
"FilePath '",
      String
fp,
      String
"' encoded as OsPath '",
      OsString -> String
decodeLenient OsString
x,
      String
"' failed isValid"
    ]

validOsStrErr :: OsString -> String
validOsStrErr :: OsString -> String
validOsStrErr OsString
str =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
"OsString '",
      OsString -> String
decodeLenient OsString
str,
      String
"' failed isValid"
    ]

-- | Unsafely combines an 'OsPath' and a 'FilePath' via (</>) with
-- 'unsafeEncode'.
--
-- __WARNING: Partial__
--
-- @since 0.1
(</>!) :: (HasCallStack) => OsPath -> FilePath -> OsPath
OsString
p </>! :: HasCallStack => OsString -> String -> OsString
</>! String
fp = OsString
p OsString -> OsString -> OsString
</> HasCallStack => String -> OsString
String -> OsString
unsafeEncode String
fp

infixl 9 </>!

-- | Unsafely combines a 'FilePath' and an 'OsPath' via (</>) with
-- 'unsafeEncode'.
--
-- __WARNING: Partial__
--
-- @since 0.1
(!</>) :: (HasCallStack) => FilePath -> OsPath -> OsPath
!</> :: HasCallStack => String -> OsString -> OsString
(!</>) = (OsString -> String -> OsString) -> String -> OsString -> OsString
forall a b c. (a -> b -> c) -> b -> a -> c
flip HasCallStack => OsString -> String -> OsString
OsString -> String -> OsString
(</>!)

infixl 9 !</>

-- | Legacy alias for FilePaths' </> operator. Exists because the </> exported
-- here is @'(</>)' :: 'OsPath' -> 'OsPath' -> 'OsPath'@.
--
-- @since 0.1
combineFilePaths :: FilePath -> FilePath -> FilePath
combineFilePaths :: String -> String -> String
combineFilePaths = String -> String -> String
(FP.</>)

-- | Exception for a path containing a tilde.
newtype TildeException = MkTildeException OsPath
  deriving stock
    ( -- | @since 0.1
      TildeException -> TildeException -> Bool
(TildeException -> TildeException -> Bool)
-> (TildeException -> TildeException -> Bool) -> Eq TildeException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TildeException -> TildeException -> Bool
== :: TildeException -> TildeException -> Bool
$c/= :: TildeException -> TildeException -> Bool
/= :: TildeException -> TildeException -> Bool
Eq,
      -- | @since 0.1
      (forall x. TildeException -> Rep TildeException x)
-> (forall x. Rep TildeException x -> TildeException)
-> Generic TildeException
forall x. Rep TildeException x -> TildeException
forall x. TildeException -> Rep TildeException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TildeException -> Rep TildeException x
from :: forall x. TildeException -> Rep TildeException x
$cto :: forall x. Rep TildeException x -> TildeException
to :: forall x. Rep TildeException x -> TildeException
Generic,
      -- | @since 0.1
      Int -> TildeException -> String -> String
[TildeException] -> String -> String
TildeException -> String
(Int -> TildeException -> String -> String)
-> (TildeException -> String)
-> ([TildeException] -> String -> String)
-> Show TildeException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TildeException -> String -> String
showsPrec :: Int -> TildeException -> String -> String
$cshow :: TildeException -> String
show :: TildeException -> String
$cshowList :: [TildeException] -> String -> String
showList :: [TildeException] -> String -> String
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      TildeException -> ()
(TildeException -> ()) -> NFData TildeException
forall a. (a -> ()) -> NFData a
$crnf :: TildeException -> ()
rnf :: TildeException -> ()
NFData
    )

-- | @since 0.1
instance Exception TildeException where
  displayException :: TildeException -> String
displayException (MkTildeException OsString
p) =
    String
"Unexpected tilde in OsPath: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OsString -> String
decodeLenient OsString
p

-- | Represents the "tilde state" for a given path.
data TildeState
  = -- | The path contains no tildes.
    TildeStateNone OsPath
  | -- | The path contained a "tilde prefix" e.g. @~/@ or @~\\ (windows only)@,
    -- which has been stripped. It contains no other tildes. The result can
    -- be empty, however.
    TildeStatePrefix OsPathNE
  | -- | The path contained a non-prefix tilde.
    TildeStateNonPrefix OsPath
  deriving stock
    ( -- | @since 0.1
      TildeState -> TildeState -> Bool
(TildeState -> TildeState -> Bool)
-> (TildeState -> TildeState -> Bool) -> Eq TildeState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TildeState -> TildeState -> Bool
== :: TildeState -> TildeState -> Bool
$c/= :: TildeState -> TildeState -> Bool
/= :: TildeState -> TildeState -> Bool
Eq,
      -- | @since 0.1
      (forall x. TildeState -> Rep TildeState x)
-> (forall x. Rep TildeState x -> TildeState) -> Generic TildeState
forall x. Rep TildeState x -> TildeState
forall x. TildeState -> Rep TildeState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TildeState -> Rep TildeState x
from :: forall x. TildeState -> Rep TildeState x
$cto :: forall x. Rep TildeState x -> TildeState
to :: forall x. Rep TildeState x -> TildeState
Generic,
      -- | @since 0.1
      Int -> TildeState -> String -> String
[TildeState] -> String -> String
TildeState -> String
(Int -> TildeState -> String -> String)
-> (TildeState -> String)
-> ([TildeState] -> String -> String)
-> Show TildeState
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TildeState -> String -> String
showsPrec :: Int -> TildeState -> String -> String
$cshow :: TildeState -> String
show :: TildeState -> String
$cshowList :: [TildeState] -> String -> String
showList :: [TildeState] -> String -> String
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      TildeState -> ()
(TildeState -> ()) -> NFData TildeState
forall a. (a -> ()) -> NFData a
$crnf :: TildeState -> ()
rnf :: TildeState -> ()
NFData
    )

-- | Retrieves the path's "tilde state".
--
-- @since 0.1
toTildeState :: OsPath -> TildeState
toTildeState :: OsString -> TildeState
toTildeState OsString
p =
  case OsString -> Maybe OsPathNE
stripTildePrefix OsString
p of
    -- No leading tilde; check original string.
    Maybe OsPathNE
Nothing -> (OsString -> TildeState) -> OsString -> TildeState
f OsString -> TildeState
TildeStateNone OsString
p
    -- Leading tilde produced empty string; fine, nothing else to check.
    Just OsPathNE
OsPathEmpty -> OsPathNE -> TildeState
TildeStatePrefix OsPathNE
OsPathEmpty
    -- Leading tilde w/ non-empty stripped; check stripped.
    Just (OsPathNonEmpty OsString
p') ->
      (OsString -> TildeState) -> OsString -> TildeState
f (OsPathNE -> TildeState
TildeStatePrefix (OsPathNE -> TildeState)
-> (OsString -> OsPathNE) -> OsString -> TildeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> OsPathNE
OsPathNonEmpty) OsString
p'
  where
    f :: (OsPath -> TildeState) -> OsPath -> TildeState
    f :: (OsString -> TildeState) -> OsString -> TildeState
f OsString -> TildeState
toState OsString
q =
      if OsString -> Bool
Internal.containsTilde (OsString -> OsString
toOsString OsString
q)
        then OsString -> TildeState
TildeStateNonPrefix OsString
q
        else OsString -> TildeState
toState OsString
q

-- | Sum type representing a possible empty OsPath.
--
-- @since 0.1
data OsPathNE
  = -- | OsPath is empty.
    --
    -- @since 0.1
    OsPathEmpty
  | -- | OsPath is non-empty.
    --
    -- @since 0.1
    OsPathNonEmpty OsPath
  deriving stock
    ( -- | @since 0.1
      OsPathNE -> OsPathNE -> Bool
(OsPathNE -> OsPathNE -> Bool)
-> (OsPathNE -> OsPathNE -> Bool) -> Eq OsPathNE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OsPathNE -> OsPathNE -> Bool
== :: OsPathNE -> OsPathNE -> Bool
$c/= :: OsPathNE -> OsPathNE -> Bool
/= :: OsPathNE -> OsPathNE -> Bool
Eq,
      -- | @since 0.1
      (forall x. OsPathNE -> Rep OsPathNE x)
-> (forall x. Rep OsPathNE x -> OsPathNE) -> Generic OsPathNE
forall x. Rep OsPathNE x -> OsPathNE
forall x. OsPathNE -> Rep OsPathNE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OsPathNE -> Rep OsPathNE x
from :: forall x. OsPathNE -> Rep OsPathNE x
$cto :: forall x. Rep OsPathNE x -> OsPathNE
to :: forall x. Rep OsPathNE x -> OsPathNE
Generic,
      -- | @since 0.1
      Int -> OsPathNE -> String -> String
[OsPathNE] -> String -> String
OsPathNE -> String
(Int -> OsPathNE -> String -> String)
-> (OsPathNE -> String)
-> ([OsPathNE] -> String -> String)
-> Show OsPathNE
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OsPathNE -> String -> String
showsPrec :: Int -> OsPathNE -> String -> String
$cshow :: OsPathNE -> String
show :: OsPathNE -> String
$cshowList :: [OsPathNE] -> String -> String
showList :: [OsPathNE] -> String -> String
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      OsPathNE -> ()
(OsPathNE -> ()) -> NFData OsPathNE
forall a. (a -> ()) -> NFData a
$crnf :: OsPathNE -> ()
rnf :: OsPathNE -> ()
NFData
    )

-- | Strip tilde prefix of path @p@, returning @Just p'@ if @p@ was stripped.
-- On unix, strips @~/@. On windows, attempts to strip the same @~/@.
-- If that was unsuccessful, then attempts @~\\@.
--
-- Note that this can return an empty OsPath if the parameter is one of
-- @"~/"@, @"~"@, or @"~\\"@ (windows only).
--
-- @since 0.1
stripTildePrefix :: OsPath -> Maybe OsPathNE
stripTildePrefix :: OsString -> Maybe OsPathNE
stripTildePrefix =
  (OsString -> OsPathNE) -> Maybe OsString -> Maybe OsPathNE
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OsString -> OsPathNE
toStripped
    (Maybe OsString -> Maybe OsPathNE)
-> (OsString -> Maybe OsString) -> OsString -> Maybe OsPathNE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TildePrefixes -> OsString -> Maybe OsString
Internal.stripTildePrefix TildePrefixes
tildePrefixes
    (OsString -> Maybe OsString)
-> (OsString -> OsString) -> OsString -> Maybe OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> OsString
toOsString
  where
    -- NOTE: This is predicated on the belief that stripping a prefix does not
    -- change the validity. In particular, stripping a prefix cannot change a
    -- valid path to an invalid path. There is one exception to this: A path
    -- that _only_ contains the tilde prefix e.g. "~/". This will produce an
    -- empty string which is _not_ valid.
    --
    -- We want to allow this, however, because downstream functions will want
    -- to turn an empty path into the plain home directory. Hence we should
    -- __not__ check validity here, which is okay as long as this is the only
    -- instance of "introduced invalidity".
    --
    -- We should strongly signal that the result can be empty, hence OsPathNE.
    toStripped :: OsString -> OsPathNE
    toStripped :: OsString -> OsPathNE
toStripped OsString
s =
      if OsString
s OsString -> OsString -> Bool
forall a. Eq a => a -> a -> Bool
== OsString
forall a. Monoid a => a
mempty
        then OsPathNE
OsPathEmpty
        else OsString -> OsPathNE
OsPathNonEmpty (OsString -> OsString
reallyUnsafeFromOsString OsString
s)

tildePrefixes :: TildePrefixes
tildePrefixes :: TildePrefixes
tildePrefixes = (OsString -> OsString
toOsString [osp|~/|], OsString -> OsString
toOsString [osp|~\|])

-- | Convert an 'OsPath' to 'OsString'. This is currently the identity
-- function.
--
-- @since 0.1
toOsString :: OsPath -> OsString
toOsString :: OsString -> OsString
toOsString = OsString -> OsString
forall a. a -> a
id

-- | Convert an 'OsString' to 'OsPath'. Currently this merely checks
-- 'OsPath.isValid'.
--
-- @since 0.1
fromOsString :: OsString -> Either EncodingException OsPath
fromOsString :: OsString -> Either EncodingException OsString
fromOsString OsString
s =
  if OsString -> Bool
OsP.isValid OsString
s
    then OsString -> Either EncodingException OsString
forall a b. b -> Either a b
Right OsString
s
    else EncodingException -> Either EncodingException OsString
forall a b. a -> Either a b
Left (String -> Maybe Word8 -> EncodingException
EncodingError (OsString -> String
validOsStrErr OsString
s) Maybe Word8
forall a. Maybe a
Nothing)

-- | 'fromOsString' that throws the 'EncodingException'.
--
-- @since 0.1
fromOsStringThrowM :: (HasCallStack, MonadThrow m) => OsString -> m OsPath
fromOsStringThrowM :: forall (m :: * -> *).
(HasCallStack, MonadThrow m) =>
OsString -> m OsString
fromOsStringThrowM =
  OsString -> Either EncodingException OsString
fromOsString (OsString -> Either EncodingException OsString)
-> (Either EncodingException OsString -> m OsString)
-> OsString
-> m OsString
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Left EncodingException
ex -> EncodingException -> m OsString
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM EncodingException
ex
    Right OsString
p -> OsString -> m OsString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
p

-- | 'fromOsString' for 'MonadFail'.
--
-- @since 0.1
fromOsStringFail :: (HasCallStack, MonadFail m) => OsString -> m OsPath
fromOsStringFail :: forall (m :: * -> *).
(HasCallStack, MonadFail m) =>
OsString -> m OsString
fromOsStringFail OsString
s = case OsString -> Either EncodingException OsString
fromOsString OsString
s of
  Left EncodingException
ex -> String -> m OsString
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m OsString) -> String -> m OsString
forall a b. (a -> b) -> a -> b
$ EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex
  Right OsString
p -> OsString -> m OsString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
p

-- | Unsafely checks an 'OsString' for validity, dying with 'error' on
-- failure.
--
-- @since 0.1
unsafeFromOsString :: (HasCallStack) => OsString -> OsPath
unsafeFromOsString :: HasCallStack => OsString -> OsString
unsafeFromOsString OsString
s = case OsString -> Either EncodingException OsString
fromOsString OsString
s of
  Left EncodingException
ex -> String -> OsString
forall a. HasCallStack => String -> a
error (String -> OsString) -> String -> OsString
forall a b. (a -> b) -> a -> b
$ EncodingException -> String
forall e. Exception e => e -> String
displayException EncodingException
ex
  Right OsString
p -> OsString
p

-- | "Converts" from 'OsString' to 'OsPath' without checking any invariants.
-- Used for when we know an operator cannot have
--
-- @since 0.1
reallyUnsafeFromOsString :: OsString -> OsPath
reallyUnsafeFromOsString :: OsString -> OsString
reallyUnsafeFromOsString = OsString -> OsString
forall a. a -> a
id