module GHC.Data.OsPath
(
OsPath
, OsString
, encodeUtf
, decodeUtf
, unsafeDecodeUtf
, unsafeEncodeUtf
, os
, (</>)
, (<.>)
)
where
import GHC.Prelude
import GHC.Utils.Misc (HasCallStack)
import GHC.Utils.Panic (panic)
import System.OsPath
import System.Directory.Internal (os)
unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath
unsafeDecodeUtf OsPath
p =
(SomeException -> FilePath)
-> (FilePath -> FilePath)
-> Either SomeException FilePath
-> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\SomeException
err -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
panic (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to decodeUtf \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ OsPath -> FilePath
forall a. Show a => a -> FilePath
show OsPath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\", because: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
err) FilePath -> FilePath
forall a. a -> a
id (OsPath -> Either SomeException FilePath
forall (m :: * -> *). MonadThrow m => OsPath -> m FilePath
decodeUtf OsPath
p)