[commit: packages/binary] master: Add 'putList' instance for Char. (bb74506)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/bb74506447397337fa3feaafdac1d714ea184358

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

commit bb74506447397337fa3feaafdac1d714ea184358
Author: Lennart Kolmodin <kolmodin at gmail.com>
Date:   Sun Apr 3 22:03:00 2016 +0200

    Add 'putList' instance for Char.
    
    This speeds up the UTF8 encoding of String with about 70%.
    
    The small String benchmark;
      "small Strings"  :      3459.04 us        1037.00 us      -70.0%
    
    GenericsBench bechmark encodes a data type with many Strings;
      encode           :     46391.59 us       13116.85 us      -71.7%


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

bb74506447397337fa3feaafdac1d714ea184358
 src/Data/Binary/Builder.hs | 6 ++++++
 src/Data/Binary/Class.hs   | 1 +
 src/Data/Binary/Put.hs     | 5 +++++
 3 files changed, 12 insertions(+)

diff --git a/src/Data/Binary/Builder.hs b/src/Data/Binary/Builder.hs
index 976f156..9da9e0e 100644
--- a/src/Data/Binary/Builder.hs
+++ b/src/Data/Binary/Builder.hs
@@ -65,6 +65,7 @@ module Data.Binary.Builder (
 
       -- ** Unicode
     , putCharUtf8
+    , putStringUtf8
     ) where
 
 import qualified Data.ByteString      as S
@@ -264,3 +265,8 @@ putInt64host = Prim.primFixed Prim.int64Host
 putCharUtf8 :: Char -> Builder
 putCharUtf8 = Prim.primBounded Prim.charUtf8
 {-# INLINE putCharUtf8 #-}
+
+-- | Write a String using UTF-8 encoding.
+putStringUtf8 :: String -> Builder
+putStringUtf8 = Prim.primMapListBounded Prim.charUtf8
+{-# INLINE putStringUtf8 #-}
diff --git a/src/Data/Binary/Class.hs b/src/Data/Binary/Class.hs
index 071b2f0..8da3787 100644
--- a/src/Data/Binary/Class.hs
+++ b/src/Data/Binary/Class.hs
@@ -421,6 +421,7 @@ instance (Binary a,Integral a) => Binary (R.Ratio a) where
 -- Char is serialised as UTF-8
 instance Binary Char where
     put = putCharUtf8
+    putList str = put (length str) >> putStringUtf8 str
     get = do
         let getByte = liftM (fromIntegral :: Word8 -> Int) get
             shiftL6 = flip shiftL 6 :: Int -> Int
diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs
index 70501d1..85ef569 100644
--- a/src/Data/Binary/Put.hs
+++ b/src/Data/Binary/Put.hs
@@ -67,6 +67,7 @@ module Data.Binary.Put (
 
     -- * Unicode
     , putCharUtf8
+    , putStringUtf8
 
   ) where
 
@@ -323,3 +324,7 @@ putCharUtf8 :: Char -> Put
 putCharUtf8 = tell . B.putCharUtf8
 {-# INLINE putCharUtf8 #-}
 
+-- | Write a String using UTF-8 encoding.
+putStringUtf8 :: String -> Put
+putStringUtf8 = tell . B.putStringUtf8
+{-# INLINE putStringUtf8 #-}