#if !defined(TEXT_FORMAT)
#endif
module Text.Show.Text.Data.Integral (
showbIntPrec
, showbInt8Prec
, showbInt16Prec
, showbInt32Prec
, showbInt64Prec
, showbIntegerPrec
, showbIntegralPrec
, showbIntAtBase
, showbBin
, showbHex
, showbOct
, showbRatioPrec
, showbWord
, showbWord8
, showbWord16
, showbWord32
, showbWord64
) where
import Data.Char (intToDigit)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Monoid (mempty)
import Data.Ratio (Ratio, numerator, denominator)
import Data.Text.Lazy.Builder (Builder)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import GHC.Exts (Int(I#))
#if __GLASGOW_HASKELL__ >= 708
import GHC.Exts (isTrue#)
import GHC.Prim (Int#)
#endif
import GHC.Prim ((<#), (>#))
import GHC.Real (ratioPrec, ratioPrec1)
import qualified Prelude as P (show)
import Prelude hiding (Show)
import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)
import Text.Show.Text.Utils ((<>), s)
#if defined(TEXT_FORMAT)
import Data.Text.Buildable (build)
#else
import GHC.Base (quotInt, remInt)
import GHC.Integer.GMP.Internals (Integer(..))
import GHC.Num (quotRemInteger)
import Text.Show.Text.Utils (i2d)
#endif
showbIntPrec :: Int -> Int -> Builder
showbIntPrec (I# p) n'@(I# n)
| isTrue (n <# 0#) && isTrue (p ># 6#) = s '(' <> build n' <> s ')'
| otherwise = build n'
where
#if __GLASGOW_HASKELL__ >= 708
isTrue :: Int# -> Bool
isTrue b = isTrue# b
#else
isTrue :: Bool -> Bool
isTrue = id
#endif
showbInt8Prec :: Int -> Int8 -> Builder
showbInt8Prec p = showbIntPrec p . fromIntegral
showbInt16Prec :: Int -> Int16 -> Builder
showbInt16Prec p = showbIntPrec p . fromIntegral
showbInt32Prec :: Int -> Int32 -> Builder
showbInt32Prec p = showbIntPrec p . fromIntegral
showbInt64Prec :: Int -> Int64 -> Builder
#if WORD_SIZE_IN_BITS < 64
showbInt64Prec p = showbIntegerPrec p . toInteger
#else
showbInt64Prec p = showbIntPrec p . fromIntegral
#endif
showbIntegerPrec :: Int -> Integer -> Builder
showbIntegerPrec p n
| p > 6 && n < 0 = s '(' <> build n <> s ')'
| otherwise = build n
showbIntegralPrec :: Integral a => Int -> a -> Builder
showbIntegralPrec p = showbIntegerPrec p . toInteger
showbIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> Builder
showbIntAtBase base toChr n0
| base <= 1 = error . P.show $ "Text.Show.Text.Int.showbIntAtBase: applied to unsupported base" <> showb base
| n0 < 0 = error . P.show $ "Text.Show.Text.Int.showbIntAtBase: applied to negative number " <> showb n0
| otherwise = showbIt (quotRem n0 base) mempty
where
showbIt (n, d) b = seq c $
case n of
0 -> b'
_ -> showbIt (quotRem n base) b'
where
c :: Char
c = toChr $ fromIntegral d
b' :: Builder
b' = s c <> b
showbBin :: (Integral a, Show a) => a -> Builder
showbBin = showbIntAtBase 2 intToDigit
showbHex :: (Integral a, Show a) => a -> Builder
showbHex = showbIntAtBase 16 intToDigit
showbOct :: (Integral a, Show a) => a -> Builder
showbOct = showbIntAtBase 8 intToDigit
showbRatioPrec :: (Show a, Integral a) => Int -> Ratio a -> Builder
showbRatioPrec p q = showbParen (p > ratioPrec) $
showbPrec ratioPrec1 (numerator q)
<> " % "
<> showbPrec ratioPrec1 (denominator q)
showbWord :: Word -> Builder
showbWord = build
showbWord8 :: Word8 -> Builder
showbWord8 = build
showbWord16 :: Word16 -> Builder
showbWord16 = build
showbWord32 :: Word32 -> Builder
showbWord32 = build
showbWord64 :: Word64 -> Builder
showbWord64 = build
#if !defined(TEXT_FORMAT)
build :: Integral a => a -> Builder
build = decimal
decimal :: Integral a => a -> 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
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 = s $! i2d (fromIntegral n)
hexDigit :: Integral a => a -> Builder
hexDigit n
| n <= 9 = s $! i2d (fromIntegral n)
| otherwise = s $! toEnum (fromIntegral n + 87)
minus :: Builder
minus = s '-'
int :: Int -> Builder
int = decimal
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
go n | n < maxInt = int (fromInteger n)
| otherwise = putH (splitf (maxInt * maxInt) n)
splitf p n
| p > n = [n]
| otherwise = splith p (splitf (p*p) n)
splith p (n:ns) = case n `quotRemInteger` p of
(# q,r #) | q > 0 -> q : r : splitb p ns
| otherwise -> r : splitb p ns
splith _ _ = error "splith: the impossible happened."
splitb p (n:ns) = case n `quotRemInteger` p of
(# q,r #) -> q : r : splitb p ns
splitb _ _ = []
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
(# 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
(# 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 (d1) q <> digit r
where q = n `quotInt` base
r = n `remInt` base
#endif
instance Show Int where
showbPrec = showbIntPrec
instance Show Int8 where
showbPrec = showbInt8Prec
instance Show Int16 where
showbPrec = showbInt16Prec
instance Show Int32 where
showbPrec = showbInt32Prec
instance Show Int64 where
showbPrec = showbInt64Prec
instance Show Integer where
showbPrec = showbIntegerPrec
instance (Show a, Integral a) => Show (Ratio a) where
showbPrec = showbRatioPrec
instance Show Word where
showb = showbWord
instance Show Word8 where
showb = showbWord8
instance Show Word16 where
showb = showbWord16
instance Show Word32 where
showb = showbWord32
instance Show Word64 where
showb = showbWord64