[commit: bytestring] master: Throw exception in IO for functions in IO (f85488d)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/f85488d2bf315792c70bbc6ecd77c4839ef6217d

>---------------------------------------------------------------

commit f85488d2bf315792c70bbc6ecd77c4839ef6217d
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Sat Nov 5 16:32:59 2011 +0000

    Throw exception in IO for functions in IO
    Tracked down by Gershom Bazerman

>---------------------------------------------------------------

 Data/ByteString.hs      |   13 ++++++++++---
 Data/ByteString/Lazy.hs |    2 ++
 2 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/Data/ByteString.hs b/Data/ByteString.hs
index 9d28d3e..776c9c1 100644
--- a/Data/ByteString.hs
+++ b/Data/ByteString.hs
@@ -229,7 +229,7 @@ import Data.Maybe               (isJust, listToMaybe)
 
 -- Control.Exception.assert not available in yhc or nhc
 #ifndef __NHC__
-import Control.Exception        (finally, bracket, assert)
+import Control.Exception        (finally, bracket, assert, throwIO)
 #else
 import Control.Exception	(bracket, finally)
 #endif
@@ -1738,7 +1738,7 @@ packCStringLen :: CStringLen -> IO ByteString
 packCStringLen (cstr, len) | len >= 0 = create len $ \p ->
     memcpy p (castPtr cstr) (fromIntegral len)
 packCStringLen (_, len) =
-    moduleError "packCStringLen" ("negative length: " ++ show len)
+    moduleErrorIO "packCStringLen" ("negative length: " ++ show len)
 
 ------------------------------------------------------------------------
 
@@ -2115,9 +2115,16 @@ errorEmptyList fun = moduleError fun "empty ByteString"
 {-# NOINLINE errorEmptyList #-}
 
 moduleError :: String -> String -> a
-moduleError fun msg = error ("Data.ByteString." ++ fun ++ ':':' ':msg)
+moduleError fun msg = error (moduleErrorMsg fun msg)
 {-# NOINLINE moduleError #-}
 
+moduleErrorIO :: String -> String -> IO a
+moduleErrorIO fun msg = throwIO (userError (moduleErrorMsg fun msg))
+{-# NOINLINE moduleErrorIO #-}
+
+moduleErrorMsg :: String -> String -> String
+moduleErrorMsg fun msg = "Data.ByteString." ++ fun ++ ':':' ':msg
+
 -- Find from the end of the string using predicate
 findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
 STRICT2(findFromEndUntil)
diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs
index 7c3b9a5..4aa91f2 100644
--- a/Data/ByteString/Lazy.hs
+++ b/Data/ByteString/Lazy.hs
@@ -1347,9 +1347,11 @@ interact transformer = putStr . transformer =<< getContents
 -- constant strings created when compiled:
 errorEmptyList :: String -> a
 errorEmptyList fun = moduleError fun "empty ByteString"
+{-# NOINLINE errorEmptyList #-}
 
 moduleError :: String -> String -> a
 moduleError fun msg = error ("Data.ByteString.Lazy." ++ fun ++ ':':' ':msg)
+{-# NOINLINE moduleError #-}
 
 
 -- reverse a list of non-empty chunks into a lazy ByteString