{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnliftedFFITypes #-}
module System.OsPath.Internal where
import {-# SOURCE #-} System.OsPath
( isValid )
import System.OsPath.Types
import qualified System.OsString.Internal as OS
import Control.Monad.Catch
( MonadThrow )
import Data.ByteString
( ByteString )
import Language.Haskell.TH.Quote
( QuasiQuoter (..) )
import Language.Haskell.TH.Syntax
( Lift (..), lift )
import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
import System.OsString.Internal.Types
import System.OsPath.Encoding
import Control.Monad (when)
import System.IO
( TextEncoding )
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
import qualified System.OsPath.Windows as PF
import GHC.IO.Encoding.UTF16 ( mkUTF16le )
#else
import qualified System.OsPath.Posix as PF
import GHC.IO.Encoding.UTF8 ( mkUTF8 )
#endif
encodeUtf :: MonadThrow m => FilePath -> m OsPath
encodeUtf :: forall (m :: * -> *). MonadThrow m => FilePath -> m OsString
encodeUtf = FilePath -> m OsString
forall (m :: * -> *). MonadThrow m => FilePath -> m OsString
OS.encodeUtf
encodeWith :: TextEncoding
-> TextEncoding
-> FilePath
-> Either EncodingException OsPath
encodeWith :: TextEncoding
-> TextEncoding -> FilePath -> Either EncodingException OsString
encodeWith = TextEncoding
-> TextEncoding -> FilePath -> Either EncodingException OsString
OS.encodeWith
encodeFS :: FilePath -> IO OsPath
encodeFS :: FilePath -> IO OsString
encodeFS = FilePath -> IO OsString
OS.encodeFS
decodeUtf :: MonadThrow m => OsPath -> m FilePath
decodeUtf :: forall (m :: * -> *). MonadThrow m => OsString -> m FilePath
decodeUtf = OsString -> m FilePath
forall (m :: * -> *). MonadThrow m => OsString -> m FilePath
OS.decodeUtf
decodeWith :: TextEncoding
-> TextEncoding
-> OsPath
-> Either EncodingException FilePath
decodeWith :: TextEncoding
-> TextEncoding -> OsString -> Either EncodingException FilePath
decodeWith = TextEncoding
-> TextEncoding -> OsString -> Either EncodingException FilePath
OS.decodeWith
decodeFS :: OsPath -> IO FilePath
decodeFS :: OsString -> IO FilePath
decodeFS = OsString -> IO FilePath
OS.decodeFS
fromBytes :: MonadThrow m
=> ByteString
-> m OsPath
fromBytes :: forall (m :: * -> *). MonadThrow m => ByteString -> m OsString
fromBytes = ByteString -> m OsString
forall (m :: * -> *). MonadThrow m => ByteString -> m OsString
OS.fromBytes
osp :: QuasiQuoter
osp :: QuasiQuoter
osp = QuasiQuoter
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
{ quoteExp = \s -> do
osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s
when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')
lift osp'
, quotePat = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
, quoteType = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a type)"
, quoteDec = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
}
#else
{ quoteExp :: FilePath -> Q Exp
quoteExp = \FilePath
s -> do
OsString
osp' <- (EncodingException -> Q OsString)
-> (PlatformString -> Q OsString)
-> Either EncodingException PlatformString
-> Q OsString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Q OsString
forall a. FilePath -> Q a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Q OsString)
-> (EncodingException -> FilePath)
-> EncodingException
-> Q OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> FilePath
forall a. Show a => a -> FilePath
show) (OsString -> Q OsString
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OsString -> Q OsString)
-> (PlatformString -> OsString) -> PlatformString -> Q OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformString -> OsString
OsString) (Either EncodingException PlatformString -> Q OsString)
-> (FilePath -> Either EncodingException PlatformString)
-> FilePath
-> Q OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> FilePath -> Either EncodingException PlatformString
PF.encodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
ErrorOnCodingFailure) (FilePath -> Q OsString) -> FilePath -> Q OsString
forall a b. (a -> b) -> a -> b
$ FilePath
s
Bool -> Q () -> Q ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ OsString -> Bool
isValid OsString
osp') (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Q ()
forall a. FilePath -> Q a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"filepath not valid: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ OsString -> FilePath
forall a. Show a => a -> FilePath
show OsString
osp')
OsString -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => OsString -> m Exp
lift OsString
osp'
, quotePat :: FilePath -> Q Pat
quotePat = \FilePath
_ ->
FilePath -> Q Pat
forall a. FilePath -> Q a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"illegal QuasiQuote (allowed as expression only, used as a pattern)"
, quoteType :: FilePath -> Q Type
quoteType = \FilePath
_ ->
FilePath -> Q Type
forall a. FilePath -> Q a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"illegal QuasiQuote (allowed as expression only, used as a type)"
, quoteDec :: FilePath -> Q [Dec]
quoteDec = \FilePath
_ ->
FilePath -> Q [Dec]
forall a. FilePath -> Q a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"illegal QuasiQuote (allowed as expression only, used as a declaration)"
}
#endif
unpack :: OsPath -> [OsChar]
unpack :: OsString -> [OsChar]
unpack = OsString -> [OsChar]
OS.unpack
pack :: [OsChar] -> OsPath
pack :: [OsChar] -> OsString
pack = [OsChar] -> OsString
OS.pack