{-# 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
#ifdef WINDOWS
import qualified System.OsPath.Windows as PF
import System.IO
    ( TextEncoding, utf16le )
import GHC.IO.Encoding.UTF16 ( mkUTF16le )
import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16
import qualified System.OsPath.Data.ByteString.Short as BS8
#else
import qualified System.OsPath.Posix as PF
import System.OsPath.Encoding
import System.IO
    ( TextEncoding )
import GHC.IO.Encoding.UTF8 ( mkUTF8 )
import Control.Monad (when)
#endif



-- | Partial unicode friendly encoding.
--
-- On windows this encodes as UTF16-LE (strictly), which is a pretty good guess.
-- On unix this encodes as UTF8 (strictly), which is a good guess.
--
-- Throws a 'EncodingException' if encoding fails.
encodeUtf :: MonadThrow m => FilePath -> m OsPath
encodeUtf :: FilePath -> m OsPath
encodeUtf = FilePath -> m OsPath
forall (m :: * -> *). MonadThrow m => FilePath -> m OsPath
OS.encodeUtf

-- | Encode a 'FilePath' with the specified encoding.
encodeWith :: TextEncoding  -- ^ unix text encoding
           -> TextEncoding  -- ^ windows text encoding
           -> FilePath
           -> Either EncodingException OsPath
encodeWith :: TextEncoding
-> TextEncoding -> FilePath -> Either EncodingException OsPath
encodeWith = TextEncoding
-> TextEncoding -> FilePath -> Either EncodingException OsPath
OS.encodeWith

-- | Like 'encodeUtf', except this mimics the behavior of the base library when doing filesystem
-- operations, which is:
--
-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,
--    but PEP 383 only works properly on UTF-8 encodings, so good luck)
-- 2. on windows does permissive UTF-16 encoding, where coding errors generate
--    Chars in the surrogate range
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
-- to deeply evaluate the result to catch exceptions).
encodeFS :: FilePath -> IO OsPath
encodeFS :: FilePath -> IO OsPath
encodeFS = FilePath -> IO OsPath
OS.encodeFS


-- | Partial unicode friendly decoding.
--
-- On windows this decodes as UTF16-LE (strictly), which is a pretty good guess.
-- On unix this decodes as UTF8 (strictly), which is a good guess.
--
-- Throws a 'EncodingException' if decoding fails.
decodeUtf :: MonadThrow m => OsPath -> m FilePath
decodeUtf :: OsPath -> m FilePath
decodeUtf = OsPath -> m FilePath
forall (m :: * -> *). MonadThrow m => OsPath -> m FilePath
OS.decodeUtf

-- | Decode an 'OsPath' with the specified encoding.
decodeWith :: TextEncoding  -- ^ unix text encoding
           -> TextEncoding  -- ^ windows text encoding
           -> OsPath
           -> Either EncodingException FilePath
decodeWith :: TextEncoding
-> TextEncoding -> OsPath -> Either EncodingException FilePath
decodeWith = TextEncoding
-> TextEncoding -> OsPath -> Either EncodingException FilePath
OS.decodeWith

-- | Like 'decodeUtf', except this mimics the behavior of the base library when doing filesystem
-- operations, which is:
--
-- 1. on unix, uses shady PEP 383 style encoding (based on the current locale,
--    but PEP 383 only works properly on UTF-8 encodings, so good luck)
-- 2. on windows does permissive UTF-16 encoding, where coding errors generate
--    Chars in the surrogate range
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
-- to deeply evaluate the result to catch exceptions).
decodeFS :: OsPath -> IO FilePath
decodeFS :: OsPath -> IO FilePath
decodeFS = OsPath -> IO FilePath
OS.decodeFS


-- | Constructs an @OsPath@ from a ByteString.
--
-- On windows, this ensures valid UCS-2LE, on unix it is passed unchanged/unchecked.
--
-- Throws 'EncodingException' on invalid UCS-2LE on windows (although unlikely).
fromBytes :: MonadThrow m
          => ByteString
          -> m OsPath
fromBytes :: ByteString -> m OsPath
fromBytes = ByteString -> m OsPath
forall (m :: * -> *). MonadThrow m => ByteString -> m OsPath
OS.fromBytes



-- | QuasiQuote an 'OsPath'. This accepts Unicode characters
-- and encodes as UTF-8 on unix and UTF-16LE on windows. Runs 'isValid'
-- on the input.
osp :: QuasiQuoter
osp :: QuasiQuoter
osp = QuasiQuoter :: (FilePath -> Q Exp)
-> (FilePath -> Q Pat)
-> (FilePath -> Q Type)
-> (FilePath -> Q [Dec])
-> QuasiQuoter
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 now 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
      OsPath
osp' <- (EncodingException -> Q OsPath)
-> (PlatformString -> Q OsPath)
-> Either EncodingException PlatformString
-> Q OsPath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Q OsPath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Q OsPath)
-> (EncodingException -> FilePath) -> EncodingException -> Q OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> FilePath
forall a. Show a => a -> FilePath
show) (OsPath -> Q OsPath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OsPath -> Q OsPath)
-> (PlatformString -> OsPath) -> PlatformString -> Q OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformString -> OsPath
OsString) (Either EncodingException PlatformString -> Q OsPath)
-> (FilePath -> Either EncodingException PlatformString)
-> FilePath
-> Q OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> FilePath -> Either EncodingException PlatformString
PF.encodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
ErrorOnCodingFailure) (FilePath -> Q OsPath) -> FilePath -> Q OsPath
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
$ OsPath -> Bool
isValid OsPath
osp') (Q () -> Q ()) -> Q () -> Q ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Q ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"filepath now valid: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> OsPath -> FilePath
forall a. Show a => a -> FilePath
show OsPath
osp')
      OsPath -> Q Exp
forall t. Lift t => t -> Q Exp
lift OsPath
osp'
  , quotePat :: FilePath -> Q Pat
quotePat  = \FilePath
_ ->
      FilePath -> Q Pat
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 (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 (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"illegal QuasiQuote (allowed as expression only, used as a declaration)"
  }
#endif


-- | Unpack an 'OsPath' to a list of 'OsChar'.
unpack :: OsPath -> [OsChar]
unpack :: OsPath -> [OsChar]
unpack = OsPath -> [OsChar]
OS.unpack


-- | Pack a list of 'OsChar' to an 'OsPath'.
--
-- Note that using this in conjunction with 'unsafeFromChar' to
-- convert from @[Char]@ to 'OsPath' is probably not what
-- you want, because it will truncate unicode code points.
pack :: [OsChar] -> OsPath
pack :: [OsChar] -> OsPath
pack = [OsChar] -> OsPath
OS.pack