Commits

Bryan O'Sullivan committed 390ea7f

Render hex.

Comments (0)

Files changed (5)

Data/Text/Buildable.hs

-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
 
 -- |
 -- 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 (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
 
     build = fromString
     {-# INLINE build #-}
 
+instance (Integral a) => Buildable (Hex a) where
+    build = hexadecimal
+    {-# INLINE build #-}
+
 instance Buildable Int8 where
     build = decimal
     {-# INLINE build #-}
 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

Data/Text/Format.hs

     -- * Format control
     , left
     , right
+    -- ** Integers
+    , hex
     -- ** Floating point numbers
     , expt
     , expt_
 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)
 -- 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.
 -- 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

Data/Text/Format/Int.hs

 module Data.Text.Format.Int
     (
       decimal
+    , hexadecimal
     , minus
     ) where
 
 {-# 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
     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 = 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
                         PAIR(q,r) -> q : r : splitb p ns
     splitb _ _      = []
 
-data T = T !Integer !Int
+    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 -> Integer
-fstT (T a _) = a
+    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)
+    maxInt | base == 10 = maxInt10
+           | otherwise  = maxInt16
+    maxDigits | base == 10 = maxDigits10
+              | otherwise  = maxDigits16
 
-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"
+    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
+    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
+    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

Data/Text/Format/Types.hs

       Format
     , Only(..)
     , Shown(..)
+    -- * Integer format control
+    , Hex(..)
     -- * Floating point format control
     , FPControl
     , Fast(..)

Data/Text/Format/Types/Internal.hs

       Format(..)
     , Only(..)
     , Shown(..)
+    -- * Integer format control
+    , Hex(..)
     -- * Floating point format control
     , Fast(..)
     , FPControl(..)
 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@).
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.