    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE CPP, NoImplicitPrelude #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Foreign.C.String
    -- Copyright   :  (c) The FFI task force 2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  ffi@haskell.org
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- Utilities for primitive marshalling of C strings.
    --
    -- The marshalling converts each Haskell character, representing a Unicode
    -- code point, to one or more bytes in a manner that, by default, is
    -- determined by the current locale.  As a consequence, no guarantees
    -- can be made about the relative length of a Haskell string and its
    -- corresponding C string, and therefore all the marshalling routines
    -- include memory allocation.  The translation between Unicode and the
    -- encoding of the current locale may be lossy.
    --
    -----------------------------------------------------------------------------

    module Foreign.C.String (   -- representation of strings in C
      -- * C strings

      CString,
      CStringLen,

      -- ** Using a locale-dependent encoding

      -- | These functions are different from their @CAString@ counterparts
      -- in that they will use an encoding determined by the current locale,
      -- rather than always assuming ASCII.

      -- conversion of C strings into Haskell strings
      --
      peekCString,
      peekCStringLen,

      -- conversion of Haskell strings into C strings
      --
      newCString,
      newCStringLen,

      -- conversion of Haskell strings into C strings using temporary storage
      --
      withCString,
      withCStringLen,

      charIsRepresentable,

      -- ** Using 8-bit characters

      -- | These variants of the above functions are for use with C libraries
      -- that are ignorant of Unicode.  These functions should be used with
      -- care, as a loss of information can occur.

      castCharToCChar,
      castCCharToChar,

      castCharToCUChar,
      castCUCharToChar,
      castCharToCSChar,
      castCSCharToChar,

      peekCAString,
      peekCAStringLen,
      newCAString,
      newCAStringLen,
      withCAString,
      withCAStringLen,

      -- * C wide strings

      -- | These variants of the above functions are for use with C libraries
      -- that encode Unicode using the C @wchar_t@ type in a system-dependent
      -- way.  The only encodings supported are
      --
      -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or
      --
      -- * UTF-16 (as used on Windows systems).

      CWString,
      CWStringLen,

      peekCWString,
      peekCWStringLen,
      newCWString,
      newCWStringLen,
      withCWString,
      withCWStringLen,

      ) where

    import Foreign.Marshal.Array
    import Foreign.C.Types
    import Foreign.Ptr
    import Foreign.Storable

    import Data.Word

    import GHC.Char
    import GHC.List
    import GHC.Real
    import GHC.Num
    import GHC.Base

    import {-# SOURCE #-} GHC.IO.Encoding
    import qualified GHC.Foreign as GHC

    -----------------------------------------------------------------------------
    -- Strings

    -- representation of strings in C
    -- ------------------------------

    -- | A C string is a reference to an array of C characters terminated by NUL.
    type CString    = Ptr CChar

    -- | A string with explicit length information in bytes instead of a
    -- terminating NUL (allowing NUL characters in the middle of the string).
    type CStringLen = (Ptr CChar, Int)

    -- exported functions
    -- ------------------
    --
    -- * the following routines apply the default conversion when converting the
    --   C-land character encoding into the Haskell-land character encoding

    -- | Marshal a NUL terminated C string into a Haskell string.
    --
    peekCString    :: CString -> IO String
    peekCString :: CString -> IO String
    peekCString CString
    s = IO TextEncoding
    getForeignEncoding IO TextEncoding -> (TextEncoding -> IO String) -> IO String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (TextEncoding -> CString -> IO String)
    -> CString -> TextEncoding -> IO String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TextEncoding -> CString -> IO String
    GHC.peekCString CString
    s

    -- | Marshal a C string with explicit length into a Haskell string.
    --
    peekCStringLen           :: CStringLen -> IO String
    peekCStringLen :: CStringLen -> IO String
    peekCStringLen CStringLen
    s = IO TextEncoding
    getForeignEncoding IO TextEncoding -> (TextEncoding -> IO String) -> IO String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (TextEncoding -> CStringLen -> IO String)
    -> CStringLen -> TextEncoding -> IO String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TextEncoding -> CStringLen -> IO String
    GHC.peekCStringLen CStringLen
    s

    -- | Marshal a Haskell string into a NUL terminated C string.
    --
    -- * the Haskell string may /not/ contain any NUL characters
    --
    -- * new storage is allocated for the C string and must be
    --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
    --   'Foreign.Marshal.Alloc.finalizerFree'.
    --
    newCString :: String -> IO CString
    newCString :: String -> IO CString
    newCString String
    s = IO TextEncoding
    getForeignEncoding IO TextEncoding -> (TextEncoding -> IO CString) -> IO CString
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (TextEncoding -> String -> IO CString)
    -> String -> TextEncoding -> IO CString
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TextEncoding -> String -> IO CString
    GHC.newCString String
    s

    -- | Marshal a Haskell string into a C string (ie, character array) with
    -- explicit length information.
    --
    -- * new storage is allocated for the C string and must be
    --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
    --   'Foreign.Marshal.Alloc.finalizerFree'.
    --
    newCStringLen     :: String -> IO CStringLen
    newCStringLen :: String -> IO CStringLen
    newCStringLen String
    s = IO TextEncoding
    getForeignEncoding IO TextEncoding -> (TextEncoding -> IO CStringLen) -> IO CStringLen
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (TextEncoding -> String -> IO CStringLen)
    -> String -> TextEncoding -> IO CStringLen
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TextEncoding -> String -> IO CStringLen
    GHC.newCStringLen String
    s

    -- | Marshal a Haskell string into a NUL terminated C string using temporary
    -- storage.
    --
    -- * the Haskell string may /not/ contain any NUL characters
    --
    -- * the memory is freed when the subcomputation terminates (either
    --   normally or via an exception), so the pointer to the temporary
    --   storage must /not/ be used after this.
    --
    withCString :: String -> (CString -> IO a) -> IO a
    withCString :: forall a. String -> (CString -> IO a) -> IO a
    withCString String
    s CString -> IO a
    f = IO TextEncoding
    getForeignEncoding IO TextEncoding -> (TextEncoding -> IO a) -> IO a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \TextEncoding
    enc -> TextEncoding -> String -> (CString -> IO a) -> IO a
    forall a. TextEncoding -> String -> (CString -> IO a) -> IO a
    GHC.withCString TextEncoding
    enc String
    s CString -> IO a
    f

    -- | Marshal a Haskell string into a C string (ie, character array)
    -- in temporary storage, with explicit length information.
    --
    -- * the memory is freed when the subcomputation terminates (either
    --   normally or via an exception), so the pointer to the temporary
    --   storage must /not/ be used after this.
    --
    withCStringLen         :: String -> (CStringLen -> IO a) -> IO a
    withCStringLen :: forall a. String -> (CStringLen -> IO a) -> IO a
    withCStringLen String
    s CStringLen -> IO a
    f = IO TextEncoding
    getForeignEncoding IO TextEncoding -> (TextEncoding -> IO a) -> IO a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \TextEncoding
    enc -> TextEncoding -> String -> (CStringLen -> IO a) -> IO a
    forall a. TextEncoding -> String -> (CStringLen -> IO a) -> IO a
    GHC.withCStringLen TextEncoding
    enc String
    s CStringLen -> IO a
    f

    -- -- | Determines whether a character can be accurately encoded in a 'CString'.
    -- -- Unrepresentable characters are converted to '?' or their nearest visual equivalent.
    charIsRepresentable :: Char -> IO Bool
    charIsRepresentable :: Char -> IO Bool
    charIsRepresentable Char
    c = IO TextEncoding
    getForeignEncoding IO TextEncoding -> (TextEncoding -> IO Bool) -> IO Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (TextEncoding -> Char -> IO Bool)
    -> Char -> TextEncoding -> IO Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TextEncoding -> Char -> IO Bool
    GHC.charIsRepresentable Char
    c

    -- single byte characters
    -- ----------------------
    --
    --   ** NOTE: These routines don't handle conversions! **

    -- | Convert a C byte, representing a Latin-1 character, to the corresponding
    -- Haskell character.
    castCCharToChar :: CChar -> Char
    castCCharToChar :: CChar -> Char
    castCCharToChar CChar
    ch = Int -> Char
    unsafeChr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CChar -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CChar
    ch :: Word8))

    -- | Convert a Haskell character to a C character.
    -- This function is only safe on the first 256 characters.
    castCharToCChar :: Char -> CChar
    castCharToCChar :: Char -> CChar
    castCharToCChar Char
    ch = Int -> CChar
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    ch)

    -- | Convert a C @unsigned char@, representing a Latin-1 character, to
    -- the corresponding Haskell character.
    castCUCharToChar :: CUChar -> Char
    castCUCharToChar :: CUChar -> Char
    castCUCharToChar CUChar
    ch = Int -> Char
    unsafeChr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CUChar -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CUChar
    ch :: Word8))

    -- | Convert a Haskell character to a C @unsigned char@.
    -- This function is only safe on the first 256 characters.
    castCharToCUChar :: Char -> CUChar
    castCharToCUChar :: Char -> CUChar
    castCharToCUChar Char
    ch = Int -> CUChar
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    ch)

    -- | Convert a C @signed char@, representing a Latin-1 character, to the
    -- corresponding Haskell character.
    castCSCharToChar :: CSChar -> Char
    castCSCharToChar :: CSChar -> Char
    castCSCharToChar CSChar
    ch = Int -> Char
    unsafeChr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CSChar -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CSChar
    ch :: Word8))

    -- | Convert a Haskell character to a C @signed char@.
    -- This function is only safe on the first 256 characters.
    castCharToCSChar :: Char -> CSChar
    castCharToCSChar :: Char -> CSChar
    castCharToCSChar Char
    ch = Int -> CSChar
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    ch)

    -- | Marshal a NUL terminated C string into a Haskell string.
    --
    peekCAString    :: CString -> IO String
    peekCAString :: CString -> IO String
    peekCAString CString
    cp = do
      Int
    l <- CChar -> CString -> IO Int
    forall a. (Storable a, Eq a) => a -> Ptr a -> IO Int
    lengthArray0 CChar
    nUL CString
    cp
      if Int
    l Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 then String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "" else String -> Int -> IO String
    loop String
    "" (Int
    lInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
      where
        loop :: String -> Int -> IO String
    loop String
    s Int
    i = do
            CChar
    xval <- CString -> Int -> IO CChar
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff CString
    cp Int
    i
            let val :: Char
    val = CChar -> Char
    castCCharToChar CChar
    xval
            Char
    val Char -> IO String -> IO String
    `seq` if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 then String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    valChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s) else String -> Int -> IO String
    loop (Char
    valChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s) (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)

    -- | Marshal a C string with explicit length into a Haskell string.
    --
    peekCAStringLen           :: CStringLen -> IO String
    peekCAStringLen :: CStringLen -> IO String
    peekCAStringLen (CString
    cp, Int
    len)
      | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0  = String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "" -- being (too?) nice.
      | Bool
    otherwise = String -> Int -> IO String
    loop [] (Int
    lenInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
      where
        loop :: String -> Int -> IO String
    loop String
    acc Int
    i = do
             CChar
    xval <- CString -> Int -> IO CChar
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff CString
    cp Int
    i
             let val :: Char
    val = CChar -> Char
    castCCharToChar CChar
    xval
               -- blow away the coercion ASAP.
             if (Char
    val Char -> Bool -> Bool
    `seq` (Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0))
              then String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char
    valChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    acc)
              else String -> Int -> IO String
    loop (Char
    valChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    acc) (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)

    -- | Marshal a Haskell string into a NUL terminated C string.
    --
    -- * the Haskell string may /not/ contain any NUL characters
    --
    -- * new storage is allocated for the C string and must be
    --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
    --   'Foreign.Marshal.Alloc.finalizerFree'.
    --
    newCAString :: String -> IO CString
    newCAString :: String -> IO CString
    newCAString String
    str = do
      CString
    ptr <- Int -> IO CString
    forall a. Storable a => Int -> IO (Ptr a)
    mallocArray0 (String -> Int
    forall a. [a] -> Int
    length String
    str)
      let
            go :: String -> Int -> IO ()
    go [] Int
    n     = CString -> Int -> CChar -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff CString
    ptr Int
    n CChar
    nUL
            go (Char
    c:String
    cs) Int
    n = do CString -> Int -> CChar -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff CString
    ptr Int
    n (Char -> CChar
    castCharToCChar Char
    c); String -> Int -> IO ()
    go String
    cs (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
      String -> Int -> IO ()
    go String
    str Int
    0
      CString -> IO CString
    forall (m :: * -> *) a. Monad m => a -> m a
    return CString
    ptr

    -- | Marshal a Haskell string into a C string (ie, character array) with
    -- explicit length information.
    --
    -- * new storage is allocated for the C string and must be
    --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
    --   'Foreign.Marshal.Alloc.finalizerFree'.
    --
    newCAStringLen     :: String -> IO CStringLen
    newCAStringLen :: String -> IO CStringLen
    newCAStringLen String
    str = do
      CString
    ptr <- Int -> IO CString
    forall a. Storable a => Int -> IO (Ptr a)
    mallocArray0 Int
    len
      let
            go :: String -> Int -> IO ()
    go [] Int
    n     = Int
    n Int -> IO () -> IO ()
    `seq` () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- make it strict in n
            go (Char
    c:String
    cs) Int
    n = do CString -> Int -> CChar -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff CString
    ptr Int
    n (Char -> CChar
    castCharToCChar Char
    c); String -> Int -> IO ()
    go String
    cs (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
      String -> Int -> IO ()
    go String
    str Int
    0
      CStringLen -> IO CStringLen
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CString
    ptr, Int
    len)
      where
        len :: Int
    len = String -> Int
    forall a. [a] -> Int
    length String
    str

    -- | Marshal a Haskell string into a NUL terminated C string using temporary
    -- storage.
    --
    -- * the Haskell string may /not/ contain any NUL characters
    --
    -- * the memory is freed when the subcomputation terminates (either
    --   normally or via an exception), so the pointer to the temporary
    --   storage must /not/ be used after this.
    --
    withCAString :: String -> (CString -> IO a) -> IO a
    withCAString :: forall a. String -> (CString -> IO a) -> IO a
    withCAString String
    str CString -> IO a
    f =
      Int -> (CString -> IO a) -> IO a
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray0 (String -> Int
    forall a. [a] -> Int
    length String
    str) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \CString
    ptr ->
          let
            go :: String -> Int -> IO ()
    go [] Int
    n     = CString -> Int -> CChar -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff CString
    ptr Int
    n CChar
    nUL
            go (Char
    c:String
    cs) Int
    n = do CString -> Int -> CChar -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff CString
    ptr Int
    n (Char -> CChar
    castCharToCChar Char
    c); String -> Int -> IO ()
    go String
    cs (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
          in do
          String -> Int -> IO ()
    go String
    str Int
    0
          CString -> IO a
    f CString
    ptr

    -- | Marshal a Haskell string into a C string (ie, character array)
    -- in temporary storage, with explicit length information.
    --
    -- * the memory is freed when the subcomputation terminates (either
    --   normally or via an exception), so the pointer to the temporary
    --   storage must /not/ be used after this.
    --
    withCAStringLen         :: String -> (CStringLen -> IO a) -> IO a
    withCAStringLen :: forall a. String -> (CStringLen -> IO a) -> IO a
    withCAStringLen String
    str CStringLen -> IO a
    f    =
      Int -> (CString -> IO a) -> IO a
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray Int
    len ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \CString
    ptr ->
          let
            go :: String -> Int -> IO ()
    go [] Int
    n     = Int
    n Int -> IO () -> IO ()
    `seq` () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- make it strict in n
            go (Char
    c:String
    cs) Int
    n = do CString -> Int -> CChar -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff CString
    ptr Int
    n (Char -> CChar
    castCharToCChar Char
    c); String -> Int -> IO ()
    go String
    cs (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
          in do
          String -> Int -> IO ()
    go String
    str Int
    0
          CStringLen -> IO a
    f (CString
    ptr,Int
    len)
      where
        len :: Int
    len = String -> Int
    forall a. [a] -> Int
    length String
    str

    -- auxiliary definitions
    -- ----------------------

    -- C's end of string character
    --
    nUL :: CChar
    nUL :: CChar
    nUL  = CChar
    0

    -- allocate an array to hold the list and pair it with the number of elements
    newArrayLen        :: Storable a => [a] -> IO (Ptr a, Int)
    newArrayLen :: forall a. Storable a => [a] -> IO (Ptr a, Int)
    newArrayLen [a]
    xs      = do
      Ptr a
    a <- [a] -> IO (Ptr a)
    forall a. Storable a => [a] -> IO (Ptr a)
    newArray [a]
    xs
      (Ptr a, Int) -> IO (Ptr a, Int)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr a
    a, [a] -> Int
    forall a. [a] -> Int
    length [a]
    xs)

    -----------------------------------------------------------------------------
    -- Wide strings

    -- representation of wide strings in C
    -- -----------------------------------

    -- | A C wide string is a reference to an array of C wide characters
    -- terminated by NUL.
    type CWString    = Ptr CWchar

    -- | A wide character string with explicit length information in 'CWchar's
    -- instead of a terminating NUL (allowing NUL characters in the middle
    -- of the string).
    type CWStringLen = (Ptr CWchar, Int)

    -- | Marshal a NUL terminated C wide string into a Haskell string.
    --
    peekCWString    :: CWString -> IO String
    peekCWString :: CWString -> IO String
    peekCWString CWString
    cp  = do
      [CWchar]
    cs <- CWchar -> CWString -> IO [CWchar]
    forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
    peekArray0 CWchar
    wNUL CWString
    cp
      String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CWchar] -> String
    cWcharsToChars [CWchar]
    cs)

    -- | Marshal a C wide string with explicit length into a Haskell string.
    --
    peekCWStringLen           :: CWStringLen -> IO String
    peekCWStringLen :: CWStringLen -> IO String
    peekCWStringLen (CWString
    cp, Int
    len)  = do
      [CWchar]
    cs <- Int -> CWString -> IO [CWchar]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray Int
    len CWString
    cp
      String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CWchar] -> String
    cWcharsToChars [CWchar]
    cs)

    -- | Marshal a Haskell string into a NUL terminated C wide string.
    --
    -- * the Haskell string may /not/ contain any NUL characters
    --
    -- * new storage is allocated for the C wide string and must
    --   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
    --   'Foreign.Marshal.Alloc.finalizerFree'.
    --
    newCWString :: String -> IO CWString
    newCWString :: String -> IO CWString
    newCWString  = CWchar -> [CWchar] -> IO CWString
    forall a. Storable a => a -> [a] -> IO (Ptr a)
    newArray0 CWchar
    wNUL ([CWchar] -> IO CWString)
    -> (String -> [CWchar]) -> String -> IO CWString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [CWchar]
    charsToCWchars

    -- | Marshal a Haskell string into a C wide string (ie, wide character array)
    -- with explicit length information.
    --
    -- * new storage is allocated for the C wide string and must
    --   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
    --   'Foreign.Marshal.Alloc.finalizerFree'.
    --
    newCWStringLen     :: String -> IO CWStringLen
    newCWStringLen :: String -> IO CWStringLen
    newCWStringLen String
    str  = [CWchar] -> IO CWStringLen
    forall a. Storable a => [a] -> IO (Ptr a, Int)
    newArrayLen (String -> [CWchar]
    charsToCWchars String
    str)

    -- | Marshal a Haskell string into a NUL terminated C wide string using
    -- temporary storage.
    --
    -- * the Haskell string may /not/ contain any NUL characters
    --
    -- * the memory is freed when the subcomputation terminates (either
    --   normally or via an exception), so the pointer to the temporary
    --   storage must /not/ be used after this.
    --
    withCWString :: String -> (CWString -> IO a) -> IO a
    withCWString :: forall a. String -> (CWString -> IO a) -> IO a
    withCWString  = CWchar -> [CWchar] -> (CWString -> IO a) -> IO a
    forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
    withArray0 CWchar
    wNUL ([CWchar] -> (CWString -> IO a) -> IO a)
    -> (String -> [CWchar]) -> String -> (CWString -> IO a) -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [CWchar]
    charsToCWchars

    -- | Marshal a Haskell string into a C wide string (i.e. wide
    -- character array) in temporary storage, with explicit length
    -- information.
    --
    -- * the memory is freed when the subcomputation terminates (either
    --   normally or via an exception), so the pointer to the temporary
    --   storage must /not/ be used after this.
    --
    withCWStringLen         :: String -> (CWStringLen -> IO a) -> IO a
    withCWStringLen :: forall a. String -> (CWStringLen -> IO a) -> IO a
    withCWStringLen String
    str CWStringLen -> IO a
    f    =
      [CWchar] -> (Int -> CWString -> IO a) -> IO a
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen (String -> [CWchar]
    charsToCWchars String
    str) ((Int -> CWString -> IO a) -> IO a)
    -> (Int -> CWString -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \ Int
    len CWString
    ptr -> CWStringLen -> IO a
    f (CWString
    ptr, Int
    len)

    -- auxiliary definitions
    -- ----------------------

    wNUL :: CWchar
    wNUL :: CWchar
    wNUL = CWchar
    0

    cWcharsToChars :: [CWchar] -> [Char]
    charsToCWchars :: [Char] -> [CWchar]

    #if defined(mingw32_HOST_OS)

    -- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.

    -- coding errors generate Chars in the surrogate range
    cWcharsToChars = map chr . fromUTF16 . map fromIntegral
     where
      fromUTF16 (c1:c2:wcs)
        | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =
          ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs
      fromUTF16 (c:wcs) = c : fromUTF16 wcs
      fromUTF16 [] = []

    charsToCWchars = foldr utf16Char [] . map ord
     where
      utf16Char c wcs
        | c < 0x10000 = fromIntegral c : wcs
        | otherwise   = let c' = c - 0x10000 in
                        fromIntegral (c' `div` 0x400 + 0xd800) :
                        fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs

    #else /* !mingw32_HOST_OS */

    cWcharsToChars :: [CWchar] -> String
    cWcharsToChars [CWchar]
    xs  = (CWchar -> Char) -> [CWchar] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map CWchar -> Char
    castCWcharToChar [CWchar]
    xs
    charsToCWchars :: String -> [CWchar]
    charsToCWchars String
    xs  = (Char -> CWchar) -> String -> [CWchar]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> CWchar
    castCharToCWchar String
    xs

    -- These conversions only make sense if __STDC_ISO_10646__ is defined
    -- (meaning that wchar_t is ISO 10646, aka Unicode)

    castCWcharToChar :: CWchar -> Char
    castCWcharToChar :: CWchar -> Char
    castCWcharToChar CWchar
    ch = Int -> Char
    chr (CWchar -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CWchar
    ch )

    castCharToCWchar :: Char -> CWchar
    castCharToCWchar :: Char -> CWchar
    castCharToCWchar Char
    ch = Int -> CWchar
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    ch)

    #endif /* !mingw32_HOST_OS */