{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnliftedFFITypes #-}

module System.OsString.Internal where

import System.OsString.Internal.Types

import Control.Monad.Catch
    ( MonadThrow )
import Data.ByteString
    ( ByteString )
import Data.ByteString.Short
    ( fromShort )
import System.AbstractFilePath.Data.ByteString.Short.Encode
import Data.Char
import Language.Haskell.TH
import Language.Haskell.TH.Quote
    ( QuasiQuoter (..) )
import Language.Haskell.TH.Syntax
    ( Lift (..), lift )
import System.IO
    ( TextEncoding )
#ifndef WINDOWS
import System.AbstractFilePath.Data.ByteString.Short.Decode
    (
      UnicodeException (..)
    )
#endif

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
import System.AbstractFilePath.Data.ByteString.Short.Decode
    ( decodeUtf16LE' )
import System.OsString.Windows
import qualified System.OsString.Windows as PF
#else
import System.OsString.Posix
import qualified System.OsString.Posix as PF
#endif




-- | Total Unicode-friendly encoding.
--
-- On windows this encodes as UTF16, which is expected.
-- On unix this encodes as UTF8, which is a good guess.
toOsString :: String -> OsString
toOsString :: String -> OsString
toOsString = PlatformString -> OsString
OsString (PlatformString -> OsString)
-> (String -> PlatformString) -> String -> OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PlatformString
toPlatformString

-- | Like 'toOsString', except on unix this uses the current
-- locale for encoding instead of always UTF8.
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
toOsStringIO :: String -> IO OsString
toOsStringIO :: String -> IO OsString
toOsStringIO = (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlatformString -> OsString
OsString (IO PlatformString -> IO OsString)
-> (String -> IO PlatformString) -> String -> IO OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO PlatformString
toPlatformStringIO


-- | Partial unicode friendly decoding.
--
-- On windows this decodes as UTF16 (which is the expected filename encoding).
-- On unix this decodes as UTF8 (which is a good guess). Note that
-- filenames on unix are encoding agnostic char arrays.
--
-- Throws a 'UnicodeException' if decoding fails.
fromOsString :: MonadThrow m => OsString -> m String
fromOsString :: OsString -> m String
fromOsString (OsString PlatformString
x) = PlatformString -> m String
forall (m :: * -> *). MonadThrow m => PlatformString -> m String
fromPlatformString PlatformString
x

-- | Like 'fromOsString', except on unix this uses the provided
-- 'TextEncoding' for decoding.
--
-- On windows, the TextEncoding parameter is ignored.
fromOsStringEnc :: OsString -> TextEncoding -> Either UnicodeException String
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
fromOsStringEnc (OsString (WS ba)) _ = decodeUtf16LE' ba
#else
fromOsStringEnc :: OsString -> TextEncoding -> Either UnicodeException String
fromOsStringEnc (OsString PlatformString
x) = PlatformString -> TextEncoding -> Either UnicodeException String
fromPlatformStringEnc PlatformString
x
#endif


-- | Like 'fromOsString', except on unix this uses the current
-- locale for decoding instead of always UTF8.
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible.
--
-- Throws 'UnicodeException' if decoding fails.
fromOsStringIO :: OsString -> IO String
fromOsStringIO :: OsString -> IO String
fromOsStringIO (OsString PlatformString
x) = PlatformString -> IO String
fromPlatformStringIO PlatformString
x


-- | Constructs an @OsString@ from a ByteString.
--
-- On windows, this ensures valid UTF16, on unix it is passed unchanged/unchecked.
--
-- Throws 'UnicodeException' on invalid UTF16 on windows.
bsToOsString :: MonadThrow m
             => ByteString
             -> m OsString
bsToOsString :: ByteString -> m OsString
bsToOsString = (PlatformString -> OsString) -> m PlatformString -> m OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlatformString -> OsString
OsString (m PlatformString -> m OsString)
-> (ByteString -> m PlatformString) -> ByteString -> m OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m PlatformString
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m PlatformString
bsToPlatformString


qq :: (ByteString -> Q Exp) -> QuasiQuoter
qq :: (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
quoteExp' =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
  { quoteExp  = (\s -> quoteExp' . fromShort . encodeUtf16LE $ s)
  , 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 :: String -> Q Exp
quoteExp  = (\String
s -> ByteString -> Q Exp
quoteExp' (ByteString -> Q Exp) -> (String -> ByteString) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (String -> ShortByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortByteString
encodeUtf8 (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
s)
  , quotePat :: String -> Q Pat
quotePat  = \String
_ ->
      String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a pattern)"
  , quoteType :: String -> Q Type
quoteType = \String
_ ->
      String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a type)"
  , quoteDec :: String -> Q [Dec]
quoteDec  = \String
_ ->
      String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a declaration)"
  }
#endif

mkOsString :: ByteString -> Q Exp
mkOsString :: ByteString -> Q Exp
mkOsString ByteString
bs = 
  case ByteString -> Maybe OsString
forall (m :: * -> *). MonadThrow m => ByteString -> m OsString
bsToOsString ByteString
bs of
    Just OsString
afp -> OsString -> Q Exp
forall t. Lift t => t -> Q Exp
lift OsString
afp
    Maybe OsString
Nothing -> String -> Q Exp
forall a. HasCallStack => String -> a
error String
"invalid encoding"

-- | QuasiQuote an 'OsString'. This accepts Unicode characters
-- and encodes as UTF-8 on unix and UTF-16 on windows.
osstr :: QuasiQuoter
osstr :: QuasiQuoter
osstr = (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
mkOsString


unpackOsString :: OsString -> [OsChar]
unpackOsString :: OsString -> [OsChar]
unpackOsString (OsString PlatformString
x) = (PlatformChar -> OsChar) -> [PlatformChar] -> [OsChar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PlatformChar -> OsChar
OsChar ([PlatformChar] -> [OsChar]) -> [PlatformChar] -> [OsChar]
forall a b. (a -> b) -> a -> b
$ PlatformString -> [PlatformChar]
unpackPlatformString PlatformString
x


packOsString :: [OsChar] -> OsString
packOsString :: [OsChar] -> OsString
packOsString = PlatformString -> OsString
OsString (PlatformString -> OsString)
-> ([OsChar] -> PlatformString) -> [OsChar] -> OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PlatformChar] -> PlatformString
packPlatformString ([PlatformChar] -> PlatformString)
-> ([OsChar] -> [PlatformChar]) -> [OsChar] -> PlatformString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OsChar -> PlatformChar) -> [OsChar] -> [PlatformChar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(OsChar PlatformChar
x) -> PlatformChar
x)


-- | Truncates on unix to 1 and on Windows to 2 octets.
unsafeFromChar :: Char -> OsChar
unsafeFromChar :: Char -> OsChar
unsafeFromChar = PlatformChar -> OsChar
OsChar (PlatformChar -> OsChar)
-> (Char -> PlatformChar) -> Char -> OsChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> PlatformChar
PF.unsafeFromChar

-- | Converts back to a unicode codepoint (total).
toChar :: OsChar -> Char
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
toChar (OsChar (WW w)) = chr $ fromIntegral w
#else
toChar :: OsChar -> Char
toChar (OsChar (PW Word8
w)) = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
#endif