Foreign/C/String.hs

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Foreign.C.String
   5 -- Copyright   :  (c) The FFI task force 2001
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  ffi@haskell.org
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- Utilities for primitive marshalling of C strings.
  13 --
  14 -- The marshalling converts each Haskell character, representing a Unicode
  15 -- code point, to one or more bytes in a manner that, by default, is
  16 -- determined by the current locale.  As a consequence, no guarantees
  17 -- can be made about the relative length of a Haskell string and its
  18 -- corresponding C string, and therefore all the marshalling routines
  19 -- include memory allocation.  The translation between Unicode and the
  20 -- encoding of the current locale may be lossy.
  21 --
  22 -----------------------------------------------------------------------------
  23
  24 module Foreign.C.String (   -- representation of strings in C
  25
  26   -- * C strings
  27
  28   CString,           -- = Ptr CChar
  29   CStringLen,        -- = (Ptr CChar, Int)
  30
  31   -- ** Using a locale-dependent encoding
  32
  33   -- | Currently these functions are identical to their @CAString@ counterparts;
  34   -- eventually they will use an encoding determined by the current locale.
  35
  36   -- conversion of C strings into Haskell strings
  37   --
  38   peekCString,       -- :: CString    -> IO String
  39   peekCStringLen,    -- :: CStringLen -> IO String
  40
  41   -- conversion of Haskell strings into C strings
  42   --
  43   newCString,        -- :: String -> IO CString
  44   newCStringLen,     -- :: String -> IO CStringLen
  45
  46   -- conversion of Haskell strings into C strings using temporary storage
  47   --
  48   withCString,       -- :: String -> (CString    -> IO a) -> IO a
  49   withCStringLen,    -- :: String -> (CStringLen -> IO a) -> IO a
  50
  51   charIsRepresentable, -- :: Char -> IO Bool
  52
  53   -- ** Using 8-bit characters
  54
  55   -- | These variants of the above functions are for use with C libraries
  56   -- that are ignorant of Unicode.  These functions should be used with
  57   -- care, as a loss of information can occur.
  58
  59   castCharToCChar,   -- :: Char -> CChar
  60   castCCharToChar,   -- :: CChar -> Char
  61
  62   peekCAString,      -- :: CString    -> IO String
  63   peekCAStringLen,   -- :: CStringLen -> IO String
  64   newCAString,       -- :: String -> IO CString
  65   newCAStringLen,    -- :: String -> IO CStringLen
  66   withCAString,      -- :: String -> (CString    -> IO a) -> IO a
  67   withCAStringLen,   -- :: String -> (CStringLen -> IO a) -> IO a
  68
  69   -- * C wide strings
  70
  71   -- | These variants of the above functions are for use with C libraries
  72   -- that encode Unicode using the C @wchar_t@ type in a system-dependent
  73   -- way.  The only encodings supported are
  74   --
  75   -- * UTF-32 (the C compiler defines @__STDC_ISO_10646__@), or
  76   --
  77   -- * UTF-16 (as used on Windows systems).
  78
  79   CWString,          -- = Ptr CWchar
  80   CWStringLen,       -- = (Ptr CWchar, Int)
  81
  82   peekCWString,      -- :: CWString    -> IO String
  83   peekCWStringLen,   -- :: CWStringLen -> IO String
  84   newCWString,       -- :: String -> IO CWString
  85   newCWStringLen,    -- :: String -> IO CWStringLen
  86   withCWString,      -- :: String -> (CWString    -> IO a) -> IO a
  87   withCWStringLen,   -- :: String -> (CWStringLen -> IO a) -> IO a
  88
  89   ) where
  90
  91 import Foreign.Marshal.Array
  92 import Foreign.C.Types
  93 import Foreign.Ptr
  94 import Foreign.Storable
  95
  96 import Data.Word
  97
  98 #ifdef __GLASGOW_HASKELL__
  99 import GHC.List
 100 import GHC.Real
 101 import GHC.Num
 102 import GHC.IOBase
 103 import GHC.Base
 104 #else
 105 import Data.Char ( chr, ord )
 106 #define unsafeChr chr
 107 #endif
 108
 109 -----------------------------------------------------------------------------
 110 -- Strings
 111
 112 -- representation of strings in C
 113 -- ------------------------------
 114
 115 -- | A C string is a reference to an array of C characters terminated by NUL.
 116 type CString    = Ptr CChar
 117
 118 -- | A string with explicit length information in bytes instead of a
 119 -- terminating NUL (allowing NUL characters in the middle of the string).
 120 type CStringLen = (Ptr CChar, Int)
 121
 122 -- exported functions
 123 -- ------------------
 124 --
 125 -- * the following routines apply the default conversion when converting the
 126 --   C-land character encoding into the Haskell-land character encoding
 127
 128 -- | Marshal a NUL terminated C string into a Haskell string.
 129 --
 130 peekCString    :: CString -> IO String
 131 peekCString = peekCAString
 132
 133 -- | Marshal a C string with explicit length into a Haskell string.
 134 --
 135 peekCStringLen           :: CStringLen -> IO String
 136 peekCStringLen = peekCAStringLen
 137
 138 -- | Marshal a Haskell string into a NUL terminated C string.
 139 --
 140 -- * the Haskell string may /not/ contain any NUL characters
 141 --
 142 -- * new storage is allocated for the C string and must be
 143 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 144 --   'Foreign.Marshal.Alloc.finalizerFree'.
 145 --
 146 newCString :: String -> IO CString
 147 newCString = newCAString
 148
 149 -- | Marshal a Haskell string into a C string (ie, character array) with
 150 -- explicit length information.
 151 --
 152 -- * new storage is allocated for the C string and must be
 153 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 154 --   'Foreign.Marshal.Alloc.finalizerFree'.
 155 --
 156 newCStringLen     :: String -> IO CStringLen
 157 newCStringLen = newCAStringLen
 158
 159 -- | Marshal a Haskell string into a NUL terminated C string using temporary
 160 -- storage.
 161 --
 162 -- * the Haskell string may /not/ contain any NUL characters
 163 --
 164 -- * the memory is freed when the subcomputation terminates (either
 165 --   normally or via an exception), so the pointer to the temporary
 166 --   storage must /not/ be used after this.
 167 --
 168 withCString :: String -> (CString -> IO a) -> IO a
 169 withCString = withCAString
 170
 171 -- | Marshal a Haskell string into a NUL terminated C string using temporary
 172 -- storage.
 173 --
 174 -- * the Haskell string may /not/ contain any NUL characters
 175 --
 176 -- * the memory is freed when the subcomputation terminates (either
 177 --   normally or via an exception), so the pointer to the temporary
 178 --   storage must /not/ be used after this.
 179 --
 180 withCStringLen         :: String -> (CStringLen -> IO a) -> IO a
 181 withCStringLen = withCAStringLen
 182
 183 -- | Determines whether a character can be accurately encoded in a 'CString'.
 184 -- Unrepresentable characters are converted to @\'?\'@.
 185 --
 186 -- Currently only Latin-1 characters are representable.
 187 charIsRepresentable :: Char -> IO Bool
 188 charIsRepresentable c = return (ord c < 256)
 189
 190 -- single byte characters
 191 -- ----------------------
 192 --
 193 --   ** NOTE: These routines don't handle conversions! **
 194
 195 -- | Convert a C byte, representing a Latin-1 character, to the corresponding
 196 -- Haskell character.
 197 castCCharToChar :: CChar -> Char
 198 castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8))
 199
 200 -- | Convert a Haskell character to a C character.
 201 -- This function is only safe on the first 256 characters.
 202 castCharToCChar :: Char -> CChar
 203 castCharToCChar ch = fromIntegral (ord ch)
 204
 205 -- | Marshal a NUL terminated C string into a Haskell string.
 206 --
 207 peekCAString    :: CString -> IO String
 208 #ifndef __GLASGOW_HASKELL__
 209 peekCAString cp  = do
 210   cs <- peekArray0 nUL cp
 211   return (cCharsToChars cs)
 212 #else
 213 peekCAString cp = do
 214   l <- lengthArray0 nUL cp
 215   if l <= 0 then return "" else loop "" (l-1)
 216   where
 217     loop s i = do
 218         xval <- peekElemOff cp i
 219         let val = castCCharToChar xval
 220         val `seq` if i <= 0 then return (val:s) else loop (val:s) (i-1)
 221 #endif
 222
 223 -- | Marshal a C string with explicit length into a Haskell string.
 224 --
 225 peekCAStringLen           :: CStringLen -> IO String
 226 #ifndef __GLASGOW_HASKELL__
 227 peekCAStringLen (cp, len)  = do
 228   cs <- peekArray len cp
 229   return (cCharsToChars cs)
 230 #else
 231 peekCAStringLen (cp, len)
 232   | len <= 0  = return "" -- being (too?) nice.
 233   | otherwise = loop [] (len-1)
 234   where
 235     loop acc i = do
 236          xval <- peekElemOff cp i
 237          let val = castCCharToChar xval
 238            -- blow away the coercion ASAP.
 239          if (val `seq` (i == 0))
 240           then return (val:acc)
 241           else loop (val:acc) (i-1)
 242 #endif
 243
 244 -- | Marshal a Haskell string into a NUL terminated C string.
 245 --
 246 -- * the Haskell string may /not/ contain any NUL characters
 247 --
 248 -- * new storage is allocated for the C string and must be
 249 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 250 --   'Foreign.Marshal.Alloc.finalizerFree'.
 251 --
 252 newCAString :: String -> IO CString
 253 #ifndef __GLASGOW_HASKELL__
 254 newCAString  = newArray0 nUL . charsToCChars
 255 #else
 256 newCAString str = do
 257   ptr <- mallocArray0 (length str)
 258   let
 259         go [] n     = pokeElemOff ptr n nUL
 260         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 261   go str 0
 262   return ptr
 263 #endif
 264
 265 -- | Marshal a Haskell string into a C string (ie, character array) with
 266 -- explicit length information.
 267 --
 268 -- * new storage is allocated for the C string and must be
 269 --   explicitly freed using 'Foreign.Marshal.Alloc.free' or
 270 --   'Foreign.Marshal.Alloc.finalizerFree'.
 271 --
 272 newCAStringLen     :: String -> IO CStringLen
 273 #ifndef __GLASGOW_HASKELL__
 274 newCAStringLen str  = do
 275   a <- newArray (charsToCChars str)
 276   return (pairLength str a)
 277 #else
 278 newCAStringLen str = do
 279   ptr <- mallocArray0 len
 280   let
 281         go [] n     = n `seq` return () -- make it strict in n
 282         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 283   go str 0
 284   return (ptr, len)
 285   where
 286     len = length str
 287 #endif
 288
 289 -- | Marshal a Haskell string into a NUL terminated C string using temporary
 290 -- storage.
 291 --
 292 -- * the Haskell string may /not/ contain any NUL characters
 293 --
 294 -- * the memory is freed when the subcomputation terminates (either
 295 --   normally or via an exception), so the pointer to the temporary
 296 --   storage must /not/ be used after this.
 297 --
 298 withCAString :: String -> (CString -> IO a) -> IO a
 299 #ifndef __GLASGOW_HASKELL__
 300 withCAString  = withArray0 nUL . charsToCChars
 301 #else
 302 withCAString str f =
 303   allocaArray0 (length str) $ \ptr ->
 304       let
 305         go [] n     = pokeElemOff ptr n nUL
 306         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 307       in do
 308       go str 0
 309       f ptr
 310 #endif
 311
 312 -- | Marshal a Haskell string into a NUL terminated C string using temporary
 313 -- storage.
 314 --
 315 -- * the Haskell string may /not/ contain any NUL characters
 316 --
 317 -- * the memory is freed when the subcomputation terminates (either
 318 --   normally or via an exception), so the pointer to the temporary
 319 --   storage must /not/ be used after this.
 320 --
 321 withCAStringLen         :: String -> (CStringLen -> IO a) -> IO a
 322 #ifndef __GLASGOW_HASKELL__
 323 withCAStringLen str act  = withArray (charsToCChars str) $ act . pairLength str
 324 #else
 325 withCAStringLen str f =
 326   allocaArray len $ \ptr ->
 327       let
 328         go [] n     = n `seq` return () -- make it strict in n
 329         go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
 330       in do
 331       go str 0
 332       f (ptr,len)
 333   where
 334     len = length str
 335 #endif
 336
 337 -- auxiliary definitions
 338 -- ----------------------
 339
 340 -- C's end of string character
 341 --
 342 nUL :: CChar
 343 nUL  = 0
 344
 345 -- pair a C string with the length of the given Haskell string
 346 --
 347 pairLength :: String -> a -> (a, Int)
 348 pairLength  = flip (,) . length
 349
 350 #ifndef __GLASGOW_HASKELL__
 351 -- cast [CChar] to [Char]
 352 --
 353 cCharsToChars :: [CChar] -> [Char]
 354 cCharsToChars xs  = map castCCharToChar xs
 355
 356 -- cast [Char] to [CChar]
 357 --
 358 charsToCChars :: [Char] -> [CChar]
 359 charsToCChars xs  = map castCharToCChar xs
 360 #endif
 361
 362 -----------------------------------------------------------------------------
 363 -- Wide strings
 364
 365 -- representation of wide strings in C
 366 -- -----------------------------------
 367
 368 -- | A C wide string is a reference to an array of C wide characters
 369 -- terminated by NUL.
 370 type CWString    = Ptr CWchar
 371
 372 -- | A wide character string with explicit length information in bytes
 373 -- instead of a terminating NUL (allowing NUL characters in the middle
 374 -- of the string).
 375 type CWStringLen = (Ptr CWchar, Int)
 376
 377 -- | Marshal a NUL terminated C wide string into a Haskell string.
 378 --
 379 peekCWString    :: CWString -> IO String
 380 peekCWString cp  = do
 381   cs <- peekArray0 wNUL cp
 382   return (cWcharsToChars cs)
 383
 384 -- | Marshal a C wide string with explicit length into a Haskell string.
 385 --
 386 peekCWStringLen           :: CWStringLen -> IO String
 387 peekCWStringLen (cp, len)  = do
 388   cs <- peekArray len cp
 389   return (cWcharsToChars cs)
 390
 391 -- | Marshal a Haskell string into a NUL terminated C wide string.
 392 --
 393 -- * the Haskell string may /not/ contain any NUL characters
 394 --
 395 -- * new storage is allocated for the C wide string and must
 396 --   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
 397 --   'Foreign.Marshal.Alloc.finalizerFree'.
 398 --
 399 newCWString :: String -> IO CWString
 400 newCWString  = newArray0 wNUL . charsToCWchars
 401
 402 -- | Marshal a Haskell string into a C wide string (ie, wide character array)
 403 -- with explicit length information.
 404 --
 405 -- * new storage is allocated for the C wide string and must
 406 --   be explicitly freed using 'Foreign.Marshal.Alloc.free' or
 407 --   'Foreign.Marshal.Alloc.finalizerFree'.
 408 --
 409 newCWStringLen     :: String -> IO CWStringLen
 410 newCWStringLen str  = do
 411   a <- newArray (charsToCWchars str)
 412   return (pairLength str a)
 413
 414 -- | Marshal a Haskell string into a NUL terminated C wide string using
 415 -- temporary storage.
 416 --
 417 -- * the Haskell string may /not/ contain any NUL characters
 418 --
 419 -- * the memory is freed when the subcomputation terminates (either
 420 --   normally or via an exception), so the pointer to the temporary
 421 --   storage must /not/ be used after this.
 422 --
 423 withCWString :: String -> (CWString -> IO a) -> IO a
 424 withCWString  = withArray0 wNUL . charsToCWchars
 425
 426 -- | Marshal a Haskell string into a NUL terminated C wide string using
 427 -- temporary storage.
 428 --
 429 -- * the Haskell string may /not/ contain any NUL characters
 430 --
 431 -- * the memory is freed when the subcomputation terminates (either
 432 --   normally or via an exception), so the pointer to the temporary
 433 --   storage must /not/ be used after this.
 434 --
 435 withCWStringLen         :: String -> (CWStringLen -> IO a) -> IO a
 436 withCWStringLen str act  = withArray (charsToCWchars str) $ act . pairLength str
 437
 438 -- auxiliary definitions
 439 -- ----------------------
 440
 441 wNUL :: CWchar
 442 wNUL = 0
 443
 444 cWcharsToChars :: [CWchar] -> [Char]
 445 charsToCWchars :: [Char] -> [CWchar]
 446
 447 #ifdef mingw32_TARGET_OS
 448
 449 -- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.
 450
 451 -- coding errors generate Chars in the surrogate range
 452 cWcharsToChars = map chr . fromUTF16 . map fromIntegral
 453  where
 454   fromUTF16 (c1:c2:wcs)
 455     | 0xd800 <= c1 && c1 <= 0xdbff && 0xdc00 <= c2 && c2 <= 0xdfff =
 456       ((c1 - 0xd800)*0x400 + (c2 - 0xdc00) + 0x10000) : fromUTF16 wcs
 457   fromUTF16 (c:wcs) = c : fromUTF16 wcs
 458   fromUTF16 [] = []
 459
 460 charsToCWchars = foldr utf16Char [] . map ord
 461  where
 462   utf16Char c wcs
 463     | c < 0x10000 = fromIntegral c : wcs
 464     | otherwise   = let c' = c - 0x10000 in
 465                     fromIntegral (c' `div` 0x400 + 0xd800) :
 466                     fromIntegral (c' `mod` 0x400 + 0xdc00) : wcs
 467
 468 #else /* !mingw32_TARGET_OS */
 469
 470 cWcharsToChars xs  = map castCWcharToChar xs
 471 charsToCWchars xs  = map castCharToCWchar xs
 472
 473 -- These conversions only make sense if __STDC_ISO_10646__ is defined
 474 -- (meaning that wchar_t is ISO 10646, aka Unicode)
 475
 476 castCWcharToChar :: CWchar -> Char
 477 castCWcharToChar ch = chr (fromIntegral ch )
 478
 479 castCharToCWchar :: Char -> CWchar
 480 castCharToCWchar ch = fromIntegral (ord ch)
 481
 482 #endif /* !mingw32_TARGET_OS */