{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PatternSynonyms #-}

module System.OsString.Internal.Types
  (
    WindowsString(..)
  , pattern WS
  , unWS
  , PosixString(..)
  , unPS
  , pattern PS
  , PlatformString
  , WindowsChar(..)
  , unWW
  , pattern WW
  , PosixChar(..)
  , unPW
  , pattern PW
  , PlatformChar
  , OsString(..)
  , OsChar(..)
  )
where


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

import System.OsPath.Encoding.Internal
import qualified System.OsPath.Data.ByteString.Short as BS
import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16
#if MIN_VERSION_template_haskell(2,16,0)
import qualified Language.Haskell.TH.Syntax as TH
#endif

-- 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 wide character bytes.
newtype WindowsString = WindowsString { WindowsString -> ShortByteString
getWindowsString :: BS.ShortByteString }
  deriving (WindowsString -> WindowsString -> Bool
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
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
Ord, NonEmpty WindowsString -> WindowsString
WindowsString -> WindowsString -> 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 :: forall b. Integral b => 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
[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
Monoid, Typeable, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: WindowsString -> ()
$crnf :: WindowsString -> ()
NFData)

-- | Decodes as UCS-2.
instance Show WindowsString where
  -- cWcharsToChars_UCS2 is total
  show :: WindowsString -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word16] -> String
cWcharsToChars_UCS2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word16]
BS16.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowsString -> ShortByteString
getWindowsString

-- | Just a short bidirectional synonym for 'WindowsString' constructor.
pattern WS :: BS.ShortByteString -> WindowsString
pattern $bWS :: ShortByteString -> WindowsString
$mWS :: forall {r}.
WindowsString -> (ShortByteString -> r) -> ((# #) -> r) -> r
WS { WindowsString -> ShortByteString
unWS } <- WindowsString unWS where
  WS ShortByteString
a = ShortByteString -> WindowsString
WindowsString ShortByteString
a
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE WS #-}
#endif


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

-- | Commonly used Posix string as uninterpreted @char[]@
-- array.
newtype PosixString = PosixString { PosixString -> ShortByteString
getPosixString :: BS.ShortByteString }
  deriving (PosixString -> PosixString -> Bool
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
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
Ord, NonEmpty PosixString -> PosixString
PosixString -> PosixString -> 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 :: forall b. Integral b => 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
[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
Monoid, Typeable, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: PosixString -> ()
$crnf :: PosixString -> ()
NFData)

-- | Prints the raw bytes without decoding.
instance Show PosixString where
  show :: PosixString -> String
show (PosixString ShortByteString
ps) = forall a. Show a => a -> String
show ShortByteString
ps

-- | Just a short bidirectional synonym for 'PosixString' constructor.
pattern PS :: BS.ShortByteString -> PosixString
pattern $bPS :: ShortByteString -> PosixString
$mPS :: forall {r}.
PosixString -> (ShortByteString -> r) -> ((# #) -> r) -> r
PS { PosixString -> ShortByteString
unPS } <- PosixString unPS where
  PS ShortByteString
a = ShortByteString -> PosixString
PosixString ShortByteString
a
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE PS #-}
#endif

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


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

newtype WindowsChar = WindowsChar { WindowsChar -> Word16
getWindowsChar :: Word16 }
  deriving (WindowsChar -> WindowsChar -> Bool
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
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
Ord, Typeable, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: WindowsChar -> ()
$crnf :: WindowsChar -> ()
NFData)

instance Show WindowsChar where
  show :: WindowsChar -> String
show (WindowsChar Word16
wc) = forall a. Show a => a -> String
show Word16
wc

newtype PosixChar   = PosixChar { PosixChar -> Word8
getPosixChar :: Word8 }
  deriving (PosixChar -> PosixChar -> Bool
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
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
Ord, Typeable, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: PosixChar -> ()
$crnf :: PosixChar -> ()
NFData)

instance Show PosixChar where
  show :: PosixChar -> String
show (PosixChar Word8
pc) = forall a. Show a => a -> String
show Word8
pc

-- | Just a short bidirectional synonym for 'WindowsChar' constructor.
pattern WW :: Word16 -> WindowsChar
pattern $bWW :: Word16 -> WindowsChar
$mWW :: forall {r}. WindowsChar -> (Word16 -> r) -> ((# #) -> r) -> r
WW { WindowsChar -> Word16
unWW } <- WindowsChar unWW where
  WW Word16
a = Word16 -> WindowsChar
WindowsChar Word16
a
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE WW #-}
#endif

-- | Just a short bidirectional synonym for 'PosixChar' constructor.
pattern PW :: Word8 -> PosixChar
pattern $bPW :: Word8 -> PosixChar
$mPW :: forall {r}. PosixChar -> (Word8 -> r) -> ((# #) -> r) -> r
PW { PosixChar -> Word8
unPW } <- PosixChar unPW where
  PW Word8
a = Word8 -> PosixChar
PosixChar Word8
a
#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE PW #-}
#endif

#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 { OsString -> PosixString
getOsString :: PlatformString }
  deriving (Typeable, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: OsString -> ()
$crnf :: OsString -> ()
NFData)

-- | On windows, decodes as UCS-2. On unix prints the raw bytes without decoding.
instance Show OsString where
  show :: OsString -> String
show (OsString PosixString
os) = forall a. Show a => a -> String
show PosixString
os

-- | Byte equality of the internal representation.
instance Eq OsString where
  (OsString PosixString
a) == :: OsString -> OsString -> Bool
== (OsString PosixString
b) = PosixString
a 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) = forall a. Ord a => a -> a -> Ordering
compare PosixString
a PosixString
b


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


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


-- | Newtype representing a code unit.
--
-- On Windows, this is restricted to two-octet codepoints 'Word16',
-- on POSIX one-octet ('Word8').
newtype OsChar = OsChar { OsChar -> PosixChar
getOsChar :: PlatformChar }
  deriving (Typeable, 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: OsChar -> ()
$crnf :: OsChar -> ()
NFData)

instance Show OsChar where
  show :: OsChar -> String
show (OsChar PosixChar
pc) = forall a. Show a => a -> String
show PosixChar
pc

-- | Byte equality of the internal representation.
instance Eq OsChar where
  (OsChar PosixChar
a) == :: OsChar -> OsChar -> Bool
== (OsChar PosixChar
b) = PosixChar
a 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) = forall a. Ord a => a -> a -> Ordering
compare PosixChar
a PosixChar
b