bytestring-show (empty) → 0.1
raw patch · 10 files changed
+758/−0 lines, 10 filesdep +QuickCheckdep +basedep +binarysetup-changed
Dependencies added: QuickCheck, base, binary, bytestring
Files
- LICENSE +117/−0
- Setup.lhs +7/−0
- Tests/Properties.hs +36/−0
- Text/Show/ByteString.hs +215/−0
- Text/Show/ByteString/Char.hs +51/−0
- Text/Show/ByteString/Float.hs +91/−0
- Text/Show/ByteString/Int.hs +62/−0
- Text/Show/ByteString/Integer.hs +84/−0
- Text/Show/ByteString/Util.hs +64/−0
- bytestring-show.cabal +31/−0
+ LICENSE view
@@ -0,0 +1,117 @@+This library (bytestring-show) contains some code adapted from other works.++ * Printing of various primitive values is adapted largely from the base+ libraries distributed with GHC. The GHC license will be reproduced+ below.++ * Decoding of characters into Word8s according to UTF-8 was+ borrowed from utf8-string, which is (c) Eric Mertens.++ * Significant modifications and original code have been written by+ Dan Doel.++All code is aviailable under a BSD-style or compatibile license:++----------------------------------------------------------------------------++Copyright (c) 2008 Dan Doel++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.++----------------------------------------------------------------------------++The original text of the GHC license is as follows:++----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------++Code derived from the document "The Haskell 98 Foreign Function+Interface, An Addendum to the Haskell 98 Report" is distributed under+the following license:++ Copyright (c) 2002 Manuel M. T. Chakravarty++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Foreign Function Interface.++-----------------------------------------------------------------------------
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> import System.Cmd (system)++> main = defaultMainWithHooks (defaultUserHooks { runTests = tests })++> tests _ _ _ _ = system "runhaskell Tests/Properties.hs" >> return ()
+ Tests/Properties.hs view
@@ -0,0 +1,36 @@++module Main where++import Test.QuickCheck++import Data.Complex+import Data.Int+import Data.Word+import Data.Ratio++import qualified Text.Show.ByteString as S++import qualified Data.ByteString.Lazy.Char8 as L++test_matchesShow :: (Show a, S.Show a, Arbitrary a) => a -> Bool+test_matchesShow a = show a == L.unpack (S.show a)++test_all :: IO ()+test_all = do quickCheck (test_matchesShow :: Int -> Bool)+-- quickCheck (test_matchesShow :: Int8 -> Bool)+-- quickCheck (test_matchesShow :: Int16 -> Bool)+-- quickCheck (test_matchesShow :: Int32 -> Bool)+-- quickCheck (test_matchesShow :: Word -> Bool)+-- quickCheck (test_matchesShow :: Word8 -> Bool)+-- quickCheck (test_matchesShow :: Word16 -> Bool)+-- quickCheck (test_matchesShow :: Word32 -> Bool)+ quickCheck (test_matchesShow :: () -> Bool)+ quickCheck (test_matchesShow :: Integer -> Bool)+ quickCheck (test_matchesShow :: Float -> Bool)+ quickCheck (test_matchesShow :: Double -> Bool)+ quickCheck (test_matchesShow :: Rational -> Bool)+ quickCheck (test_matchesShow :: (Int,Int,Int) -> Bool)+ quickCheck (test_matchesShow :: (Int,Int,Int,Int) -> Bool)+ quickCheck (test_matchesShow :: [Int] -> Bool)++main = test_all
+ Text/Show/ByteString.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE TypeSynonymInstances #-}++-- ---------------------------------------------------------------------------+-- |+-- Module : Text.Show.ByteString+-- Copyright : (c) 2008 Dan Doel+-- Maintainer : Dan Doel+-- Stability : Experimental+-- Portability : Non-portable (type synonym instances)+--+-- Efficiently convert from values to lazy byte strings.++module Text.Show.ByteString ( -- * The Show class+ Show (..)+ , show+ -- * Putting Chars+ , putAscii+ , putUTF8+ -- * Putting Strings+ , putAsciiStr+ , putUTF8Str+ -- * Putting digits+ , unsafePutDigit+ , putDigit+ -- * Putting floats+ , showpGFloat+ , showpFFloat+ , showpEFloat+ -- * Combining builders+ , unlinesP+ , unwordsP+ -- * Printing values+ , print+ ) where++import Prelude hiding (Show(..), print, putStrLn)+import qualified Prelude++import Data.Binary.Put+import Data.ByteString.Lazy++import Data.Int+import Data.Word+import Data.Ratio+import Data.Complex++import Text.Show.ByteString.Util ( putAscii , putUTF8+ , putAsciiStr, putUTF8Str+ , unsafePutDigit+ )++import Text.Show.ByteString.Char+import Text.Show.ByteString.Int+import Text.Show.ByteString.Integer+import Text.Show.ByteString.Float++-- | Conversion of values to readable byte strings.+-- Minimal complete definition: 'showp'+class Show a where+ -- | Encodes a value to an efficient byte string builder.+ -- Values of type Put can be efficiently combined, so this+ -- is available for building strings from multiple values.+ showp :: a -> Put++ -- | Allows for specialized display of lists of values.+ -- This is used, for example, when showing arrays of Chars.+ showpList :: [a] -> Put++ showpList [] = putWord8 91 >> putWord8 93 -- "[]"+ showpList (x:xs) = putWord8 91 >> showp x >> go xs -- "[..+ where+ go (y:ys) = putWord8 44 >> showp y >> go ys -- ..,..+ go [ ] = putWord8 93 -- ..]"++-- | Encode a single value into a byte string+show :: Show a => a -> ByteString+show = runPut . showp++-- | Print a value to the standard output+print :: Show a => a -> IO ()+print = putStrLn . show++-- | Merge several string builders, separating them by newlines+unlinesP :: [Put] -> Put+unlinesP [ ] = return ()+unlinesP (p:ps) = p >> putAscii '\n' >> unlinesP ps++-- | Merge several string builders, separating them by spaces+unwordsP :: [Put] -> Put+unwordsP [ ] = return ()+unwordsP [p] = p+unwordsP (p:ps) = p >> putAscii ' ' >> unwordsP ps++-- | Puts the digit corresponding to the Int passed in.+putDigit :: Int -> Put+putDigit i+ | i < 0 = error $ "putDigit: Negative integer: " ++ Prelude.show i+ | i > 9 = error $ "putDigit: Non-decimal digit: " ++ Prelude.show i+ | otherwise = unsafePutDigit i++-- This may be a bad idea, but I'm trying it out+instance Show Put where+ showp p = p++instance Show () where+ showp () = putAscii '(' >> putAscii ')'++instance Show Char where+ showp = showpChar+ showpList = showpString++instance Show Bool where+ showp True = putAsciiStr "True"+ showp False = putAsciiStr "False"++instance (Show a) => Show [a] where+ showp = showpList++instance Show Int where+ showp = showpInt++instance Show Int8 where+ showp = showpInt8++instance Show Int16 where+ showp = showpInt16++instance Show Int32 where+ showp = showpInt32++instance Show Word where+ showp = showpWord++instance Show Word8 where+ showp = showpWord8++instance Show Word16 where+ showp = showpWord16++instance Show Word32 where+ showp = showpWord32++instance Show Integer where+ showp = showpInteger++instance Show Float where+ showp = showpGFloat Nothing++instance Show Double where+ showp = showpGFloat Nothing++instance (Show a, Integral a) => Show (Ratio a) where+ showp q = wrap (numerator q) >>+ putAscii '%' >>+ showp (denominator q)+ where+ wrap n+ | n < 0 = putAscii '(' >> showp n >> putAscii ')'+ | otherwise = showp n++instance (Show a, RealFloat a) => Show (Complex a) where+ showp (a :+ b) = showp a >>+ putAscii ' ' >> putAscii ':' >> putAscii '+' >> putAscii ' ' >>+ showp b++instance Show a => Show (Maybe a) where+ showp Nothing = putAsciiStr "Nothing"+ showp (Just a) = putAsciiStr "Just " >> showp a++instance (Show a, Show b) => Show (a,b) where+ showp (a,b) = putAscii '(' >> showp a >> putAscii ',' >> showp b >> putAscii ')'++instance (Show a, Show b, Show c) => Show (a,b,c) where+ showp (a,b,c) = putAscii '(' >> showp a >>+ putAscii ',' >> showp b >>+ putAscii ',' >> showp c >>+ putAscii ')'++instance (Show a, Show b, Show c, Show d) => Show (a,b,c,d) where+ showp (a,b,c,d) =+ putAscii '(' >> showp a >>+ putAscii ',' >> showp b >>+ putAscii ',' >> showp c >>+ putAscii ',' >> showp d >>+ putAscii ')'++instance (Show a, Show b, Show c, Show d, Show e) => Show (a,b,c,d,e) where+ showp (a,b,c,d,e) =+ putAscii '(' >> showp a >>+ putAscii ',' >> showp b >>+ putAscii ',' >> showp c >>+ putAscii ',' >> showp d >>+ putAscii ',' >> showp e >>+ putAscii ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where+ showp (a,b,c,d,e,f) =+ putAscii '(' >> showp a >>+ putAscii ',' >> showp b >>+ putAscii ',' >> showp c >>+ putAscii ',' >> showp d >>+ putAscii ',' >> showp e >>+ putAscii ',' >> showp f >>+ putAscii ')'++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) => Show (a,b,c,d,e,f,g) where+ showp (a,b,c,d,e,f,g) =+ putAscii '(' >> showp a >>+ putAscii ',' >> showp b >>+ putAscii ',' >> showp c >>+ putAscii ',' >> showp d >>+ putAscii ',' >> showp e >>+ putAscii ',' >> showp f >>+ putAscii ',' >> showp g >>+ putAscii ')'
+ Text/Show/ByteString/Char.hs view
@@ -0,0 +1,51 @@+-- ---------------------------------------------------------------------------+-- |+-- Module : Text.Show.ByteString.Char+-- Copyright : (c) 2008 Dan Doel+-- Maintainer : Dan Doel+-- Stability : Experimental+-- Portability : Portable+--+-- Putting characters.+--+-- Functions based on GHC.Show in base++module Text.Show.ByteString.Char where++import Data.Binary+import Data.Char++import Text.Show.ByteString.Util++asciiTab :: [String]+asciiTab = ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",+ "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",+ "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",+ "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", "SP"]++putLitChar :: Char -> Put+putLitChar '\DEL' = putAsciiStr "\\DEL"+putLitChar '\\' = putAscii '\\' >> putAscii '\\'+putLitChar c | c >= ' ' = putUTF8 c+putLitChar '\a' = putAscii '\\' >> putAscii 'a'+putLitChar '\b' = putAscii '\\' >> putAscii 'b'+putLitChar '\f' = putAscii '\\' >> putAscii 'f'+putLitChar '\n' = putAscii '\\' >> putAscii 'n'+putLitChar '\r' = putAscii '\\' >> putAscii 'r'+putLitChar '\t' = putAscii '\\' >> putAscii 't'+putLitChar '\v' = putAscii '\\' >> putAscii 'v'+putLitChar '\SO' = putAscii '\\' >> putAscii 'S' >> putAscii 'O'+putLitChar c = putAscii '\\' >> putAsciiStr (asciiTab !! ord c)++showpChar :: Char -> Put+showpChar c = putAscii '\'' >> putEscaped c >> putAscii '\''+ where+ putEscaped '\'' = putAscii '\\' >> putAscii '\''+ putEscaped c' = putLitChar c'++showpString :: String -> Put+showpString xs = putAscii '"' >> mapM_ putEscaped xs >> putAscii '"'+ where+ putEscaped '"' = putAscii '\\' >> putAscii '"'+ putEscaped '\SO' = putAsciiStr "\\SO\\&"+ putEscaped c = putLitChar c
+ Text/Show/ByteString/Float.hs view
@@ -0,0 +1,91 @@+-- ---------------------------------------------------------------------------+-- |+-- Module : Text.Show.ByteString.Float+-- Copyright : (c) 2008 Dan Doel+-- Maintainer : Dan Doel+-- Stability : Experimental+-- Portability : Non-portable (magic hash)+--+-- Putting floating point values.+--+-- The code in this module is heavily based on GHC.Float++module Text.Show.ByteString.Float where++import GHC.Float++import Control.Monad++import Data.Binary++import Text.Show.ByteString.Util+import Text.Show.ByteString.Int++-- | Show a signed RealFloat value using decimal notation when the+-- absolute value lies between 0.1 and 9,999,999, and scientific+-- notation otherwise. The optional integer can be used to specify+-- precision.+showpGFloat :: RealFloat a => Maybe Int -> a -> Put+showpGFloat = putFormattedFloat FFGeneric++-- | Show a signed RealFloat value using decimal notation. The optional+-- integer can be used to specify precision.+showpFFloat :: RealFloat a => Maybe Int -> a -> Put+showpFFloat = putFormattedFloat FFFixed++-- | Show a signed RealFloat value using scientific (exponential) notation.+-- The optional integer can be used to specify precision.+showpEFloat :: RealFloat a => Maybe Int -> a -> Put+showpEFloat = putFormattedFloat FFExponent++putFormattedFloat :: RealFloat a => FFFormat -> Maybe Int -> a -> Put+putFormattedFloat fmt decs f+ | isNaN f = putAscii 'N' >> putAscii 'a' >> putAscii 'N'+ | isInfinite f = putAsciiStr (if f < 0 then "-Infinity" else "Infinity")+ | f < 0 || isNegativeZero f = putAscii '-' >> go fmt (floatToDigits (toInteger base) (-f))+ | otherwise = go fmt (floatToDigits (toInteger base) f)+ where+ base = 10+ + go FFGeneric p@(_,e)+ | e < 0 || e > 7 = go FFExponent p+ | otherwise = go FFFixed p+ go FFExponent (is, e) =+ case decs of+ Nothing -> case is of+ [] -> error "putFormattedFloat"+ [0] -> putAsciiStr "0.0e0"+ [d] -> unsafePutDigit d >> putAsciiStr ".0e" >> showpInt e+ (d:ds) -> unsafePutDigit d >> putAscii '.' >> mapM_ unsafePutDigit ds+ >> putAscii 'e' >> showpInt (e-1)+ Just dec ->+ let dec' = max dec 1 in+ case is of+ [0] -> putAscii '0' >> putAscii '.' >> replicateM_ dec' (putAscii '0')+ >> putAscii 'e' >> putAscii '0'+ _ ->+ let (ei, is') = roundTo base (dec'+1) is+ (d:ds) = if ei > 0 then init is' else is'+ in unsafePutDigit d >> putAscii '.' >> mapM_ unsafePutDigit ds+ >> putAscii 'e' >> showpInt (e - 1 + ei)+ go FFFixed (is, e) = case decs of+ Nothing+ | e <= 0 -> putAscii '0' >> putAscii '.' >> replicateM_ (-e) (putAscii '0')+ >> mapM_ unsafePutDigit is+ | otherwise -> let g 0 rs = putAscii '.' >> mk0 rs+ g n [] = putAscii '0' >> g (n-1) []+ g n (r:rs) = unsafePutDigit r >> g (n-1) rs+ in g e is+ Just dec ->+ let dec' = max dec 0 in+ if e >= 0 then+ let (ei, is') = roundTo base (dec' + e) is+ (ls,rs) = splitAt (e+ei) is'+ in mk0 ls >> when (not $ null rs) (putAscii '.' >> mapM_ unsafePutDigit rs)+ else+ let (ei, is') = roundTo base dec' (replicate (-e) 0 ++ is)+ d:ds = if ei > 0 then is' else 0:is'+ in unsafePutDigit d >> when (not $ null ds) (putAscii '.' >> mapM_ unsafePutDigit ds)+ + mk0 [] = putAscii '0'+ mk0 rs = mapM_ unsafePutDigit rs
+ Text/Show/ByteString/Int.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE MagicHash #-}++-- ---------------------------------------------------------------------------+-- |+-- Module : Text.Show.ByteString.Int+-- Copyright : (c) 2008 Dan Doel+-- Maintainer : Dan Doel+-- Stability : Experimental+-- Portability : Non-portable (magic hash)+--+-- Putting integers and words.+--+-- The code in this module is based on the printing in the GHC modules.++module Text.Show.ByteString.Int where++import GHC.Base+import GHC.Int+import GHC.Word++import Data.Binary++import Text.Show.ByteString.Util++putI :: Int# -> Put+putI i#+ | i# <# 0# = let I# minInt# = minInt+ in if i# ==# minInt#+ then putWord8 45 >> putW (int2Word# (negateInt# (i# `quotInt#` 10#)))+ >> putW (int2Word# (negateInt# (i# `remInt#` 10#)))+ else putWord8 45 >> putW (int2Word# (negateInt# i#))+ | otherwise = putW (int2Word# i#)++putW :: Word# -> Put+putW w#+ | w# `ltWord#` int2Word# 10# = unsafePutDigit# w#+ | otherwise = putW (w# `quotWord#` int2Word# 10#)+ >> unsafePutDigit# (w# `remWord#` int2Word# 10#)++showpInt :: Int -> Put+showpInt (I# i#) = putI i#++showpInt8 :: Int8 -> Put+showpInt8 (I8# i#) = putI i#++showpInt16 :: Int16 -> Put+showpInt16 (I16# i#) = putI i#++showpInt32 :: Int32 -> Put+showpInt32 (I32# i#) = putI i#++showpWord :: Word -> Put+showpWord (W# w#) = putW w#++showpWord8 :: Word8 -> Put+showpWord8 (W8# w#) = putW w#++showpWord16 :: Word16 -> Put+showpWord16 (W16# w#) = putW w#++showpWord32 :: Word32 -> Put+showpWord32 (W32# w#) = putW w#
+ Text/Show/ByteString/Integer.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE MagicHash, BangPatterns #-}++-- ---------------------------------------------------------------------------+-- |+-- Module : Text.Show.ByteString.Integer+-- Copyright : (c) 2008 Dan Doel+-- Maintainer : Dan Doel+-- Stability : Experimental+-- Portability : Non-portable (magic hash, bang patterns)+--+-- Putting unbounded integers.+--+-- This code is based off the integer showing code in GHC.++module Text.Show.ByteString.Integer where++import GHC.Base+import GHC.Num++import Data.Binary.Put++import Text.Show.ByteString.Util+import Text.Show.ByteString.Int++mx :: Integer+ds :: Int+(mx, ds) = until ((>mi) . (*10) . fst) (\(n,d) -> (n*10,d+1)) (10,1)+ where mi = fromIntegral (maxBound :: Int)++showpInteger :: Integer -> Put+showpInteger (S# i#) = putI i#+showpInteger n+ | n < 0 = putAscii '-' >> posIntegerPut (-n)+ | otherwise = posIntegerPut n++posIntegerPut :: Integer -> Put+posIntegerPut n+ | n < mx = case fromInteger n of+ I# i# -> putI i#+ | otherwise = printh (splitf (mx*mx) n)++splitf :: Integer -> Integer -> [Integer]+splitf p n+ | p > n = [n]+ | otherwise = splith p (splitf (p*p) n)++splith :: Integer -> [Integer] -> [Integer]+splith _ [ ] = error "splith: the impossible happened."+splith p (n:ns) = case n `quotRemInteger` p of+ (q, r) -> if q > 0+ then q : r : splitb p ns+ else r : splitb p ns++splitb :: Integer -> [Integer] -> [Integer]+splitb _ [ ] = []+splitb p (n:ns) = case n `quotRemInteger` p of+ (q, r) -> q : r : splitb p ns++printh :: [Integer] -> Put+printh [ ] = error "printh: the impossible happened."+printh (n:ns) = case n `quotRemInteger` mx of+ (q', r') -> let q = fromInteger q'+ r = fromInteger r'+ in if q > 0 then phead q >> pblock r >> printb ns+ else phead r >> printb ns++printb :: [Integer] -> Put+printb [ ] = return ()+printb (n:ns) = case n `quotRemInteger` mx of+ (q', r') -> let q = fromInteger q'+ r = fromInteger r'+ in pblock q >> pblock r >> printb ns++phead :: Int -> Put+phead (I# i#) = putI i#++pblock :: Int -> Put+pblock = pblock' ds++pblock' :: Int -> Int -> Put+pblock' d !n+ | d == 1 = unsafePutDigit n+ | otherwise = pblock' (d-1) q >> unsafePutDigit r+ where (q, r) = n `quotRemInt` 10
+ Text/Show/ByteString/Util.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE MagicHash #-}++-- ---------------------------------------------------------------------------+-- |+-- Module : Text.Show.ByteString.Util+-- Copyright : (c) 2008 Dan Doel+-- Maintainer : Dan Doel+-- Stability : Experimental+-- Portability : Non-portable (magic hash, GHC libraries)+--+-- Utility functions for producing readable byte strings.++module Text.Show.ByteString.Util ( putAscii+ , putUTF8+ , putAsciiStr+ , putUTF8Str+ , unsafePutDigit+ , unsafePutDigit#+ ) where++import GHC.Base+import GHC.Word++import Data.Binary+import Data.Bits++import Data.ByteString.Internal (c2w)++-- | Writes a single Char to a byte string, assuming it's ascii.+putAscii :: Char -> Put+putAscii = putWord8 . c2w++-- | Writes a single Char to a byte string, properly UTF-8 encoded+putUTF8 :: Char -> Put+putUTF8 c+ | oc <= 0x7f = putWord8 (fromIntegral oc)+ | oc <= 0x7ff = do putWord8 . fromIntegral $ 0xc0 + (oc `shiftR` 6)+ putWord8 . fromIntegral $ 0x80 + oc .&. 0x3f+ | oc <= 0xffff = do putWord8 . fromIntegral $ 0xf0 + (oc `shiftR` 12)+ putWord8 . fromIntegral $ 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ putWord8 . fromIntegral $ 0x80 + oc .&. 0x3f+ | otherwise = do putWord8 . fromIntegral $ 0xf0 + (oc `shiftR` 18)+ putWord8 . fromIntegral $ 0x80 + ((oc `shiftR` 12) .&. 0x3f)+ putWord8 . fromIntegral $ 0x80 + ((oc `shiftR` 6) .&. 0x3f)+ putWord8 . fromIntegral $ 0x80 + oc .&. 0x3f+ where+ oc = ord c++-- | Writes a string of ascii characters to a byte string+putAsciiStr :: String -> Put+putAsciiStr = mapM_ putAscii++-- | Writes a string of unicode characters to a byte string,+-- properly UTF-8 encoded+putUTF8Str :: String -> Put+putUTF8Str = mapM_ putUTF8++-- | Puts the decimal digit corresponding to the given Int without+-- checking that it is in the interval [0,9]+unsafePutDigit :: Int -> Put+unsafePutDigit (I# i#) = unsafePutDigit# (int2Word# i#)++unsafePutDigit# :: Word# -> Put+unsafePutDigit# w# = putWord8 (W8# (w# `plusWord#` int2Word# 48#))
+ bytestring-show.cabal view
@@ -0,0 +1,31 @@+Name: bytestring-show+Version: 0.1+License: BSD3+License-File: LICENSE+Author: Dan Doel+Maintainer: Dan Doel <dan.doel@gmail.com>+Homepage: http://code.haskell.org/~dolio/+Category: Text+Synopsis: Efficient conversion of values into readable byte strings.+Description: Efficient conversion of values into readable byte strings.+Build-Type: Simple+Cabal-Version: >= 1.2++Library+ Build-Depends: base, binary, bytestring >= 0.9, QuickCheck++ Exposed-Modules:+ Text.Show.ByteString++ Other-Modules:+ Text.Show.ByteString.Util+ Text.Show.ByteString.Char+ Text.Show.ByteString.Int+ Text.Show.ByteString.Float+ Text.Show.ByteString.Integer++ Extensions:+ MagicHash, BangPatterns, TypeSynonymInstances++ GHC-Options:+ -O2 -Wall