text-printer 0.1 → 0.3
raw patch · 4 files changed
+974/−467 lines, 4 filesdep +semigroupsdep +text-latin1
Dependencies added: semigroups, text-latin1
Files
- src/Text/Printer.hs +38/−444
- src/Text/Printer/Numerals.hs +852/−0
- tests/Tests.hs +79/−21
- text-printer.cabal +5/−2
src/Text/Printer.hs view
@@ -2,24 +2,25 @@ {-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-} -- | Monoids with a homomorphism from 'String' to themselves. module Text.Printer ( -- * The class- Printer(..)+ Printer(..) -- * Builders , StringBuilder(..) , buildString+ , buildText+ , buildLazyText , AsciiBuilder(..) , buildAscii+ , buildLazyAscii , Utf8Builder(..) , buildUtf8+ , buildLazyUtf8 -- * Combinators , (<>) , hcat@@ -37,22 +38,6 @@ , dquotes , punctuateL , punctuateR- -- * Number printers- , unsignedBinary- , unsignedOctal- , unsignedUpHex- , unsignedLowHex- , unsignedDecimal- , binary'- , binary- , octal'- , octal- , lowHex'- , lowHex- , upHex'- , upHex- , decimal'- , decimal -- * Multiline printers , MultilinePrinter(..) , lines@@ -61,19 +46,12 @@ , LinePrinter(..) , lfPrinter , crlfPrinter- -- * Default printers- , Printable(..)- , defaultPrintList- , toString ) where import Prelude hiding (foldr, foldr1, print, lines) import Data.Typeable (Typeable)-import Data.Int-import Data.Word-import Data.Bits (Bits(..))-import Data.Char (chr, ord) import Data.String (IsString(..))+import qualified Data.Semigroup as S import Data.Monoid (Monoid(..), (<>)) import Data.Foldable (Foldable(..), toList) import Data.Traversable (Traversable, mapAccumL, mapAccumR)@@ -148,6 +126,10 @@ fromString s = StringBuilder (s ++) {-# INLINE fromString #-} +instance S.Semigroup StringBuilder where+ (<>) = mappend+ {-# INLINE (<>) #-}+ instance Printer StringBuilder where char c = StringBuilder (c :) {-# INLINE char #-}@@ -164,6 +146,14 @@ lazyText = TB.fromLazyText {-# INLINE lazyText #-} +buildText ∷ TB.Builder → TS.Text+buildText = fold . TL.toChunks . buildLazyText+{-# INLINE buildText #-}++buildLazyText ∷ TB.Builder → TL.Text+buildLazyText = TB.toLazyText+{-# INLINE buildLazyText #-}+ -- | Use this builder when you are sure that only ASCII characters -- will get printed to it. newtype AsciiBuilder = AsciiBuilder { asciiBuilder ∷ BB.Builder }@@ -173,6 +163,10 @@ fromString = AsciiBuilder . BB.string7 {-# INLINE fromString #-} +instance S.Semigroup AsciiBuilder where+ (<>) = mappend+ {-# INLINE (<>) #-}+ instance Printer AsciiBuilder where char = AsciiBuilder . BB.char7 {-# INLINE char #-}@@ -185,10 +179,14 @@ lazyUtf8 = AsciiBuilder . BB.lazyByteString {-# INLINE lazyUtf8 #-} -buildAscii ∷ AsciiBuilder → BL.ByteString-buildAscii = BB.toLazyByteString . asciiBuilder+buildAscii ∷ AsciiBuilder → BS.ByteString+buildAscii = fold . BL.toChunks . buildLazyAscii {-# INLINE buildAscii #-} +buildLazyAscii ∷ AsciiBuilder → BL.ByteString+buildLazyAscii = BB.toLazyByteString . asciiBuilder+{-# INLINE buildLazyAscii #-}+ -- | UTF-8 lazy 'BL.ByteString' builder. newtype Utf8Builder = Utf8Builder { utf8Builder ∷ BB.Builder } deriving (Typeable, Monoid)@@ -197,6 +195,10 @@ fromString = Utf8Builder . BB.stringUtf8 {-# INLINE fromString #-} +instance S.Semigroup Utf8Builder where+ (<>) = mappend+ {-# INLINE (<>) #-}+ instance Printer Utf8Builder where char = Utf8Builder . BB.charUtf8 {-# INLINE char #-}@@ -217,10 +219,14 @@ lazyUtf8 = Utf8Builder . BB.lazyByteString {-# INLINE lazyUtf8 #-} -buildUtf8 ∷ Utf8Builder → BL.ByteString-buildUtf8 = BB.toLazyByteString . utf8Builder+buildUtf8 ∷ Utf8Builder → BS.ByteString+buildUtf8 = fold . BL.toChunks . buildLazyUtf8 {-# INLINE buildUtf8 #-} +buildLazyUtf8 ∷ Utf8Builder → BL.ByteString+buildLazyUtf8 = BB.toLazyByteString . utf8Builder+{-# INLINE buildLazyUtf8 #-}+ instance Printer PP.Doc where char = PP.char {-# INLINE char #-}@@ -327,314 +333,6 @@ snd . mapAccumR (\l a → if l then (False, a) else (False, a <> p)) True {-# INLINE punctuateR #-} --- | Print an unsigned number in the binary numeral system.-unsignedBinary ∷ (Num α, Bits α, Printer p) ⇒ α → p-unsignedBinary = go (char7 '0')- where go p 0 = p- go _ m = go mempty (shiftR m 1) <> char7 c- where !c = if testBit m 0 then '1' else '0'-{-# INLINABLE unsignedBinary #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Int → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Int8 → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Int16 → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Int32 → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Int64 → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Word → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Word8 → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Word16 → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Word32 → p #-}-{-# SPECIALIZE unsignedBinary ∷ Printer p ⇒ Word64 → p #-}---- | Print an unsigned number in the octal numeral system.-unsignedOctal ∷ (Num α, Bits α, Printer p) ⇒ α → p-unsignedOctal = go (char7 '0')- where go p 0 = p- go _ m = go mempty (shiftR m 3) <> char7 c- where !r = (if testBit m 0 then 1 else 0)- + (if testBit m 1 then 2 else 0)- + (if testBit m 2 then 4 else 0)- !c = chr $ ord '0' + r-{-# INLINABLE unsignedOctal #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Int → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Int8 → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Int16 → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Int32 → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Int64 → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Word → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Word8 → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Word16 → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Word32 → p #-}-{-# SPECIALIZE unsignedOctal ∷ Printer p ⇒ Word64 → p #-}---- | Print an unsigned number in the hexadecimal numeral system--- using lower case digits.-unsignedLowHex ∷ (Num α, Bits α, Printer p) ⇒ α → p-unsignedLowHex = go (char7 '0')- where go p 0 = p- go _ m = go mempty (shiftR m 4) <> char7 c- where !r = (if testBit m 0 then 1 else 0)- + (if testBit m 1 then 2 else 0)- + (if testBit m 2 then 4 else 0)- + (if testBit m 3 then 8 else 0)- !c | r < 10 = chr $ ord '0' + r- | otherwise = chr $ ord 'a' + r - 10-{-# INLINABLE unsignedLowHex #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Int → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Int8 → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Int16 → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Int32 → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Int64 → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Word → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Word8 → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Word16 → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Word32 → p #-}-{-# SPECIALIZE unsignedLowHex ∷ Printer p ⇒ Word64 → p #-}---- | Print an unsigned number in the hexadecimal numeral system--- using upper case digits.-unsignedUpHex ∷ (Num α, Bits α, Printer p) ⇒ α → p-unsignedUpHex = go (char7 '0')- where go p 0 = p- go _ m = go mempty (shiftR m 4) <> char7 c- where !r = (if testBit m 0 then 1 else 0)- + (if testBit m 1 then 2 else 0)- + (if testBit m 2 then 4 else 0)- + (if testBit m 3 then 8 else 0)- !c | r < 10 = chr $ ord '0' + r- | otherwise = chr $ ord 'A' + r - 10-{-# INLINABLE unsignedUpHex #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Int → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Int8 → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Int16 → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Int32 → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Int64 → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Word → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Word8 → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Word16 → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Word32 → p #-}-{-# SPECIALIZE unsignedUpHex ∷ Printer p ⇒ Word64 → p #-}---- | Print an unsigned number in the decimal numeral system.-unsignedDecimal ∷ (Integral α, Printer p) ⇒ α → p-unsignedDecimal = go (char7 '0')- where go p 0 = p- go _ m = go mempty q <> char7 c- where (q, r) = quotRem m 10- !c = chr $ ord '0' + fromIntegral r-{-# INLINABLE unsignedDecimal #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Int → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Int8 → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Int16 → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Int32 → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Int64 → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Word → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Word8 → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Word16 → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Word32 → p #-}-{-# SPECIALIZE unsignedDecimal ∷ Printer p ⇒ Word64 → p #-}---- | Print a number in the binary numeral system.-binary' ∷ (Ord α, Num α, Bits α, Printer p)- ⇒ p -- ^ Prefix for negative values- → p -- ^ Prefix for the zero- → p -- ^ Prefix for positive values- → α → p-binary' neg z pos n = case compare n 0 of- LT → case testBit n 0 of- True → go neg (shiftR (negate n) 1) <> char7 '1'- False → go neg (negate $ shiftR n 1) <> char7 '0'- EQ → z <> char7 '0'- GT → go pos (shiftR n 1) <> char7 c- where !c = if testBit n 0 then '1' else '0'- where go p 0 = p- go p m = go p (shiftR m 1) <> char7 c- where !c = if testBit m 0 then '1' else '0'-{-# INLINABLE binary' #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Int → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Int8 → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Int16 → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Int32 → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Int64 → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Word → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Word8 → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Word16 → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Word32 → p #-}-{-# SPECIALIZE binary' ∷ Printer p ⇒ p → p → p → Word64 → p #-}---- | Print a number in the binary numeral system. Negative values--- are prefixed with \"-0b\", postive values are prefixed with \"0b\".-binary ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p-binary = binary' (string7 "-0b") mempty (string7 "0b")-{-# INLINE binary #-}---- | Print a number in the octal numeral system.-octal' ∷ (Ord α, Num α, Bits α, Printer p)- ⇒ p -- ^ Prefix for negative values- → p -- ^ Prefix for the zero- → p -- ^ Prefix for positive values- → α → p-octal' neg z pos n = case compare n 0 of- LT → case testBit n 0 of- True → go neg (shiftR (negate n) 3) <> char7 c- where !r = 7- - (if testBit n 1 then 2 else 0)- - (if testBit n 2 then 4 else 0)- !c = chr $ ord '0' + r- False → case n > negate (bit 3) of- True → neg <> char7 c - False → go neg m <> char7 c- where m | v == 0 = negate $ shiftR n 3- | otherwise = complement $ shiftR n 3- where !v = (if testBit n 1 then 2 else 0)- + (if testBit n 2 then 4 else 0)- !r = (8 - v) .&. 7- !c = chr $ ord '0' + r- EQ → z <> char7 '0'- GT → go pos (shiftR n 3) <> char7 c- where !r = (if testBit n 0 then 1 else 0)- + (if testBit n 1 then 2 else 0)- + (if testBit n 2 then 4 else 0)- !c = chr $ ord '0' + r- where go p 0 = p- go p m = go p (shiftR m 3) <> char7 c- where !r = (if testBit m 0 then 1 else 0)- + (if testBit m 1 then 2 else 0)- + (if testBit m 2 then 4 else 0)- !c = chr $ ord '0' + r-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Int → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Int8 → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Int16 → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Int32 → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Int64 → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Word → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Word8 → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Word16 → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Word32 → p #-}-{-# SPECIALIZE octal' ∷ Printer p ⇒ p → p → p → Word64 → p #-}---- | Print a number in the octal numeral system. Negative values--- are prefixed with \"-0o\", postive values are prefixed with \"0o\".-octal ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p-octal = octal' (string7 "-0o") mempty (string7 "0o")-{-# INLINE octal #-}--hex' ∷ (Ord α, Num α, Bits α, Printer p) ⇒ Int → p → p → p → α → p-hex' a neg z pos n = case compare n 0 of- LT → case testBit n 0 of- True → go neg (shiftR (negate n) 4) <> char7 c- where !r = 15- - (if testBit n 1 then 2 else 0)- - (if testBit n 2 then 4 else 0)- - (if testBit n 3 then 8 else 0)- !c | r < 10 = chr $ ord '0' + r- | otherwise = chr $ a + (r - 10) - False → case n > negate (bit 4) of- True → neg <> char7 c - False → go neg m <> char7 c- where m | v == 0 = negate $ shiftR n 4- | otherwise = complement $ shiftR n 4- where !v = (if testBit n 1 then 2 else 0)- + (if testBit n 2 then 4 else 0)- + (if testBit n 3 then 8 else 0)- !r = (16 - v) .&. 15- !c | r < 10 = chr $ ord '0' + r- | otherwise = chr $ a + (r - 10)- EQ → z <> char7 '0'- GT → go pos (shiftR n 4) <> char7 c- where !r = (if testBit n 0 then 1 else 0)- + (if testBit n 1 then 2 else 0)- + (if testBit n 2 then 4 else 0)- + (if testBit n 3 then 8 else 0)- !c | r < 10 = chr $ ord '0' + r- | otherwise = chr $ a + (r - 10)- where go p 0 = p- go p m = go p (shiftR m 4) <> char7 c- where !r = (if testBit m 0 then 1 else 0)- + (if testBit m 1 then 2 else 0)- + (if testBit m 2 then 4 else 0)- + (if testBit m 3 then 8 else 0)- !c | r < 10 = chr $ ord '0' + r- | otherwise = chr $ a + (r - 10)-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Int → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Int8 → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Int16 → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Int32 → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Int64 → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Word → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Word8 → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Word16 → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Word32 → p #-}-{-# SPECIALIZE hex' ∷ Printer p ⇒ Int → p → p → p → Word64 → p #-}---- | Print a number in the hexadecimal numeral system using lower case--- digits.-lowHex' ∷ (Ord α, Num α, Bits α, Printer p)- ⇒ p -- ^ Prefix for negative values- → p -- ^ Prefix for the zero- → p -- ^ Prefix for postive values- → α → p-lowHex' = hex' (ord 'a')-{-# INLINE lowHex' #-}---- | Print a number in the hexadecimal numeral system using lower case--- digits. Negative values are prefixed with \"-0x\", positive values--- are prefixed with \"0x\".-lowHex ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p-lowHex = lowHex' (string7 "-0x") mempty (string7 "0x")-{-# INLINE lowHex #-}---- | Print a number in the hexadecimal numeral system using upper case--- digits.-upHex' ∷ (Ord α, Num α, Bits α, Printer p)- ⇒ p -- ^ Prefix for negative values- → p -- ^ Prefix for the zero- → p -- ^ Prefix for postive values- → α → p-upHex' = hex' (ord 'A')-{-# INLINE upHex' #-}---- | Print a number in the hexadecimal numeral system using upper case--- digits. Negative values are prefixed with \"-0x\", positive values--- are prefixed with \"0x\".-upHex ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p-upHex = upHex' (string7 "-0x") mempty (string7 "0x")-{-# INLINE upHex #-}---- | Print a number in the decimal numeral system.-decimal' ∷ (Integral α, Printer p)- ⇒ p -- ^ Prefix for negative values- → p -- ^ Prefix for the zero- → p -- ^ Prefix for postive values- → α → p-decimal' neg z pos n = case compare n 0 of- LT → go neg q <> char7 c- where (q, r) = quotRem n (-10)- !c = chr $ ord '0' - fromIntegral r- EQ → z <> char7 '0'- GT → go pos q <> char7 c- where (q, r) = quotRem n 10- !c = chr $ ord '0' + fromIntegral r- where go p 0 = p- go p m = go p q <> char7 c- where (q, r) = quotRem m 10- !c = chr $ ord '0' + fromIntegral r-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Int → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Int8 → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Int16 → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Int32 → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Int64 → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Word → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Word8 → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Word16 → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Word32 → p #-}-{-# SPECIALIZE decimal' ∷ Printer p ⇒ p → p → p → Word64 → p #-}---- | Print a number in the decimal numeral system. Negative values--- are prefixed with \"-\".-decimal ∷ (Integral α, Printer p) ⇒ α → p-decimal = decimal' (char7 '-') mempty mempty-{-# INLINE decimal #-}- infixr 5 <-> -- | Printers that can produce multiple lines of text.@@ -714,108 +412,4 @@ crlfPrinter ∷ Printer p ⇒ LinePrinter p → p crlfPrinter p = linePrinter p (separate crlf) {-# INLINE crlfPrinter #-}---- | The default printer for values of a type.-class Printable α where- print ∷ Printer p ⇒ α → p- printList ∷ Printer p ⇒ [α] → p- printList = defaultPrintList- {-# INLINE printList #-}--defaultPrintList ∷ (Printable α, Printer p) ⇒ [α] → p-defaultPrintList = brackets . list . map print-{-# INLINE defaultPrintList #-}--instance Printable () where- print _ = string7 "()"- {-# INLINE print #-}--instance (Printable α, Printable β) ⇒ Printable (α, β) where- print (a, b) = parens $ list [print a, print b]- {-# INLINE print #-}--instance (Printable α, Printable β, Printable γ) ⇒ Printable (α, β, γ) where- print (a, b, c) = parens $ list [print a, print b, print c]- {-# INLINE print #-}--instance (Printable α, Printable β, Printable γ, Printable δ)- ⇒ Printable (α, β, γ, δ) where- print (a, b, c, d) = parens $ list [print a, print b, print c, print d]- {-# INLINE print #-}--instance Printable α ⇒ Printable [α] where- print = printList- {-# INLINE print #-}--instance Printable Char where- print = char- {-# INLINE print #-}- printList = string- {-# INLINE printList #-}--instance Printable TS.Text where- print = text- {-# INLINE print #-}--instance Printable TL.Text where- print = lazyText- {-# INLINE print #-}--instance Printable Integer where- print = decimal- {-# INLINE print #-}--instance Printable Int where- print = decimal- {-# INLINE print #-}--instance Printable Int8 where- print = decimal- {-# INLINE print #-}--instance Printable Int16 where- print = decimal- {-# INLINE print #-}--instance Printable Int32 where- print = decimal- {-# INLINE print #-}--instance Printable Int64 where- print = decimal- {-# INLINE print #-}--instance Printable Word where- print = unsignedDecimal- {-# INLINE print #-}--instance Printable Word8 where- print = unsignedDecimal- {-# INLINE print #-}--instance Printable Word16 where- print = unsignedDecimal- {-# INLINE print #-}--instance Printable Word32 where- print = unsignedDecimal- {-# INLINE print #-}--instance Printable Word64 where- print = unsignedDecimal- {-# INLINE print #-}--instance Printable Float where- print = string7 . show- {-# INLINE print #-}--instance Printable Double where- print = string7 . show- {-# INLINE print #-}---- | Print a 'Printable' value via 'StringBuilder', i.e.--- @'toString' = 'buildString' . 'print'@.-toString ∷ Printable α ⇒ α → String-toString = buildString . print-{-# INLINE toString #-}
+ src/Text/Printer/Numerals.hs view
@@ -0,0 +1,852 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE BangPatterns #-}++-- | Print numbers in common positional numeral systems. +module Text.Printer.Numerals+ (+ -- * Positional systems.+ PositionalSystem(..)+ , BitSystem(..)+ , Binary(..)+ , Octal(..)+ , Decimal(..)+ , Hexadecimal(..)+ , LowHex(..)+ , UpHex(..)+ -- * Numeral printers+ , nonNegative+ , nnBinary+ , nnOctal+ , nnDecimal+ , nnLowHex+ , nnUpHex+ , nnBits+ , nnBinaryBits+ , nnOctalBits+ , nnLowHexBits+ , nnUpHexBits+ , nonPositive+ , npBinary+ , npOctal+ , npDecimal+ , npLowHex+ , npUpHex+ , npBits+ , npBinaryBits+ , npOctalBits+ , npLowHexBits+ , npUpHexBits+ , number'+ , number+ , binary'+ , binary+ , octal'+ , octal+ , decimal'+ , decimal+ , lowHex'+ , lowHex+ , upHex'+ , upHex+ , bits'+ , bits+ , binaryBits'+ , binaryBits+ , octalBits'+ , octalBits+ , lowHexBits'+ , lowHexBits+ , upHexBits'+ , upHexBits+ ) where++import Data.Typeable (Typeable)+import Data.Char (chr, ord)+import Data.Int+import Data.Word+import Data.Bits (Bits(..))+import Data.Monoid (mempty)+import qualified Text.Ascii as A+import Text.Printer++-- | Positional numeral system.+class PositionalSystem s where+ -- | The name of the system (e.g. \"binary\", \"decimal\").+ systemName ∷ s → String+ -- | The radix of the system.+ radixIn ∷ Num α ⇒ s → α+ -- | Test if a character is a digit.+ isDigitIn ∷ s → Char → Bool+ -- | Test if a character is a non-zero digit.+ isNzDigitIn ∷ s → Char → Bool+ -- | Map digits to the corresponding numbers. Return 'Nothing' on+ -- other inputs.+ fromDigitIn ∷ Num α ⇒ s → Char → Maybe α+ -- | Map non-zero digits to the corresponding numbers. Return 'Nothing' on+ -- other inputs.+ fromNzDigitIn ∷ Num α ⇒ s → Char → Maybe α+ -- | Map digits to the corresponding numbers. No checks are performed.+ unsafeFromDigitIn ∷ Num α ⇒ s → Char → α+ -- | Map 'Int' values to the corresponding digits. Inputs /must/ be+ -- non-negative and less than the radix.+ intToDigitIn ∷ s → Int → Char+ -- | Print a digit.+ printDigitIn ∷ Printer p ⇒ s → Char → p+ printDigitIn _ = char7+ {-# INLINE printDigitIn #-}++-- | Positonal numeral system with a power of two radix.+class PositionalSystem s ⇒ BitSystem s where+ -- | Numer of bits occupied by a digit.+ digitBitsIn ∷ s → Int+ -- | The number that has 'digitBitsIn' least significant bits set to ones+ -- and all the other bits set to zeroes.+ digitMaskIn ∷ Num α ⇒ s → α+ -- | Map the last digit of a number to the corresponding 'Int' value.+ lastDigitIn ∷ Bits α ⇒ s → α → Int++-- | The binary numeral system.+data Binary = Binary deriving (Typeable, Eq, Ord, Show, Read)++instance PositionalSystem Binary where+ systemName _ = "binary"+ {-# INLINE systemName #-}+ radixIn _ = 2+ {-# INLINE radixIn #-}+ isDigitIn _ = A.isBinDigit+ {-# INLINE isDigitIn #-}+ isNzDigitIn _ = A.isNzBinDigit+ {-# INLINE isNzDigitIn #-}+ fromDigitIn _ = A.fromBinDigit+ {-# INLINE fromDigitIn #-}+ fromNzDigitIn _ = A.fromNzBinDigit+ {-# INLINE fromNzDigitIn #-}+ unsafeFromDigitIn _ = A.unsafeFromBinDigit+ {-# INLINE unsafeFromDigitIn #-}+ intToDigitIn _ i = chr $! ord '0' + i+ {-# INLINE intToDigitIn #-}++instance BitSystem Binary where+ digitBitsIn _ = 1+ {-# INLINE digitBitsIn #-}+ digitMaskIn _ = 1+ {-# INLINE digitMaskIn #-}+ lastDigitIn _ n = if testBit n 0 then 1 else 0+ {-# INLINE lastDigitIn #-}++-- | The octal numeral system.+data Octal = Octal deriving (Typeable, Eq, Ord, Show, Read)++instance PositionalSystem Octal where+ systemName _ = "octal"+ {-# INLINE systemName #-}+ radixIn _ = 8+ {-# INLINE radixIn #-}+ isDigitIn _ = A.isOctDigit+ {-# INLINE isDigitIn #-}+ isNzDigitIn _ = A.isNzOctDigit+ {-# INLINE isNzDigitIn #-}+ fromDigitIn _ = A.fromOctDigit+ {-# INLINE fromDigitIn #-}+ fromNzDigitIn _ = A.fromNzOctDigit+ {-# INLINE fromNzDigitIn #-}+ unsafeFromDigitIn _ = A.unsafeFromOctDigit+ {-# INLINE unsafeFromDigitIn #-}+ intToDigitIn _ i = chr $! ord '0' + i+ {-# INLINE intToDigitIn #-}++instance BitSystem Octal where+ digitBitsIn _ = 3+ {-# INLINE digitBitsIn #-}+ digitMaskIn _ = 7+ {-# INLINE digitMaskIn #-}+ lastDigitIn _ n = (if testBit n 0 then 1 else 0)+ + (if testBit n 1 then 2 else 0)+ + (if testBit n 2 then 4 else 0)+ {-# INLINE lastDigitIn #-}++-- | The decimal numeral system.+data Decimal = Decimal deriving (Typeable, Eq, Ord, Show, Read)++instance PositionalSystem Decimal where+ systemName _ = "decimal"+ {-# INLINE systemName #-}+ radixIn _ = 10+ {-# INLINE radixIn #-}+ isDigitIn _ = A.isDecDigit+ {-# INLINE isDigitIn #-}+ isNzDigitIn _ = A.isNzDecDigit+ {-# INLINE isNzDigitIn #-}+ fromDigitIn _ = A.fromDecDigit+ {-# INLINE fromDigitIn #-}+ fromNzDigitIn _ = A.fromNzDecDigit+ {-# INLINE fromNzDigitIn #-}+ unsafeFromDigitIn _ = A.unsafeFromDecDigit+ {-# INLINE unsafeFromDigitIn #-}+ intToDigitIn _ i = chr $! ord '0' + i+ {-# INLINE intToDigitIn #-}++-- | The hexadecimal numeral system.+data Hexadecimal = Hexadecimal++instance PositionalSystem Hexadecimal where+ systemName _ = "hexadecimal"+ {-# INLINE systemName #-}+ radixIn _ = 16+ {-# INLINE radixIn #-}+ isDigitIn _ = A.isHexDigit+ {-# INLINE isDigitIn #-}+ isNzDigitIn _ = A.isNzHexDigit+ {-# INLINE isNzDigitIn #-}+ fromDigitIn _ = A.fromHexDigit+ {-# INLINE fromDigitIn #-}+ fromNzDigitIn _ = A.fromNzHexDigit+ {-# INLINE fromNzDigitIn #-}+ unsafeFromDigitIn _ = A.unsafeFromHexDigit+ {-# INLINE unsafeFromDigitIn #-}+ intToDigitIn _ i | i < 10 = chr $! ord '0' + i+ | otherwise = chr $! ord 'A' + (i - 10) + {-# INLINE intToDigitIn #-}++instance BitSystem Hexadecimal where+ digitBitsIn _ = 4+ {-# INLINE digitBitsIn #-}+ digitMaskIn _ = 15+ {-# INLINE digitMaskIn #-}+ lastDigitIn _ n = (if testBit n 0 then 1 else 0)+ + (if testBit n 1 then 2 else 0)+ + (if testBit n 2 then 4 else 0)+ + (if testBit n 3 then 8 else 0)+ {-# INLINABLE lastDigitIn #-}++-- | The hexadecimal numeral system, using lower case digits.+data LowHex = LowHex++instance PositionalSystem LowHex where+ systemName _ = "lower case hexadecimal"+ {-# INLINE systemName #-}+ radixIn _ = 16+ {-# INLINE radixIn #-}+ isDigitIn _ = A.isLowHexDigit+ {-# INLINE isDigitIn #-}+ isNzDigitIn _ = A.isNzLowHexDigit+ {-# INLINE isNzDigitIn #-}+ fromDigitIn _ = A.fromLowHexDigit+ {-# INLINE fromDigitIn #-}+ fromNzDigitIn _ = A.fromNzLowHexDigit+ {-# INLINE fromNzDigitIn #-}+ unsafeFromDigitIn _ = A.unsafeFromLowHexDigit+ {-# INLINE unsafeFromDigitIn #-}+ intToDigitIn _ i | i < 10 = chr $! ord '0' + i+ | otherwise = chr $! ord 'a' + (i - 10) + {-# INLINE intToDigitIn #-}++instance BitSystem LowHex where+ digitBitsIn _ = 4+ {-# INLINE digitBitsIn #-}+ digitMaskIn _ = 15+ {-# INLINE digitMaskIn #-}+ lastDigitIn _ n = (if testBit n 0 then 1 else 0)+ + (if testBit n 1 then 2 else 0)+ + (if testBit n 2 then 4 else 0)+ + (if testBit n 3 then 8 else 0)+ {-# INLINABLE lastDigitIn #-}++-- | The hexadecimal numeral system, using upper case digits.+data UpHex = UpHex++instance PositionalSystem UpHex where+ systemName _ = "upper case hexadecimal"+ {-# INLINE systemName #-}+ radixIn _ = 16+ {-# INLINE radixIn #-}+ isDigitIn _ = A.isUpHexDigit+ {-# INLINE isDigitIn #-}+ isNzDigitIn _ = A.isNzUpHexDigit+ {-# INLINE isNzDigitIn #-}+ fromDigitIn _ = A.fromUpHexDigit+ {-# INLINE fromDigitIn #-}+ fromNzDigitIn _ = A.fromNzUpHexDigit+ {-# INLINE fromNzDigitIn #-}+ unsafeFromDigitIn _ = A.unsafeFromUpHexDigit+ {-# INLINE unsafeFromDigitIn #-}+ intToDigitIn _ i | i < 10 = chr $! ord '0' + i+ | otherwise = chr $! ord 'A' + (i - 10) + {-# INLINE intToDigitIn #-}++instance BitSystem UpHex where+ digitBitsIn _ = 4+ {-# INLINE digitBitsIn #-}+ digitMaskIn _ = 15+ {-# INLINE digitMaskIn #-}+ lastDigitIn _ n = (if testBit n 0 then 1 else 0)+ + (if testBit n 1 then 2 else 0)+ + (if testBit n 2 then 4 else 0)+ + (if testBit n 3 then 8 else 0)+ {-# INLINABLE lastDigitIn #-}++-- | Print a non-negative number in the specified positional numeral system.+nonNegative ∷ (PositionalSystem s, Integral α, Printer p) ⇒ s → α → p+nonNegative s = go (printDigitIn s $! intToDigitIn s 0)+ where go p 0 = p+ go _ m = go mempty q <> printDigitIn s d+ where (q, r) = quotRem m radix+ !d = intToDigitIn s $ fromIntegral r+ radix = radixIn s+{-# INLINABLE nonNegative #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Int → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Int8 → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Int16 → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Int32 → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Int64 → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Word → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Word8 → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Word16 → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Word32 → p #-}+{-# SPECIALIZE nonNegative ∷ Printer p ⇒ Decimal → Word64 → p #-}+{-# SPECIALIZE nonNegative ∷ (Integral α, Printer p) ⇒ Binary → α → p #-}+{-# SPECIALIZE nonNegative ∷ (Integral α, Printer p) ⇒ Octal → α → p #-}+{-# SPECIALIZE nonNegative ∷ (Integral α, Printer p) ⇒ Decimal → α → p #-}+{-# SPECIALIZE nonNegative ∷ (Integral α, Printer p) ⇒ LowHex → α → p #-}+{-# SPECIALIZE nonNegative ∷ (Integral α, Printer p) ⇒ UpHex → α → p #-}++-- | Print a non-negative number in the binary numeral system.+nnBinary ∷ (Integral α, Printer p) ⇒ α → p+nnBinary = nonNegative Binary+{-# INLINE nnBinary #-}++-- | Print a non-negative number in the octal numeral system.+nnOctal ∷ (Integral α, Printer p) ⇒ α → p+nnOctal = nonNegative Octal+{-# INLINE nnOctal #-}++-- | Print a non-negative number in the decimal numeral system.+nnDecimal ∷ (Integral α, Printer p) ⇒ α → p+nnDecimal = nonNegative Decimal+{-# INLINE nnDecimal #-}++-- | Print a non-negative number in the hexadecimal numeral system+-- using lower case digits.+nnLowHex ∷ (Integral α, Printer p) ⇒ α → p+nnLowHex = nonNegative LowHex+{-# INLINE nnLowHex #-}++-- | Print a non-negative number in the hexadecimal numeral system+-- using upper case digits.+nnUpHex ∷ (Integral α, Printer p) ⇒ α → p+nnUpHex = nonNegative UpHex+{-# INLINE nnUpHex #-}++-- | Print a non-negative binary number in the specified positional numeral+-- system.+nnBits ∷ (BitSystem s, Num α, Bits α, Printer p) ⇒ s → α → p+nnBits s = go (printDigitIn s $! intToDigitIn s 0)+ where go p 0 = p+ go _ m = go mempty (shiftR m digitBits) <> printDigitIn s d+ where !d = intToDigitIn s $ lastDigitIn s m+ digitBits = digitBitsIn s+{-# INLINABLE nnBits #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Int → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Int8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Int16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Int32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Int64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Word → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Word8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Word16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Word32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Binary → Word64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Int → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Int8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Int16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Int32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Int64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Word → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Word8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Word16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Word32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Octal → Word64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Int → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Int8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Int16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Int32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Int64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Word → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Word8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Word16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Word32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ Hexadecimal → Word64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Int → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Int8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Int16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Int32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Int64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Word → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Word8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Word16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Word32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ LowHex → Word64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Int → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Int8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Int16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Int32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Int64 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Word → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Word8 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Word16 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Word32 → p #-}+{-# SPECIALIZE nnBits ∷ Printer p ⇒ UpHex → Word64 → p #-}+{-# SPECIALIZE nnBits ∷ (Num α, Bits α, Printer p) ⇒ Binary → α → p #-}+{-# SPECIALIZE nnBits ∷ (Num α, Bits α, Printer p) ⇒ Octal → α → p #-}+{-# SPECIALIZE nnBits ∷ (Num α, Bits α, Printer p) ⇒ Hexadecimal → α → p #-}+{-# SPECIALIZE nnBits ∷ (Num α, Bits α, Printer p) ⇒ LowHex → α → p #-}+{-# SPECIALIZE nnBits ∷ (Num α, Bits α, Printer p) ⇒ UpHex → α → p #-}++-- | Print a non-negative binary number in the binary numeral system.+nnBinaryBits ∷ (Num α, Bits α, Printer p) ⇒ α → p+nnBinaryBits = nnBits Binary+{-# INLINE nnBinaryBits #-}++-- | Print a non-negative binary number in the octal numeral system.+nnOctalBits ∷ (Num α, Bits α, Printer p) ⇒ α → p+nnOctalBits = nnBits Octal+{-# INLINE nnOctalBits #-}++-- | Print a non-negative binary number in the hexadecimal numeral system+-- using lower case digits.+nnLowHexBits ∷ (Num α, Bits α, Printer p) ⇒ α → p+nnLowHexBits = nnBits LowHex+{-# INLINE nnLowHexBits #-}++-- | Print a non-negative binary number in the hexadecimal numeral system+-- using upper case digits.+nnUpHexBits ∷ (Num α, Bits α, Printer p) ⇒ α → p+nnUpHexBits = nnBits UpHex+{-# INLINE nnUpHexBits #-}++-- | Print a non-positive number in the specified positional numeral system.+-- For example, @'nonPositive' 'Decimal' (-/123/)@ would print \"123\".+nonPositive ∷ (PositionalSystem s, Integral α, Printer p) ⇒ s → α → p+nonPositive s = go (printDigitIn s $! intToDigitIn s 0)+ where go p 0 = p+ go _ m = go mempty q <> printDigitIn s d+ where (q, r) = quotRem m radix+ !d = intToDigitIn s $ negate $ fromIntegral r+ radix = radixIn s+{-# INLINABLE nonPositive #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Int → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Int8 → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Int16 → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Int32 → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Int64 → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Word → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Word8 → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Word16 → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Word32 → p #-}+{-# SPECIALIZE nonPositive ∷ Printer p ⇒ Decimal → Word64 → p #-}+{-# SPECIALIZE nonPositive ∷ (Integral α, Printer p) ⇒ Binary → α → p #-}+{-# SPECIALIZE nonPositive ∷ (Integral α, Printer p) ⇒ Octal → α → p #-}+{-# SPECIALIZE nonPositive ∷ (Integral α, Printer p) ⇒ Decimal → α → p #-}+{-# SPECIALIZE nonPositive ∷ (Integral α, Printer p) ⇒ LowHex → α → p #-}+{-# SPECIALIZE nonPositive ∷ (Integral α, Printer p) ⇒ UpHex → α → p #-}++-- | Print a non-positive number in the binary numeral system.+npBinary ∷ (Integral α, Printer p) ⇒ α → p+npBinary = nonPositive Binary+{-# INLINE npBinary #-}++-- | Print a non-positive number in the octal numeral system.+npOctal ∷ (Integral α, Printer p) ⇒ α → p+npOctal = nonPositive Octal+{-# INLINE npOctal #-}++-- | Print a non-positive number in the decimal numeral system.+npDecimal ∷ (Integral α, Printer p) ⇒ α → p+npDecimal = nonPositive Decimal+{-# INLINE npDecimal #-}++-- | Print a non-positive number in the hexadecimal numeral system+-- using lower case digits.+npLowHex ∷ (Integral α, Printer p) ⇒ α → p+npLowHex = nonPositive LowHex+{-# INLINE npLowHex #-}++-- | Print a non-positive number in the hexadecimal numeral system+-- using upper case digits.+npUpHex ∷ (Integral α, Printer p) ⇒ α → p+npUpHex = nonPositive UpHex+{-# INLINE npUpHex #-}++-- | Print a non-positive two-compliment binary number in the specified+-- positional numeral system. For example, @'npBits' 'UpHex' (-/0xABC/)@+-- would print \"ABC\".+npBits ∷ (BitSystem s, Ord α, Num α, Bits α, Printer p) ⇒ s → α → p+npBits s n = case testBit n 0 of+ True → go mempty (shiftR (negate n) digitBits) <> printDigitIn s d+ where !d = intToDigitIn s $ radix - lastDigitIn s n+ False → case n > negRadix of+ True → printDigitIn s d'+ False → go mempty m <> printDigitIn s d'+ where m | d == 0 = negate $ shiftR n digitBits+ | otherwise = complement $ shiftR n digitBits+ where !d = lastDigitIn s n+ !d' = intToDigitIn s $ (radix - d) .&. digitMask+ where go p 0 = p+ go p m = go p (shiftR m digitBits) <> printDigitIn s d+ where !d = intToDigitIn s $ lastDigitIn s m+ radix = radixIn s+ digitMask = digitMaskIn s+ digitBits = digitBitsIn s+ negRadix = complement $ digitMaskIn s+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Int → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Int8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Int16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Int32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Int64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Word → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Word8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Word16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Word32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Binary → Word64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Int → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Int8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Int16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Int32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Int64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Word → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Word8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Word16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Word32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Octal → Word64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Int → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Int8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Int16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Int32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Int64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Word → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Word8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Word16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Word32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ Hexadecimal → Word64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Int → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Int8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Int16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Int32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Int64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Word → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Word8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Word16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Word32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ LowHex → Word64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Int → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Int8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Int16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Int32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Int64 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Word → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Word8 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Word16 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Word32 → p #-}+{-# SPECIALIZE npBits ∷ Printer p ⇒ UpHex → Word64 → p #-}+{-# SPECIALIZE npBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ Binary → α → p #-}+{-# SPECIALIZE npBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ Octal → α → p #-}+{-# SPECIALIZE npBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ Hexadecimal → α → p #-}+{-# SPECIALIZE npBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ LowHex → α → p #-}+{-# SPECIALIZE npBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ UpHex → α → p #-}++-- | Print a non-positive binary number in the binary numeral system.+npBinaryBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+npBinaryBits = npBits Binary+{-# INLINE npBinaryBits #-}++-- | Print a non-positive binary number in the octal numeral system.+npOctalBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+npOctalBits = npBits Octal+{-# INLINE npOctalBits #-}++-- | Print a non-positive binary number in the hexadecimal numeral system+-- using lower case digits.+npLowHexBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+npLowHexBits = npBits LowHex+{-# INLINE npLowHexBits #-}++-- | Print a non-positive binary number in the hexadecimal numeral system+-- using upper case digits.+npUpHexBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+npUpHexBits = npBits UpHex+{-# INLINE npUpHexBits #-}++-- | Print a number in the specified positional numeral system.+number' ∷ (PositionalSystem s, Ord α, Integral α, Printer p)+ ⇒ s+ → p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+number' s neg z pos n = case compare n 0 of+ LT → go neg q <> printDigitIn s d+ where (q, r) = quotRem n (negate radix)+ !d = intToDigitIn s $ negate $ fromIntegral r+ EQ → z <> (printDigitIn s $! intToDigitIn s 0)+ GT → go pos q <> printDigitIn s d+ where (q, r) = quotRem n radix+ !d = intToDigitIn s $ fromIntegral r+ where go p 0 = p+ go p m = go p q <> printDigitIn s d+ where (q, r) = quotRem m radix+ !d = intToDigitIn s $ fromIntegral r+ radix = radixIn s+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Int → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Int8 → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Int16 → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Int32 → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Int64 → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Word → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Word8 → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Word16 → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Word32 → p #-}+{-# SPECIALIZE number' ∷ Printer p ⇒ Decimal → p → p → p → Word64 → p #-}+{-# SPECIALIZE number' ∷ (Ord α, Integral α, Printer p) ⇒ Binary → p → p → p → α → p #-}+{-# SPECIALIZE number' ∷ (Ord α, Integral α, Printer p) ⇒ Decimal → p → p → p → α → p #-}+{-# SPECIALIZE number' ∷ (Ord α, Integral α, Printer p) ⇒ Octal → p → p → p → α → p #-}+{-# SPECIALIZE number' ∷ (Ord α, Integral α, Printer p) ⇒ Hexadecimal → p → p → p → α → p #-}+{-# SPECIALIZE number' ∷ (Ord α, Integral α, Printer p) ⇒ LowHex → p → p → p → α → p #-}+{-# SPECIALIZE number' ∷ (Ord α, Integral α, Printer p) ⇒ UpHex → p → p → p → α → p #-}++-- | Print a number in the specified positional numeral system. Negative+-- values are prefixed with a minus sign.+number ∷ (PositionalSystem s, Ord α, Integral α, Printer p) ⇒ s → α → p+number s = number' s (char7 '-') mempty mempty+{-# INLINE number #-}++-- | Print a number in the binary numeral system.+binary' ∷ (Ord α, Integral α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+binary' = number' Binary+{-# INLINE binary' #-}++-- | Print a number in the binary numeral system. Negative values+-- are prefixed with a minus sign.+binary ∷ (Ord α, Integral α, Printer p) ⇒ α → p+binary = number Binary+{-# INLINE binary #-}++-- | Print a number in the octal numeral system.+octal' ∷ (Ord α, Integral α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+octal' = number' Octal+{-# INLINE octal' #-}++-- | Print a number in the octal numeral system. Negative values+-- are prefixed with a minus sign.+octal ∷ (Ord α, Integral α, Printer p) ⇒ α → p+octal = number Octal+{-# INLINE octal #-}++-- | Print a number in the decimal numeral system.+decimal' ∷ (Ord α, Integral α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+decimal' = number' Decimal+{-# INLINE decimal' #-}++-- | Print a number in the decimal numeral system. Negative values+-- are prefixed with a minus sign.+decimal ∷ (Ord α, Integral α, Printer p) ⇒ α → p+decimal = number Decimal+{-# INLINE decimal #-}++-- | Print a number in the hexadecimal numeral system using lower case+-- digits.+lowHex' ∷ (Ord α, Integral α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+lowHex' = number' LowHex+{-# INLINE lowHex' #-}++-- | Print a number in the hexadecimal numeral system using lower case+-- digits. Negative values are prefixed with a minus sign.+lowHex ∷ (Ord α, Integral α, Printer p) ⇒ α → p+lowHex = number LowHex+{-# INLINE lowHex #-}++-- | Print a number in the hexadecimal numeral system using upper case+-- digits.+upHex' ∷ (Ord α, Integral α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+upHex' = number' UpHex+{-# INLINE upHex' #-}++-- | Print a number in the hexadecimal numeral system using upper case+-- digits. Negative values are prefixed with a minus sign.+upHex ∷ (Ord α, Integral α, Printer p) ⇒ α → p+upHex = number UpHex+{-# INLINE upHex #-}++-- | Print a binary number in the specified positional numeral system.+bits' ∷ (BitSystem s, Ord α, Num α, Bits α, Printer p)+ ⇒ s+ → p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+bits' s neg z pos n = case compare n 0 of+ LT → case testBit n 0 of+ True → go neg (shiftR (negate n) digitBits) <> printDigitIn s d+ where !d = intToDigitIn s $ radix - lastDigitIn s n+ False → case n > negRadix of+ True → neg <> printDigitIn s d'+ False → go neg m <> printDigitIn s d'+ where m | d == 0 = negate $ shiftR n digitBits+ | otherwise = complement $ shiftR n digitBits+ where !d = lastDigitIn s n+ !d' = intToDigitIn s $ (radix - d) .&. digitMask+ EQ → z <> (printDigitIn s $! intToDigitIn s 0)+ GT → go pos (shiftR n digitBits) <> printDigitIn s d+ where !d = intToDigitIn s $ lastDigitIn s n+ where go p 0 = p+ go p m = go p (shiftR m digitBits) <> printDigitIn s d+ where !d = intToDigitIn s $ lastDigitIn s m+ radix = radixIn s+ digitMask = digitMaskIn s+ digitBits = digitBitsIn s+ negRadix = complement $ digitMaskIn s+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Int → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Int8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Int16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Int32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Int64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Word → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Word8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Word16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Word32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Binary → p → p → p → Word64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Int → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Int8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Int16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Int32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Int64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Word → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Word8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Word16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Word32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Octal → p → p → p → Word64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Int → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Int8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Int16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Int32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Int64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Word → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Word8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Word16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Word32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ Hexadecimal → p → p → p → Word64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Int → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Int8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Int16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Int32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Int64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Word → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Word8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Word16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Word32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ LowHex → p → p → p → Word64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Int → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Int8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Int16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Int32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Int64 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Word → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Word8 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Word16 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Word32 → p #-}+{-# SPECIALIZE bits' ∷ Printer p ⇒ UpHex → p → p → p → Word64 → p #-}+{-# SPECIALIZE bits' ∷ (Ord α, Num α, Bits α, Printer p) ⇒ Binary → p → p → p → α → p #-}+{-# SPECIALIZE bits' ∷ (Ord α, Num α, Bits α, Printer p) ⇒ Octal → p → p → p → α → p #-}+{-# SPECIALIZE bits' ∷ (Ord α, Num α, Bits α, Printer p) ⇒ Hexadecimal → p → p → p → α → p #-}+{-# SPECIALIZE bits' ∷ (Ord α, Num α, Bits α, Printer p) ⇒ LowHex → p → p → p → α → p #-}+{-# SPECIALIZE bits' ∷ (Ord α, Num α, Bits α, Printer p) ⇒ UpHex → p → p → p → α → p #-}++-- | Print a binary number in the specified positional numeral system.+-- Negative values are prefixed with a minus sign.+bits ∷ (BitSystem s, Ord α, Num α, Bits α, Printer p) ⇒ s → α → p+bits s = bits' s (char7 '-') mempty mempty+{-# INLINE bits #-}++-- | Print a binary number in the binary numeral system.+binaryBits' ∷ (Ord α, Num α, Bits α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+binaryBits' = bits' Binary+{-# INLINE binaryBits' #-}++-- | Print a binary number in the binary numeral system. Negative values+-- are prefixed with a minus sign.+binaryBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+binaryBits = bits Binary+{-# INLINE binaryBits #-}++-- | Print a binary number in the octal numeral system.+octalBits' ∷ (Ord α, Num α, Bits α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+octalBits' = bits' Octal+{-# INLINE octalBits' #-}++-- | Print a binary number in the octal numeral system. Negative values+-- are prefixed with a minus sign.+octalBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+octalBits = bits Octal+{-# INLINE octalBits #-}++-- | Print a binary number in the hexadecimal numeral system using lower+-- case digits.+lowHexBits' ∷ (Ord α, Num α, Bits α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+lowHexBits' = bits' LowHex+{-# INLINE lowHexBits' #-}++-- | Print a binary number in the hexadecimal numeral system using lower+-- case digits. Negative values are prefixed with a minus sign.+lowHexBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+lowHexBits = bits LowHex+{-# INLINE lowHexBits #-}++-- | Print a binary number in the hexadecimal numeral system using upper+-- case digits.+upHexBits' ∷ (Ord α, Num α, Bits α, Printer p)+ ⇒ p -- ^ Prefix for negative values+ → p -- ^ Prefix for the zero+ → p -- ^ Prefix for positive values+ → α → p+upHexBits' = bits' UpHex+{-# INLINE upHexBits' #-}++-- | Print a binary number in the hexadecimal numeral system using upper+-- case digits. Negative values are prefixed with a minus sign.+upHexBits ∷ (Ord α, Num α, Bits α, Printer p) ⇒ α → p+upHexBits = bits UpHex+{-# INLINE upHexBits #-}++
tests/Tests.hs view
@@ -3,50 +3,108 @@ import Test.Framework (defaultMain) import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck ((==>)) import Data.Word (Word) import Data.Char (intToDigit) import Numeric (showIntAtBase) import Text.Printf (printf)-import Text.Printer+import Text.Printer.Numerals main = defaultMain- [ testProperty "unsignedBinary" $ \w →- unsignedBinary w == showBinary (w ∷ Word)- , testProperty "unsignedOctal" $ \w →- unsignedOctal w == (printf "%o" (w ∷ Word) ∷ String)- , testProperty "unsignedDecimal" $ \w →- unsignedDecimal w == show (w ∷ Word)- , testProperty "unsignedLowHex" $ \w →- unsignedLowHex w == (printf "%x" (w ∷ Word) ∷ String)- , testProperty "unsignedUpHex" $ \w →- unsignedUpHex w == (printf "%X" (w ∷ Word) ∷ String)+ [ testProperty "nnBinary" $ \w →+ nnBinary w == showBinary (w ∷ Word)+ , testProperty "nnBinaryBits" $ \w →+ nnBinaryBits w == showBinary (w ∷ Word)+ , testProperty "npBinary" $ \i →+ i <= 0 ==> npBinary (i ∷ Int) == showBinary (negate $ toInteger i)+ , testProperty "npBinaryBits" $ \i →+ i <= 0 ==> npBinaryBits (i ∷ Int) == showBinary (negate $ toInteger i)+ , testProperty "nnOctal" $ \w →+ nnOctal w == (printf "%o" (w ∷ Word) ∷ String)+ , testProperty "nnOctalBits" $ \w →+ nnOctalBits w == (printf "%o" (w ∷ Word) ∷ String)+ , testProperty "npOctal" $ \i →+ i <= 0 ==> npOctal (i ∷ Int) ==+ (printf "%o" (negate $ toInteger i) ∷ String)+ , testProperty "npOctalBits" $ \i →+ i <= 0 ==> npOctalBits (i ∷ Int) ==+ (printf "%o" (negate $ toInteger i) ∷ String)+ , testProperty "nnDecimal" $ \w →+ nnDecimal w == show (w ∷ Word)+ , testProperty "npDecimal" $ \i →+ i <= 0 ==> npDecimal (i ∷ Int) == show (negate $ toInteger i)+ , testProperty "nnLowHex" $ \w →+ nnLowHex w == (printf "%x" (w ∷ Word) ∷ String)+ , testProperty "nnLowHexBits" $ \w →+ nnLowHexBits w == (printf "%x" (w ∷ Word) ∷ String)+ , testProperty "npLowHex" $ \i →+ i <= 0 ==> npLowHex (i ∷ Int) ==+ (printf "%x" (negate $ toInteger i) ∷ String)+ , testProperty "npLowHexBits" $ \i →+ i <= 0 ==> npLowHexBits (i ∷ Int) ==+ (printf "%x" (negate $ toInteger i) ∷ String)+ , testProperty "nnUpHex" $ \w →+ nnUpHex w == (printf "%X" (w ∷ Word) ∷ String)+ , testProperty "nnUpHexBits" $ \w →+ nnUpHexBits w == (printf "%X" (w ∷ Word) ∷ String)+ , testProperty "npUpHex" $ \i →+ i <= 0 ==> npUpHex (i ∷ Int) ==+ (printf "%X" (negate $ toInteger i) ∷ String)+ , testProperty "npLowHexBits" $ \i →+ i <= 0 ==> npUpHexBits (i ∷ Int) ==+ (printf "%X" (negate $ toInteger i) ∷ String) , testProperty "binary" $ \i → if (i ∷ Int) == 0 then binary i == "0" else if i < 0- then binary i == "-0b" ++ showBinary (negate $ toInteger i)- else binary i == "0b" ++ showBinary i+ then binary i == '-' : showBinary (negate $ toInteger i)+ else binary i == showBinary i+ , testProperty "binaryBits" $ \i →+ if (i ∷ Int) == 0+ then binaryBits i == "0"+ else if i < 0+ then binaryBits i == '-' : showBinary (negate $ toInteger i)+ else binaryBits i == showBinary i , testProperty "octal" $ \i → if (i ∷ Int) == 0 then octal i == "0" else if i < 0- then octal i == (printf "-0o%o" (negate $ toInteger i) ∷ String)- else octal i == (printf "0o%o" i ∷ String)+ then octal i == (printf "-%o" (negate $ toInteger i) ∷ String)+ else octal i == (printf "%o" i ∷ String)+ , testProperty "octalBits" $ \i →+ if (i ∷ Int) == 0+ then octalBits i == "0"+ else if i < 0+ then octalBits i ==+ (printf "-%o" (negate $ toInteger i) ∷ String)+ else octalBits i == (printf "%o" i ∷ String)+ , testProperty "decimal" $ \i →+ decimal i == show (i ∷ Int) , testProperty "lowHex" $ \i → if (i ∷ Int) == 0 then lowHex i == "0" else if i < 0- then lowHex i == (printf "-0x%x" (negate $ toInteger i) ∷ String)- else lowHex i == (printf "0x%x" i ∷ String)+ then lowHex i == (printf "-%x" (negate $ toInteger i) ∷ String)+ else lowHex i == (printf "%x" i ∷ String)+ , testProperty "lowHexBits" $ \i →+ if (i ∷ Int) == 0+ then lowHexBits i == "0"+ else if i < 0+ then lowHexBits i == (printf "-%x" (negate $ toInteger i) ∷ String)+ else lowHexBits i == (printf "%x" i ∷ String) , testProperty "upHex" $ \i → if (i ∷ Int) == 0 then upHex i == "0" else if i < 0- then upHex i == (printf "-0x%X" (negate $ toInteger i) ∷ String)- else upHex i == (printf "0x%X" i ∷ String)- , testProperty "decimal" $ \i →- decimal i == show (i ∷ Int)+ then upHex i == (printf "-%X" (negate $ toInteger i) ∷ String)+ else upHex i == (printf "%X" i ∷ String)+ , testProperty "upHexBits" $ \i →+ if (i ∷ Int) == 0+ then upHexBits i == "0"+ else if i < 0+ then upHexBits i == (printf "-%X" (negate $ toInteger i) ∷ String)+ else upHexBits i == (printf "%X" i ∷ String) ] showBinary i = showIntAtBase 2 intToDigit i ""
text-printer.cabal view
@@ -1,5 +1,5 @@ Name: text-printer-Version: 0.1+Version: 0.3 Category: Text Stability: experimental Synopsis: Abstract interface for text builders/printers.@@ -29,11 +29,14 @@ base >= 4 && < 5, bytestring >= 0.10, text,- pretty+ pretty,+ text-latin1 >= 0.2,+ semigroups >= 0.8 Hs-Source-Dirs: src GHC-Options: -Wall Exposed-Modules: Text.Printer+ Text.Printer.Numerals Test-Suite tests Default-Language: Haskell2010