module Data.Bits.Pretty
  (
  -- * Show in base
    showBin
  , showDec
  , showHex
  , formatHex
  -- * Show binary groups
  , showBinGroups
  -- * Size of Int
  , platformSizeOfInt
  -- * Shorthand
  , showHex8
  , showHex16
  , showHex32
  ) where

import Data.Bits (FiniteBits, (.&.), shiftR)
import Data.Word (Word8, Word16, Word32)
import Text.Printf (PrintfArg, printf)
import qualified Data.Bits

-- * Show in base

-- | Format number using binary notation with leading 0b,
-- padded according to its bit size
showBin :: (PrintfArg t, FiniteBits t) => t -> String
showBin :: forall t. (PrintfArg t, FiniteBits t) => t -> String
showBin t
x =
  String -> t -> String
forall r. PrintfType r => String -> r
printf
    (String
"0b%0"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ t -> Int
forall b. FiniteBits b => b -> Int
Data.Bits.finiteBitSize t
x)
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"b"
    )
    t
x

-- | Format number using decimal notation
showDec :: (PrintfArg t, FiniteBits t) => t -> String
showDec :: forall t. (PrintfArg t, FiniteBits t) => t -> String
showDec t
x =
  String -> t -> String
forall r. PrintfType r => String -> r
printf (String
"%0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
decSize) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"u") t
x
  where
    decSize :: Int
    decSize :: Int
decSize =
      Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
      (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase
          (Double
10 :: Double)
          (Double
2 Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (t -> Int
forall b. FiniteBits b => b -> Int
Data.Bits.finiteBitSize t
x))

-- | Format number using hexadecimal notation with leading 0x,
-- padded according to its bit size
showHex :: (PrintfArg t, FiniteBits t) => t -> String
showHex :: forall t. (PrintfArg t, FiniteBits t) => t -> String
showHex t
x =
  String -> t -> String
forall r. PrintfType r => String -> r
printf
    (String
"0x%0"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ t -> Int
forall b. FiniteBits b => b -> Int
Data.Bits.finiteBitSize t
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"X"
    )
    t
x

-- | Format number using hexadecimal notation with leading 0x
formatHex :: PrintfArg t => t -> String
formatHex :: forall t. PrintfArg t => t -> String
formatHex = String -> t -> String
forall r. PrintfType r => String -> r
printf String
"0x%x"

-- * Show binary groups

-- | Print number in binary with bits grouped by `groupSize`
-- e.g. with `groupSize = 4` we would get `0000 1010 0000 0101`
showBinGroups :: (PrintfArg b, Num b, FiniteBits b) => Int -> b -> String
showBinGroups :: forall b. (PrintfArg b, Num b, FiniteBits b) => Int -> b -> String
showBinGroups Int
groupSize b
x =
  [String] -> String
unwords
    ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Int -> String) -> [Int] -> [String])
-> [Int] -> (Int -> String) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [Int
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 ,Int
gs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 .. Int
0]
    ((Int -> String) -> [String]) -> (Int -> String) -> [String]
forall a b. (a -> b) -> a -> b
$ \Int
g -> ((String -> b -> String
forall r. PrintfType r => String -> r
printf (String
"%0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
groupSize) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"b") (Int -> b -> b
forall {a}. (Bits a, Num a) => Int -> a -> a
mask Int
g b
x)) :: String)
  where
    mask :: Int -> a -> a
mask Int
g a
n = (a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^Int
groupSize a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a
n a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
g Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
groupSize)))
    gs :: Int
gs = Int
sz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
groupSize
    sz :: Int
sz = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ b -> Int
forall b. FiniteBits b => b -> Int
Data.Bits.finiteBitSize b
x

-- * Size of Int

-- | Size of `Int` at the current platform
platformSizeOfInt :: Int
platformSizeOfInt :: Int
platformSizeOfInt = Int -> Int
forall b. FiniteBits b => b -> Int
Data.Bits.finiteBitSize (Int
0 :: Int)

-- * Shorthand

-- | Format Int as 32-bit unsigned hexadecimal string
showHex32 :: Int -> String
showHex32 :: Int -> String
showHex32 = Word32 -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
showHex (Word32 -> String) -> (Int -> Word32) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word32)

-- | Format Int as 16-bit unsigned hexadecimal string
showHex16 :: Int -> String
showHex16 :: Int -> String
showHex16 = Word16 -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
showHex (Word16 -> String) -> (Int -> Word16) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word16)

-- | Format Int as 8-bit unsigned hexadecimal string
showHex8 :: Int -> String
showHex8 :: Int -> String
showHex8  = Word8 -> String
forall t. (PrintfArg t, FiniteBits t) => t -> String
showHex (Word8 -> String) -> (Int -> Word8) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word8)