{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

module System.OsString.Internal.Types
  (
    WindowsString(..)
  , PosixString(..)
  , PlatformString
  , WindowsChar(..)
  , PosixChar(..)
  , PlatformChar
  , OsString(..)
  , OsChar(..)
  )
where


import Control.DeepSeq
import Data.Data
import Data.Word
import GHC.Exts
    ( IsString (..) )
import Language.Haskell.TH.Syntax
    ( Lift (..), lift )
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
import GHC.Generics (Generic)

import qualified Data.ByteString.Short as BS
#if MIN_VERSION_template_haskell(2,16,0)
import qualified Language.Haskell.TH.Syntax as TH
#endif
import System.AbstractFilePath.Encoding ( encodeWith, decodeWith )
import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
import GHC.IO.Encoding.UTF16 ( mkUTF16le )
import GHC.IO.Encoding.UTF8 ( mkUTF8 )

-- Using unpinned bytearrays to avoid Heap fragmentation and
-- which are reasonably cheap to pass to FFI calls
-- wrapped with typeclass-friendly types allowing to avoid CPP
-- 
-- Note that, while unpinned bytearrays incur a memcpy on each
-- FFI call, this overhead is generally much preferable to
-- the memory fragmentation of pinned bytearrays

-- | Commonly used windows string as UTF16 bytes.
newtype WindowsString = WS { WindowsString -> ShortByteString
unWFP :: BS.ShortByteString }
  deriving (WindowsString -> WindowsString -> Bool
(WindowsString -> WindowsString -> Bool)
-> (WindowsString -> WindowsString -> Bool) -> Eq WindowsString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowsString -> WindowsString -> Bool
$c/= :: WindowsString -> WindowsString -> Bool
== :: WindowsString -> WindowsString -> Bool
$c== :: WindowsString -> WindowsString -> Bool
Eq, Eq WindowsString
Eq WindowsString
-> (WindowsString -> WindowsString -> Ordering)
-> (WindowsString -> WindowsString -> Bool)
-> (WindowsString -> WindowsString -> Bool)
-> (WindowsString -> WindowsString -> Bool)
-> (WindowsString -> WindowsString -> Bool)
-> (WindowsString -> WindowsString -> WindowsString)
-> (WindowsString -> WindowsString -> WindowsString)
-> Ord WindowsString
WindowsString -> WindowsString -> Bool
WindowsString -> WindowsString -> Ordering
WindowsString -> WindowsString -> WindowsString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WindowsString -> WindowsString -> WindowsString
$cmin :: WindowsString -> WindowsString -> WindowsString
max :: WindowsString -> WindowsString -> WindowsString
$cmax :: WindowsString -> WindowsString -> WindowsString
>= :: WindowsString -> WindowsString -> Bool
$c>= :: WindowsString -> WindowsString -> Bool
> :: WindowsString -> WindowsString -> Bool
$c> :: WindowsString -> WindowsString -> Bool
<= :: WindowsString -> WindowsString -> Bool
$c<= :: WindowsString -> WindowsString -> Bool
< :: WindowsString -> WindowsString -> Bool
$c< :: WindowsString -> WindowsString -> Bool
compare :: WindowsString -> WindowsString -> Ordering
$ccompare :: WindowsString -> WindowsString -> Ordering
$cp1Ord :: Eq WindowsString
Ord, b -> WindowsString -> WindowsString
NonEmpty WindowsString -> WindowsString
WindowsString -> WindowsString -> WindowsString
(WindowsString -> WindowsString -> WindowsString)
-> (NonEmpty WindowsString -> WindowsString)
-> (forall b. Integral b => b -> WindowsString -> WindowsString)
-> Semigroup WindowsString
forall b. Integral b => b -> WindowsString -> WindowsString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> WindowsString -> WindowsString
$cstimes :: forall b. Integral b => b -> WindowsString -> WindowsString
sconcat :: NonEmpty WindowsString -> WindowsString
$csconcat :: NonEmpty WindowsString -> WindowsString
<> :: WindowsString -> WindowsString -> WindowsString
$c<> :: WindowsString -> WindowsString -> WindowsString
Semigroup, Semigroup WindowsString
WindowsString
Semigroup WindowsString
-> WindowsString
-> (WindowsString -> WindowsString -> WindowsString)
-> ([WindowsString] -> WindowsString)
-> Monoid WindowsString
[WindowsString] -> WindowsString
WindowsString -> WindowsString -> WindowsString
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [WindowsString] -> WindowsString
$cmconcat :: [WindowsString] -> WindowsString
mappend :: WindowsString -> WindowsString -> WindowsString
$cmappend :: WindowsString -> WindowsString -> WindowsString
mempty :: WindowsString
$cmempty :: WindowsString
$cp1Monoid :: Semigroup WindowsString
Monoid, Typeable, (forall x. WindowsString -> Rep WindowsString x)
-> (forall x. Rep WindowsString x -> WindowsString)
-> Generic WindowsString
forall x. Rep WindowsString x -> WindowsString
forall x. WindowsString -> Rep WindowsString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowsString x -> WindowsString
$cfrom :: forall x. WindowsString -> Rep WindowsString x
Generic, WindowsString -> ()
(WindowsString -> ()) -> NFData WindowsString
forall a. (a -> ()) -> NFData a
rnf :: WindowsString -> ()
$crnf :: WindowsString -> ()
NFData)

instance Lift WindowsString where
  lift :: WindowsString -> Q Exp
lift (WS ShortByteString
bs)
    = [| WS (BS.pack $(lift $ BS.unpack bs)) :: WindowsString |]
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: WindowsString -> Q (TExp WindowsString)
liftTyped = Q Exp -> Q (TExp WindowsString)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp WindowsString))
-> (WindowsString -> Q Exp)
-> WindowsString
-> Q (TExp WindowsString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowsString -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Commonly used Posix string as uninterpreted @char[]@
-- array.
newtype PosixString   = PS { PosixString -> ShortByteString
unPFP :: BS.ShortByteString }
  deriving (PosixString -> PosixString -> Bool
(PosixString -> PosixString -> Bool)
-> (PosixString -> PosixString -> Bool) -> Eq PosixString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PosixString -> PosixString -> Bool
$c/= :: PosixString -> PosixString -> Bool
== :: PosixString -> PosixString -> Bool
$c== :: PosixString -> PosixString -> Bool
Eq, Eq PosixString
Eq PosixString
-> (PosixString -> PosixString -> Ordering)
-> (PosixString -> PosixString -> Bool)
-> (PosixString -> PosixString -> Bool)
-> (PosixString -> PosixString -> Bool)
-> (PosixString -> PosixString -> Bool)
-> (PosixString -> PosixString -> PosixString)
-> (PosixString -> PosixString -> PosixString)
-> Ord PosixString
PosixString -> PosixString -> Bool
PosixString -> PosixString -> Ordering
PosixString -> PosixString -> PosixString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PosixString -> PosixString -> PosixString
$cmin :: PosixString -> PosixString -> PosixString
max :: PosixString -> PosixString -> PosixString
$cmax :: PosixString -> PosixString -> PosixString
>= :: PosixString -> PosixString -> Bool
$c>= :: PosixString -> PosixString -> Bool
> :: PosixString -> PosixString -> Bool
$c> :: PosixString -> PosixString -> Bool
<= :: PosixString -> PosixString -> Bool
$c<= :: PosixString -> PosixString -> Bool
< :: PosixString -> PosixString -> Bool
$c< :: PosixString -> PosixString -> Bool
compare :: PosixString -> PosixString -> Ordering
$ccompare :: PosixString -> PosixString -> Ordering
$cp1Ord :: Eq PosixString
Ord, b -> PosixString -> PosixString
NonEmpty PosixString -> PosixString
PosixString -> PosixString -> PosixString
(PosixString -> PosixString -> PosixString)
-> (NonEmpty PosixString -> PosixString)
-> (forall b. Integral b => b -> PosixString -> PosixString)
-> Semigroup PosixString
forall b. Integral b => b -> PosixString -> PosixString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PosixString -> PosixString
$cstimes :: forall b. Integral b => b -> PosixString -> PosixString
sconcat :: NonEmpty PosixString -> PosixString
$csconcat :: NonEmpty PosixString -> PosixString
<> :: PosixString -> PosixString -> PosixString
$c<> :: PosixString -> PosixString -> PosixString
Semigroup, Semigroup PosixString
PosixString
Semigroup PosixString
-> PosixString
-> (PosixString -> PosixString -> PosixString)
-> ([PosixString] -> PosixString)
-> Monoid PosixString
[PosixString] -> PosixString
PosixString -> PosixString -> PosixString
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PosixString] -> PosixString
$cmconcat :: [PosixString] -> PosixString
mappend :: PosixString -> PosixString -> PosixString
$cmappend :: PosixString -> PosixString -> PosixString
mempty :: PosixString
$cmempty :: PosixString
$cp1Monoid :: Semigroup PosixString
Monoid, Typeable, (forall x. PosixString -> Rep PosixString x)
-> (forall x. Rep PosixString x -> PosixString)
-> Generic PosixString
forall x. Rep PosixString x -> PosixString
forall x. PosixString -> Rep PosixString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PosixString x -> PosixString
$cfrom :: forall x. PosixString -> Rep PosixString x
Generic, PosixString -> ()
(PosixString -> ()) -> NFData PosixString
forall a. (a -> ()) -> NFData a
rnf :: PosixString -> ()
$crnf :: PosixString -> ()
NFData)

instance Lift PosixString where
  lift :: PosixString -> Q Exp
lift (PS ShortByteString
bs)
    = [| PS (BS.pack $(lift $ BS.unpack bs)) :: PosixString |]
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: PosixString -> Q (TExp PosixString)
liftTyped = Q Exp -> Q (TExp PosixString)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp PosixString))
-> (PosixString -> Q Exp) -> PosixString -> Q (TExp PosixString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixString -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Decodes as UTF-16LE.
instance Show WindowsString where
  show :: WindowsString -> String
show (WS ShortByteString
bs) = (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
: (EncodingException -> String)
-> ShowS -> Either EncodingException String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ShowS
forall a. HasCallStack => String -> a
error ShowS
-> (EncodingException -> String) -> EncodingException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShowS
forall a. a -> a
id (TextEncoding -> ShortByteString -> Either EncodingException String
decodeWith (CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
TransliterateCodingFailure) ShortByteString
bs)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""

-- | Encodes as UTF-16LE.
instance Read WindowsString where
  readsPrec :: Int -> ReadS WindowsString
readsPrec Int
p String
str = [ (ShortByteString -> WindowsString
WS (ShortByteString -> WindowsString)
-> ShortByteString -> WindowsString
forall a b. (a -> b) -> a -> b
$ (EncodingException -> ShortByteString)
-> (ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString
-> ShortByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ShortByteString
forall a. HasCallStack => String -> a
error (String -> ShortByteString)
-> (EncodingException -> String)
-> EncodingException
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShortByteString -> ShortByteString
forall a. a -> a
id (Either EncodingException ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ TextEncoding -> String -> Either EncodingException ShortByteString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
TransliterateCodingFailure) String
x, String
y) | (String
x, String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]

-- | Decodes as UTF-8 and replaces invalid chars with unicode replacement
-- char U+FFFD.
instance Show PosixString where
  show :: PosixString -> String
show (PS ShortByteString
bs) = (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
: (EncodingException -> String)
-> ShowS -> Either EncodingException String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ShowS
forall a. HasCallStack => String -> a
error ShowS
-> (EncodingException -> String) -> EncodingException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShowS
forall a. a -> a
id (TextEncoding -> ShortByteString -> Either EncodingException String
decodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure) ShortByteString
bs)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""

-- | Encodes as UTF-8.
instance Read PosixString where
  readsPrec :: Int -> ReadS PosixString
readsPrec Int
p String
str = [ (ShortByteString -> PosixString
PS (ShortByteString -> PosixString) -> ShortByteString -> PosixString
forall a b. (a -> b) -> a -> b
$ (EncodingException -> ShortByteString)
-> (ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString
-> ShortByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ShortByteString
forall a. HasCallStack => String -> a
error (String -> ShortByteString)
-> (EncodingException -> String)
-> EncodingException
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShortByteString -> ShortByteString
forall a. a -> a
id (Either EncodingException ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ TextEncoding -> String -> Either EncodingException ShortByteString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure) String
x, String
y) | (String
x, String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]

instance IsString WindowsString where
    fromString :: String -> WindowsString
fromString = ShortByteString -> WindowsString
WS (ShortByteString -> WindowsString)
-> (String -> ShortByteString) -> String -> WindowsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncodingException -> ShortByteString)
-> (ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString
-> ShortByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ShortByteString
forall a. HasCallStack => String -> a
error (String -> ShortByteString)
-> (EncodingException -> String)
-> EncodingException
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShortByteString -> ShortByteString
forall a. a -> a
id (Either EncodingException ShortByteString -> ShortByteString)
-> (String -> Either EncodingException ShortByteString)
-> String
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> String -> Either EncodingException ShortByteString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
TransliterateCodingFailure)

instance IsString PosixString where
    fromString :: String -> PosixString
fromString = ShortByteString -> PosixString
PS (ShortByteString -> PosixString)
-> (String -> ShortByteString) -> String -> PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncodingException -> ShortByteString)
-> (ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString
-> ShortByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ShortByteString
forall a. HasCallStack => String -> a
error (String -> ShortByteString)
-> (EncodingException -> String)
-> EncodingException
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShortByteString -> ShortByteString
forall a. a -> a
id (Either EncodingException ShortByteString -> ShortByteString)
-> (String -> Either EncodingException ShortByteString)
-> String
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> String -> Either EncodingException ShortByteString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure)

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
type PlatformString = WindowsString
#else
type PlatformString = PosixString
#endif

newtype WindowsChar = WW { WindowsChar -> Word16
unWW :: Word16 }
  deriving (WindowsChar -> WindowsChar -> Bool
(WindowsChar -> WindowsChar -> Bool)
-> (WindowsChar -> WindowsChar -> Bool) -> Eq WindowsChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowsChar -> WindowsChar -> Bool
$c/= :: WindowsChar -> WindowsChar -> Bool
== :: WindowsChar -> WindowsChar -> Bool
$c== :: WindowsChar -> WindowsChar -> Bool
Eq, Eq WindowsChar
Eq WindowsChar
-> (WindowsChar -> WindowsChar -> Ordering)
-> (WindowsChar -> WindowsChar -> Bool)
-> (WindowsChar -> WindowsChar -> Bool)
-> (WindowsChar -> WindowsChar -> Bool)
-> (WindowsChar -> WindowsChar -> Bool)
-> (WindowsChar -> WindowsChar -> WindowsChar)
-> (WindowsChar -> WindowsChar -> WindowsChar)
-> Ord WindowsChar
WindowsChar -> WindowsChar -> Bool
WindowsChar -> WindowsChar -> Ordering
WindowsChar -> WindowsChar -> WindowsChar
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WindowsChar -> WindowsChar -> WindowsChar
$cmin :: WindowsChar -> WindowsChar -> WindowsChar
max :: WindowsChar -> WindowsChar -> WindowsChar
$cmax :: WindowsChar -> WindowsChar -> WindowsChar
>= :: WindowsChar -> WindowsChar -> Bool
$c>= :: WindowsChar -> WindowsChar -> Bool
> :: WindowsChar -> WindowsChar -> Bool
$c> :: WindowsChar -> WindowsChar -> Bool
<= :: WindowsChar -> WindowsChar -> Bool
$c<= :: WindowsChar -> WindowsChar -> Bool
< :: WindowsChar -> WindowsChar -> Bool
$c< :: WindowsChar -> WindowsChar -> Bool
compare :: WindowsChar -> WindowsChar -> Ordering
$ccompare :: WindowsChar -> WindowsChar -> Ordering
$cp1Ord :: Eq WindowsChar
Ord, Int -> WindowsChar -> ShowS
[WindowsChar] -> ShowS
WindowsChar -> String
(Int -> WindowsChar -> ShowS)
-> (WindowsChar -> String)
-> ([WindowsChar] -> ShowS)
-> Show WindowsChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowsChar] -> ShowS
$cshowList :: [WindowsChar] -> ShowS
show :: WindowsChar -> String
$cshow :: WindowsChar -> String
showsPrec :: Int -> WindowsChar -> ShowS
$cshowsPrec :: Int -> WindowsChar -> ShowS
Show, Typeable, (forall x. WindowsChar -> Rep WindowsChar x)
-> (forall x. Rep WindowsChar x -> WindowsChar)
-> Generic WindowsChar
forall x. Rep WindowsChar x -> WindowsChar
forall x. WindowsChar -> Rep WindowsChar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WindowsChar x -> WindowsChar
$cfrom :: forall x. WindowsChar -> Rep WindowsChar x
Generic, WindowsChar -> ()
(WindowsChar -> ()) -> NFData WindowsChar
forall a. (a -> ()) -> NFData a
rnf :: WindowsChar -> ()
$crnf :: WindowsChar -> ()
NFData)
newtype PosixChar   = PW { PosixChar -> Word8
unPW :: Word8 }
  deriving (PosixChar -> PosixChar -> Bool
(PosixChar -> PosixChar -> Bool)
-> (PosixChar -> PosixChar -> Bool) -> Eq PosixChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PosixChar -> PosixChar -> Bool
$c/= :: PosixChar -> PosixChar -> Bool
== :: PosixChar -> PosixChar -> Bool
$c== :: PosixChar -> PosixChar -> Bool
Eq, Eq PosixChar
Eq PosixChar
-> (PosixChar -> PosixChar -> Ordering)
-> (PosixChar -> PosixChar -> Bool)
-> (PosixChar -> PosixChar -> Bool)
-> (PosixChar -> PosixChar -> Bool)
-> (PosixChar -> PosixChar -> Bool)
-> (PosixChar -> PosixChar -> PosixChar)
-> (PosixChar -> PosixChar -> PosixChar)
-> Ord PosixChar
PosixChar -> PosixChar -> Bool
PosixChar -> PosixChar -> Ordering
PosixChar -> PosixChar -> PosixChar
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PosixChar -> PosixChar -> PosixChar
$cmin :: PosixChar -> PosixChar -> PosixChar
max :: PosixChar -> PosixChar -> PosixChar
$cmax :: PosixChar -> PosixChar -> PosixChar
>= :: PosixChar -> PosixChar -> Bool
$c>= :: PosixChar -> PosixChar -> Bool
> :: PosixChar -> PosixChar -> Bool
$c> :: PosixChar -> PosixChar -> Bool
<= :: PosixChar -> PosixChar -> Bool
$c<= :: PosixChar -> PosixChar -> Bool
< :: PosixChar -> PosixChar -> Bool
$c< :: PosixChar -> PosixChar -> Bool
compare :: PosixChar -> PosixChar -> Ordering
$ccompare :: PosixChar -> PosixChar -> Ordering
$cp1Ord :: Eq PosixChar
Ord, Int -> PosixChar -> ShowS
[PosixChar] -> ShowS
PosixChar -> String
(Int -> PosixChar -> ShowS)
-> (PosixChar -> String)
-> ([PosixChar] -> ShowS)
-> Show PosixChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PosixChar] -> ShowS
$cshowList :: [PosixChar] -> ShowS
show :: PosixChar -> String
$cshow :: PosixChar -> String
showsPrec :: Int -> PosixChar -> ShowS
$cshowsPrec :: Int -> PosixChar -> ShowS
Show, Typeable, (forall x. PosixChar -> Rep PosixChar x)
-> (forall x. Rep PosixChar x -> PosixChar) -> Generic PosixChar
forall x. Rep PosixChar x -> PosixChar
forall x. PosixChar -> Rep PosixChar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PosixChar x -> PosixChar
$cfrom :: forall x. PosixChar -> Rep PosixChar x
Generic, PosixChar -> ()
(PosixChar -> ()) -> NFData PosixChar
forall a. (a -> ()) -> NFData a
rnf :: PosixChar -> ()
$crnf :: PosixChar -> ()
NFData)

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
type PlatformChar = WindowsChar
#else
type PlatformChar = PosixChar
#endif


-- | Newtype representing short operating system specific strings.
--
-- Internally this is either 'WindowsString' or 'PosixString',
-- depending on the platform. Both use unpinned
-- 'ShortByteString' for efficiency.
--
-- The constructor is only exported via "System.OsString.Internal.Types", since
-- dealing with the internals isn't generally recommended, but supported
-- in case you need to write platform specific code.
newtype OsString = OsString PlatformString
  deriving (Typeable, (forall x. OsString -> Rep OsString x)
-> (forall x. Rep OsString x -> OsString) -> Generic OsString
forall x. Rep OsString x -> OsString
forall x. OsString -> Rep OsString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OsString x -> OsString
$cfrom :: forall x. OsString -> Rep OsString x
Generic, OsString -> ()
(OsString -> ()) -> NFData OsString
forall a. (a -> ()) -> NFData a
rnf :: OsString -> ()
$crnf :: OsString -> ()
NFData)

-- | Byte equality of the internal representation.
instance Eq OsString where
  (OsString PosixString
a) == :: OsString -> OsString -> Bool
== (OsString PosixString
b) = PosixString
a PosixString -> PosixString -> Bool
forall a. Eq a => a -> a -> Bool
== PosixString
b

-- | Byte ordering of the internal representation.
instance Ord OsString where
  compare :: OsString -> OsString -> Ordering
compare (OsString PosixString
a) (OsString PosixString
b) = PosixString -> PosixString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PosixString
a PosixString
b

-- | Encodes as UTF16 on windows and UTF8 on unix.
instance IsString OsString where 
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    fromString = OsString . WS . either (error . show) id . encodeWith (mkUTF16le TransliterateCodingFailure)
#else
    fromString :: String -> OsString
fromString = PosixString -> OsString
OsString (PosixString -> OsString)
-> (String -> PosixString) -> String -> OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PosixString
PS (ShortByteString -> PosixString)
-> (String -> ShortByteString) -> String -> PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EncodingException -> ShortByteString)
-> (ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString
-> ShortByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ShortByteString
forall a. HasCallStack => String -> a
error (String -> ShortByteString)
-> (EncodingException -> String)
-> EncodingException
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShortByteString -> ShortByteString
forall a. a -> a
id (Either EncodingException ShortByteString -> ShortByteString)
-> (String -> Either EncodingException ShortByteString)
-> String
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> String -> Either EncodingException ShortByteString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure)
#endif


-- | \"String-Concatenation\" for 'OsString. This is __not__ the same
-- as '(</>)'.
instance Monoid OsString where 
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    mempty      = OsString (WS BS.empty)
#if MIN_VERSION_base(4,16,0)
    mappend = (<>)
#else
    mappend (OsString (WS a)) (OsString (WS b))
      = OsString (WS (mappend a b))
#endif
#else
    mempty :: OsString
mempty      = PosixString -> OsString
OsString (ShortByteString -> PosixString
PS ShortByteString
BS.empty)
#if MIN_VERSION_base(4,16,0)
    mappend = (<>)
#else
    mappend :: OsString -> OsString -> OsString
mappend (OsString (PS ShortByteString
a)) (OsString (PS ShortByteString
b))
      = PosixString -> OsString
OsString (ShortByteString -> PosixString
PS (ShortByteString -> ShortByteString -> ShortByteString
forall a. Monoid a => a -> a -> a
mappend ShortByteString
a ShortByteString
b))
#endif
#endif
#if MIN_VERSION_base(4,11,0)
instance Semigroup OsString where 
#if MIN_VERSION_base(4,16,0)
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    (<>) (OsString (WS a)) (OsString (WS b))
      = OsString (WS (mappend a b))
#else
    (<>) (OsString (PS a)) (OsString (PS b))
      = OsString (PS (mappend a b))
#endif
#else
    <> :: OsString -> OsString -> OsString
(<>) = OsString -> OsString -> OsString
forall a. Monoid a => a -> a -> a
mappend
#endif
#endif


instance Lift OsString where
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
  lift (OsString (WS bs))
    = [| OsString (WS (BS.pack $(lift $ BS.unpack bs))) :: OsString |]
#else
  lift :: OsString -> Q Exp
lift (OsString (PS ShortByteString
bs))
    = [| OsString (PS (BS.pack $(lift $ BS.unpack bs))) :: OsString |]
#endif
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: OsString -> Q (TExp OsString)
liftTyped = Q Exp -> Q (TExp OsString)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp OsString))
-> (OsString -> Q Exp) -> OsString -> Q (TExp OsString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Decodes as UTF-16 on windows.
--
-- Decodes as UTF-8 on unix and replaces invalid chars with unicode replacement
-- char U+FFFD.
instance Show OsString where
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
  show (OsString (WS bs)) = ('\"': either (error . show) id (decodeWith (mkUTF16le TransliterateCodingFailure) bs)) <> "\""
#else
  show :: OsString -> String
show (OsString (PS ShortByteString
bs)) = (Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
: (EncodingException -> String)
-> ShowS -> Either EncodingException String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ShowS
forall a. HasCallStack => String -> a
error ShowS
-> (EncodingException -> String) -> EncodingException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShowS
forall a. a -> a
id (TextEncoding -> ShortByteString -> Either EncodingException String
decodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure) ShortByteString
bs)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""
#endif

-- | Encodes as UTF-8 on unix and UTF-16LE on windows.
instance Read OsString where
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
  readsPrec p str = [ (OsString $ WS $ either (error . show) id $ encodeWith (mkUTF16le TransliterateCodingFailure) x, y) | (x, y) <- readsPrec p str ]
#else
  readsPrec :: Int -> ReadS OsString
readsPrec Int
p String
str = [ (PosixString -> OsString
OsString (PosixString -> OsString) -> PosixString -> OsString
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PosixString
PS (ShortByteString -> PosixString) -> ShortByteString -> PosixString
forall a b. (a -> b) -> a -> b
$ (EncodingException -> ShortByteString)
-> (ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString
-> ShortByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ShortByteString
forall a. HasCallStack => String -> a
error (String -> ShortByteString)
-> (EncodingException -> String)
-> EncodingException
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> String
forall a. Show a => a -> String
show) ShortByteString -> ShortByteString
forall a. a -> a
id (Either EncodingException ShortByteString -> ShortByteString)
-> Either EncodingException ShortByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ TextEncoding -> String -> Either EncodingException ShortByteString
encodeWith (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure) String
x, String
y) | (String
x, String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]
#endif


-- | Newtype representing a code unit.
--
-- On Windows, this is restricted to two-octet codepoints 'Word16',
-- on POSIX one-octet ('Word8').
newtype OsChar = OsChar PlatformChar
  deriving (Int -> OsChar -> ShowS
[OsChar] -> ShowS
OsChar -> String
(Int -> OsChar -> ShowS)
-> (OsChar -> String) -> ([OsChar] -> ShowS) -> Show OsChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OsChar] -> ShowS
$cshowList :: [OsChar] -> ShowS
show :: OsChar -> String
$cshow :: OsChar -> String
showsPrec :: Int -> OsChar -> ShowS
$cshowsPrec :: Int -> OsChar -> ShowS
Show, Typeable, (forall x. OsChar -> Rep OsChar x)
-> (forall x. Rep OsChar x -> OsChar) -> Generic OsChar
forall x. Rep OsChar x -> OsChar
forall x. OsChar -> Rep OsChar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OsChar x -> OsChar
$cfrom :: forall x. OsChar -> Rep OsChar x
Generic, OsChar -> ()
(OsChar -> ()) -> NFData OsChar
forall a. (a -> ()) -> NFData a
rnf :: OsChar -> ()
$crnf :: OsChar -> ()
NFData)

-- | Byte equality of the internal representation.
instance Eq OsChar where
  (OsChar PosixChar
a) == :: OsChar -> OsChar -> Bool
== (OsChar PosixChar
b) = PosixChar
a PosixChar -> PosixChar -> Bool
forall a. Eq a => a -> a -> Bool
== PosixChar
b

-- | Byte ordering of the internal representation.
instance Ord OsChar where
  compare :: OsChar -> OsChar -> Ordering
compare (OsChar PosixChar
a) (OsChar PosixChar
b) = PosixChar -> PosixChar -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PosixChar
a PosixChar
b