{-# LANGUAGE ScopedTypeVariables #-}

module Numeric.Long
  ( showLongHex
  , showLongBin
  , showPrefix
  ) where

import           Data.Bits
import           Data.Char



showLongHex :: (FiniteBits a, Integral a, Num a) => a -> ShowS
showLongHex :: forall a. (FiniteBits a, Integral a, Num a) => a -> ShowS
showLongHex (a
w0 :: a) = a -> Int -> ShowS
forall {a}. Integral a => a -> Int -> ShowS
go a
w0 Int
0
  where
    go :: a -> Int -> ShowS
go a
w Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
0 :: a) = ShowS
forall a. a -> a
id
      | Bool
otherwise                   =
          let (a
q, a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
w a
16
          in a -> Int -> ShowS
go a
q (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 :: Int) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar (Int -> Char
intToDigit (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r))



showLongBin :: (FiniteBits a, Integral a, Num a) => a -> ShowS
showLongBin :: forall a. (FiniteBits a, Integral a, Num a) => a -> ShowS
showLongBin (a
w :: a) = Int -> ShowS
go Int
0
  where
    go :: Int -> ShowS
go Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
0 :: a) = ShowS
forall a. a -> a
id
      | Bool
otherwise                   =
          Int -> ShowS
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar (Int -> Char
chr (Int -> Char) -> (a -> Int) -> a -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Char) -> a -> Char
forall a b. (a -> b) -> a -> b
$ a
48 a -> a -> a
forall a. Num a => a -> a -> a
+ (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
w Int
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1))



showPrefix :: (FiniteBits a, Integral a, Num a) => a -> ShowS
showPrefix :: forall a. (FiniteBits a, Integral a, Num a) => a -> ShowS
showPrefix (a
w :: a) = Int -> ShowS
go Int
0
  where
    m :: a
m = a
w a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Num a => a -> a
negate a
w

    go :: Int -> ShowS
go Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (a
0 :: a) = ShowS
forall a. a -> a
id
      | Bool
otherwise                   =
          Int -> ShowS
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar
                         ( if a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL a
1 Int
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
m
                             then Int -> Char
chr (Int -> Char) -> (a -> Int) -> a -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Char) -> a -> Char
forall a b. (a -> b) -> a -> b
$ a
48 a -> a -> a
forall a. Num a => a -> a -> a
+ (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
w Int
n a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1)
                             else Char
'X'
                         )