Permalink
Browse files

Render hex.

  • Loading branch information...
1 parent 61ff642 commit 3939af9a001de9289230c4a78cf76131ed0b84cc @bos committed May 23, 2011
Showing with 103 additions and 45 deletions.
  1. +17 −3 Data/Text/Buildable.hs
  2. +10 −3 Data/Text/Format.hs
  3. +68 −39 Data/Text/Format/Int.hs
  4. +2 −0 Data/Text/Format/Types.hs
  5. +6 −0 Data/Text/Format/Types/Internal.hs
View
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
-- |
-- Module : Data.Text.Buildable
@@ -19,17 +19,18 @@ module Data.Text.Buildable
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Ratio (Ratio, denominator, numerator)
import Data.Text.Format.Functions ((<>))
-import Data.Text.Format.Int (decimal)
+import Data.Text.Format.Int (decimal, hexadecimal)
import Data.Text.Format.RealFloat (formatRealFloat, showFloat)
import Data.Text.Format.RealFloat.Fast (DispFloat, formatFloat, fshowFloat)
-import Data.Text.Format.Types (Fast(..), Shown(..))
+import Data.Text.Format.Types (Fast(..), Hex(..), Shown(..))
import Data.Text.Format.Types.Internal (FPControl(..))
import Data.Text.Lazy.Builder
import Data.Time.Calendar (Day, showGregorian)
import Data.Time.Clock (DiffTime, NominalDiffTime, UTCTime, UniversalTime)
import Data.Time.Clock (getModJulianDate)
import Data.Time.LocalTime (LocalTime, TimeOfDay, TimeZone, ZonedTime)
import Data.Word (Word, Word8, Word16, Word32, Word64)
+import Foreign.Ptr (IntPtr, WordPtr, Ptr, ptrToWordPtr)
import qualified Data.Text as ST
import qualified Data.Text.Lazy as LT
@@ -56,6 +57,10 @@ instance Buildable [Char] where
build = fromString
{-# INLINE build #-}
+instance (Integral a) => Buildable (Hex a) where
+ build = hexadecimal
+ {-# INLINE build #-}
+
instance Buildable Int8 where
build = decimal
{-# INLINE build #-}
@@ -163,3 +168,12 @@ instance Buildable LocalTime where
instance Buildable ZonedTime where
build = build . Shown
{-# INLINE build #-}
+
+instance Buildable IntPtr where
+ build p = fromText "0x" <> hexadecimal p
+
+instance Buildable WordPtr where
+ build p = fromText "0x" <> hexadecimal p
+
+instance Buildable (Ptr a) where
+ build = build . ptrToWordPtr
View
@@ -27,6 +27,8 @@ module Data.Text.Format
-- * Format control
, left
, right
+ -- ** Integers
+ , hex
-- ** Floating point numbers
, expt
, expt_
@@ -38,7 +40,7 @@ import qualified Data.Text.Buildable as B
import Data.Text.Format.Params (Params(..))
import Data.Text.Format.Functions ((<>))
import Data.Text.Format.Types.Internal (FPControl(..), FPFormat(..), Fast(..))
-import Data.Text.Format.Types.Internal (Format(..), Only(..), Shown(..))
+import Data.Text.Format.Types.Internal (Format(..), Hex(..), Only(..), Shown(..))
import Data.Text.Lazy.Builder
import Prelude hiding (exp, print)
import System.IO (Handle)
@@ -73,13 +75,13 @@ hprint h fmt ps = LT.hPutStr h . toLazyText $ build fmt ps
-- characters wide, if necessary filling with character @c@.
left :: B.Buildable a => Int -> Char -> a -> Builder
left k c =
- fromLazyText . LT.justifyLeft (fromIntegral k) c . toLazyText . B.build
+ fromLazyText . LT.justifyRight (fromIntegral k) c . toLazyText . B.build
-- | Pad the right hand side of a string until it reaches @k@
-- characters wide, if necessary filling with character @c@.
right :: B.Buildable a => Int -> Char -> a -> Builder
right k c =
- fromLazyText . LT.justifyRight (fromIntegral k) c . toLazyText . B.build
+ fromLazyText . LT.justifyLeft (fromIntegral k) c . toLazyText . B.build
-- ^ Render a floating point number using normal notation, with the
-- given number of decimal places.
@@ -105,3 +107,8 @@ expt decs = B.build . FPControl Exponent (Just decs)
-- notation (e.g. @2.3e123@).
expt_ :: (B.Buildable a, RealFloat a) => a -> Builder
expt_ = B.build . FPControl Exponent Nothing
+
+-- ^ Render an integer using hexadecimal notation. (No leading "0x"
+-- is added.)
+hex :: Integral a => a -> Builder
+hex = B.build . Hex
View
@@ -12,6 +12,7 @@
module Data.Text.Format.Int
(
decimal
+ , hexadecimal
, minus
) where
@@ -49,28 +50,56 @@ decimal :: Integral a => a -> Builder
{-# SPECIALIZE decimal :: Word16 -> Builder #-}
{-# SPECIALIZE decimal :: Word32 -> Builder #-}
{-# SPECIALIZE decimal :: Word64 -> Builder #-}
-{-# RULES "decimal/Integer" decimal = integer :: Integer -> Builder #-}
+{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
decimal i
| i < 0 = minus <> go (-i)
| otherwise = go i
where
go n | n < 10 = digit n
| otherwise = go (n `quot` 10) <> digit (n `rem` 10)
+hexadecimal :: Integral a => a -> Builder
+{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
+{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
+{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}
+hexadecimal i
+ | i < 0 = minus <> go (-i)
+ | otherwise = go i
+ where
+ go n | n < 16 = hexDigit n
+ | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
+
digit :: Integral a => a -> Builder
digit n = singleton $! i2d (fromIntegral n)
{-# INLINE digit #-}
+hexDigit :: Integral a => a -> Builder
+hexDigit n
+ | n <= 9 = singleton $! i2d (fromIntegral n)
+ | otherwise = singleton $! toEnum (fromIntegral n + 87)
+{-# INLINE hexDigit #-}
+
minus :: Builder
minus = singleton '-'
int :: Int -> Builder
int = decimal
{-# INLINE int #-}
-integer :: Integer -> Builder
-integer (S# i#) = int (I# i#)
-integer i
+data T = T !Integer !Int
+
+integer :: Int -> Integer -> Builder
+integer 10 (S# i#) = decimal (I# i#)
+integer 16 (S# i#) = hexadecimal (I# i#)
+integer base i
| i < 0 = minus <> go (-i)
| otherwise = go i
where
@@ -90,38 +119,38 @@ integer i
PAIR(q,r) -> q : r : splitb p ns
splitb _ _ = []
-data T = T !Integer !Int
-
-fstT :: T -> Integer
-fstT (T a _) = a
-
-maxInt :: Integer
-maxDigits :: Int
-T maxInt maxDigits =
- until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
- where mi = fromIntegral (maxBound :: Int)
-
-putH :: [Integer] -> Builder
-putH (n:ns) = case n `quotRemInteger` maxInt of
- PAIR(x,y)
- | q > 0 -> int q <> pblock r <> putB ns
- | otherwise -> int r <> putB ns
- where q = fromInteger x
- r = fromInteger y
-putH _ = error "putH: the impossible happened"
-
-putB :: [Integer] -> Builder
-putB (n:ns) = case n `quotRemInteger` maxInt of
- PAIR(x,y) -> pblock q <> pblock r <> putB ns
- where q = fromInteger x
- r = fromInteger y
-putB _ = mempty
-
-pblock :: Int -> Builder
-pblock = go maxDigits
- where
- go !d !n
- | d == 1 = digit n
- | otherwise = go (d-1) q <> digit r
- where q = n `quotInt` 10
- r = n `remInt` 10
+ T maxInt10 maxDigits10 =
+ until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
+ where mi = fromIntegral (maxBound :: Int)
+ T maxInt16 maxDigits16 =
+ until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)
+ where mi = fromIntegral (maxBound :: Int)
+
+ fstT (T a _) = a
+
+ maxInt | base == 10 = maxInt10
+ | otherwise = maxInt16
+ maxDigits | base == 10 = maxDigits10
+ | otherwise = maxDigits16
+
+ putH (n:ns) = case n `quotRemInteger` maxInt of
+ PAIR(x,y)
+ | q > 0 -> int q <> pblock r <> putB ns
+ | otherwise -> int r <> putB ns
+ where q = fromInteger x
+ r = fromInteger y
+ putH _ = error "putH: the impossible happened"
+
+ putB (n:ns) = case n `quotRemInteger` maxInt of
+ PAIR(x,y) -> pblock q <> pblock r <> putB ns
+ where q = fromInteger x
+ r = fromInteger y
+ putB _ = mempty
+
+ pblock = loop maxDigits
+ where
+ loop !d !n
+ | d == 1 = digit n
+ | otherwise = loop (d-1) q <> digit r
+ where q = n `quotInt` base
+ r = n `remInt` base
@@ -16,6 +16,8 @@ module Data.Text.Format.Types
Format
, Only(..)
, Shown(..)
+ -- * Integer format control
+ , Hex(..)
-- * Floating point format control
, FPControl
, Fast(..)
@@ -16,6 +16,8 @@ module Data.Text.Format.Types.Internal
Format(..)
, Only(..)
, Shown(..)
+ -- * Integer format control
+ , Hex(..)
-- * Floating point format control
, Fast(..)
, FPControl(..)
@@ -55,6 +57,10 @@ instance Monoid Format where
instance IsString Format where
fromString = Format . fromString
+-- | Render an integral type in hexadecimal.
+newtype Hex a = Hex a
+ deriving (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
+
-- | Control the rendering of floating point numbers.
data FPFormat = Exponent
-- ^ Scientific notation (e.g. @2.3e123@).

0 comments on commit 3939af9

Please sign in to comment.