bytestring-show-0.3.5.6/0000755000000000000000000000000012316311015013212 5ustar0000000000000000bytestring-show-0.3.5.6/LICENSE0000644000000000000000000001241212316311015014217 0ustar0000000000000000This 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. -----------------------------------------------------------------------------bytestring-show-0.3.5.6/Setup.lhs0000644000000000000000000000034212316311015015021 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > import System.Cmd (system) > main = defaultMainWithHooks (simpleUserHooks { runTests = tests }) > tests _ _ _ _ = system "runhaskell Tests/Properties.hs" >> return () bytestring-show-0.3.5.6/bytestring-show.cabal0000644000000000000000000000264212316311015017352 0ustar0000000000000000name: bytestring-show version: 0.3.5.6 license: BSD3 license-file: LICENSE author: Dan Doel maintainer: Dan Doel 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.6 flag integer-simple default: False description: use with integer-simple build of GHC library build-depends: base < 5, binary < 0.8, bytestring >= 0.9 && <= 1, array < 0.6, containers < 0.6 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 ghc-options: -O2 -Wall if flag(integer-simple) cpp-options: -DINTEGER_SIMPLE build-depends: integer-simple if impl(ghc >= 6.11) && !flag(integer-simple) cpp-options: -DINTEGER_GMP build-depends: integer-gmp >= 0.2 if impl(ghc >= 6.9) && impl(ghc < 6.11) && !flag(integer-simple) cpp-options: -DINTEGER_GMP build-depends: integer >= 0.1 && < 0.2 source-repository head type: darcs location: http://hub.darcs.net/dolio/bytestring-show bytestring-show-0.3.5.6/Text/0000755000000000000000000000000012316311015014136 5ustar0000000000000000bytestring-show-0.3.5.6/Text/Show/0000755000000000000000000000000012316311015015056 5ustar0000000000000000bytestring-show-0.3.5.6/Text/Show/ByteString.hs0000644000000000000000000002143712316311015017513 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -- --------------------------------------------------------------------------- -- | -- 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 integers , showpIntAtBase -- * Putting floats , showpGFloat , showpFFloat , showpEFloat -- * Combining builders , unlinesP , unwordsP , showpParen -- * Printing values , print -- * Put , Put , PutM(..) , runPut ) where import Prelude hiding (Show(..), print, putStrLn) import qualified Prelude import Data.Binary.Put import Data.ByteString.Lazy.Char8 import Data.Int import Data.Word import Data.Ratio import Data.Complex import Data.Array import qualified Data.Map as M import qualified Data.Set as S 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' or 'showpPrec' class Show a where -- | Encodes a value to an efficient byte string builder. -- The precedence is used to determine where to put -- parentheses in a shown expression involving operators. -- -- Values of type Put can be efficiently combined, so the -- showp functions are available for showing multiple values -- before producing an output byte string. showpPrec :: Int -> a -> Put -- | 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 showpPrec _ = showp showp = showpPrec 0 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 -- | A utility function for surrounding output by parentheses -- conditionally. showpParen :: Bool -> Put -> Put showpParen b p | b = putAscii '(' >> p >> putAscii ')' | otherwise = p -- | 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 showpPrec k i = showpParen (i < 0 && k > 0) $ showpInt i instance Show Int8 where showp = showpInt8 showpPrec k i = showpParen (i < 0 && k > 0) $ showpInt8 i instance Show Int16 where showp = showpInt16 showpPrec k i = showpParen (i < 0 && k > 0) $ showpInt16 i instance Show Int32 where showp = showpInt32 showpPrec k i = showpParen (i < 0 && k > 0) $ showpInt32 i instance Show Int64 where showp = showpInt64 showpPrec k i = showpParen (i < 0 && k > 0) $ showpInt64 i 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 Word64 where showp = showpWord64 instance Show Integer where showp = showpInteger showpPrec k i = showpParen (i < 0 && k > 0) $ showpInteger i instance Show Float where showp = showpGFloat Nothing showpPrec k f = showpParen (f < 0 && k > 0) $ showpGFloat Nothing f instance Show Double where showp = showpGFloat Nothing showpPrec k f = showpParen (f < 0 && k > 0) $ showpGFloat Nothing f instance (Show a, Integral a) => Show (Ratio a) where showpPrec k q = showpParen (k > 7) $ showpPrec 8 (numerator q) >> putAscii '%' >> showp (denominator q) instance (Show a, RealFloat a) => Show (Complex a) where showpPrec k (a :+ b) = showpParen (k > 6) $ showpPrec 7 a >> putAscii ' ' >> putAscii ':' >> putAscii '+' >> putAscii ' ' >> showpPrec 7 b instance Show a => Show (Maybe a) where showpPrec _ Nothing = putAsciiStr "Nothing" showpPrec k (Just a) = showpParen (k > 10) $ putAsciiStr "Just " >> showpPrec 11 a instance (Show a, Show b) => Show (Either a b) where showpPrec k (Left a) = showpParen (k > 10) $ putAsciiStr "Left " >> showpPrec 11 a showpPrec k (Right b) = showpParen (k > 10) $ putAsciiStr "Right " >> showpPrec 11 b instance Show Ordering where showp LT = putAscii 'L' >> putAscii 'T' showp EQ = putAscii 'E' >> putAscii 'Q' showp GT = putAscii 'G' >> putAscii 'T' 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 ')' instance (Show i, Show e, Ix i) => Show (Array i e) where showpPrec k a = showpParen (k > 10) $ putAsciiStr "array " >> showp (bounds a) >> putAscii ' ' >> showp (assocs a) instance (Show k, Show v) => Show (M.Map k v) where showpPrec k m = showpParen (k > 10) $ putAsciiStr "fromList " >> showp (M.toList m) instance (Show e) => Show (S.Set e) where showpPrec k s = showpParen (k > 10) $ putAsciiStr "fromList " >> showp (S.toList s) bytestring-show-0.3.5.6/Text/Show/ByteString/0000755000000000000000000000000012316311015017150 5ustar0000000000000000bytestring-show-0.3.5.6/Text/Show/ByteString/Util.hs0000644000000000000000000000437412316311015020431 0ustar0000000000000000{-# 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-0.3.5.6/Text/Show/ByteString/Char.hs0000644000000000000000000000332612316311015020365 0ustar0000000000000000-- --------------------------------------------------------------------------- -- | -- 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 bytestring-show-0.3.5.6/Text/Show/ByteString/Int.hs0000644000000000000000000000635312316311015020245 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE BangPatterns #-} -- --------------------------------------------------------------------------- -- | -- 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. #include "MachDeps.h" 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# #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708 = case i# <# 0# of 1# -> let !(I# minInt#) = minInt #elif __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 611 | i# <# 0# = let !(I# minInt#) = minInt #else | i# <# 0# = let I# minInt# = minInt #endif in case i# ==# minInt# of #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708 1# -> #else True -> #endif putWord8 45 >> putW (int2Word# (negateInt# (i# `quotInt#` 10#))) >> putW (int2Word# (negateInt# (i# `remInt#` 10#))) _ -> putWord8 45 >> putW (int2Word# (negateInt# i#)) #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708 _ -> putW (int2Word# i#) #else | otherwise = putW (int2Word# i#) #endif putW :: Word# -> Put putW w# #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708 = case w# `ltWord#` int2Word# 10# of 1# -> #else | w# `ltWord#` int2Word# 10# = #endif unsafePutDigit# w# #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 708 _ -> #else | otherwise = #endif 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# showpInt64 :: Int64 -> Put #if WORD_SIZE_IN_BITS >= 64 showpInt64 (I64# i#) = putI i# #else /* WORD_SIZE_IN_BITS < 64 */ showpInt64 = putI64 -- Unboxed 64-bit-specific operations aren't exported putI64 :: Int64 -> Put putI64 i | i == minBound = putWord8 45 >> putW64 (fromIntegral $ negate (i `quot` 10)) >> putW64 (fromIntegral $ negate (i `rem` 10)) | i < 0 = putWord8 45 >> putW64 (fromIntegral $ negate i) | otherwise = putW64 (fromIntegral i) #endif 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# showpWord64 :: Word64 -> Put #if WORD_SIZE_IN_BITS >= 64 showpWord64 (W64# w#) = putW w# #else /* WORD_SIZE_IN_BITS < 64 */ showpWord64 = putW64 putW64 :: Word64 -> Put putW64 w | w < 10 = unsafePutDigit64 w | otherwise = putW64 (w `quot` 10) >> unsafePutDigit64 (w `rem` 10) where unsafePutDigit64 w = unsafePutDigit# (case fromIntegral w of (W# w#) -> w#) #endif bytestring-show-0.3.5.6/Text/Show/ByteString/Float.hs0000644000000000000000000000675412316311015020565 0ustar0000000000000000-- --------------------------------------------------------------------------- -- | -- 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-1) (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 bytestring-show-0.3.5.6/Text/Show/ByteString/Integer.hs0000644000000000000000000000704112316311015021103 0ustar0000000000000000{-# LANGUAGE UnboxedTuples, MagicHash, BangPatterns, CPP #-} -- --------------------------------------------------------------------------- -- | -- 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 #if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 611 && INTEGER_GMP import GHC.Integer.Internals #elif __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 611 && INTEGER_GMP import GHC.Integer.GMP.Internals #elif __GLASGOW_HASKELL__ && INTEGER_SIMPLE import GHC.Integer.Simple.Internals #endif 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 #ifdef INTEGER_SIMPLE #elif INTEGER_GMP showpInteger (S# i#) = putI i# #else showpInteger (I# i#) = putI i# #endif 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 #if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE) (# q, r #) -> #else (q, r) -> #endif 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 #if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE) (# q, r #) -> #else (q, r) -> #endif q : r : splitb p ns printh :: [Integer] -> Put printh [ ] = error "printh: the impossible happened." printh (n:ns) = case n `quotRemInteger` mx of #if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE) (# q', r' #) -> #else (q', r') -> #endif 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 #if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE) (# q', r' #) -> #else (q', r') -> #endif 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 -- | Shows an Integral number using the base specified by the first -- argument and the chracter representation specified by the second. showpIntAtBase :: Integral a => a -> (Int -> Char) -> a -> Put showpIntAtBase b f n | n < 0 = putAscii '-' >> showpIntAtBase b f (-n) | n == 0 = putAscii (f 0) | otherwise = let go k | k == 0 = return () | otherwise = go d >> putAscii (f $ fromIntegral m) where (d, m) = k `divMod` b in go n