{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module HaskellWorks.Data.Bits.BitShow
  ( BitShow(..)
  , bitShow
  ) where

import Data.Int
import Data.Word
import GHC.Exts
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Bits.Word

import qualified Data.Bit             as Bit
import qualified Data.Bit.ThreadSafe  as BitTS
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Vector          as DV
import qualified Data.Vector.Storable as DVS
import qualified Data.Vector.Unboxed  as DVU

-- | Shower of a value as a bit string
class BitShow a where
  -- | Show a value as a bit string
  bitShows :: a -> String -> String

instance BitShow Bool where
  bitShows :: Bool -> String -> String
bitShows Bool
a = ((if Bool
a then Char
'1' else Char
'0')Char -> String -> String
forall a. a -> [a] -> [a]
:)

instance BitShow Word8 where
  bitShows :: Word8 -> String -> String
bitShows Word8
w =
      (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
0 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
1 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
2 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
3 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
4 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
5 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
6 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))
    (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Word8
w Word8 -> Position -> Bool
forall a. TestBit a => a -> Position -> Bool
.?. Position
7 then (Char
'1'Char -> String -> String
forall a. a -> [a] -> [a]
:) else (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:))

instance BitShow Word16 where
  bitShows :: Word16 -> String -> String
bitShows Word16
w = case Word16 -> (HalfWords Word16, HalfWords Word16)
forall a. WordSplit a => a -> (HalfWords a, HalfWords a)
leSplit Word16
w of (HalfWords Word16
a, HalfWords Word16
b) -> Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word8
HalfWords Word16
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word8
HalfWords Word16
b

instance BitShow Word32 where
  bitShows :: Word32 -> String -> String
bitShows Word32
w = case Word32 -> (HalfWords Word32, HalfWords Word32)
forall a. WordSplit a => a -> (HalfWords a, HalfWords a)
leSplit Word32
w of (HalfWords Word32
a, HalfWords Word32
b) -> Word16 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word16
HalfWords Word32
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word16
HalfWords Word32
b

instance BitShow Word64 where
  bitShows :: Word64 -> String -> String
bitShows Word64
w = case Word64 -> (HalfWords Word64, HalfWords Word64)
forall a. WordSplit a => a -> (HalfWords a, HalfWords a)
leSplit Word64
w of (HalfWords Word64
a, HalfWords Word64
b) -> Word32 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word32
HalfWords Word64
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word32
HalfWords Word64
b

instance BitShow Int8 where
  bitShows :: Int8 -> String -> String
bitShows = Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (Word8 -> String -> String)
-> (Int8 -> Word8) -> Int8 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Int8, Num Word8) => Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int8 @Word8

instance BitShow Int16 where
  bitShows :: Int16 -> String -> String
bitShows = Word16 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (Word16 -> String -> String)
-> (Int16 -> Word16) -> Int16 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Int16, Num Word16) => Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int16 @Word16

instance BitShow Int32 where
  bitShows :: Int32 -> String -> String
bitShows = Word32 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (Word32 -> String -> String)
-> (Int32 -> Word32) -> Int32 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Int32, Num Word32) => Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word32

instance BitShow Int64 where
  bitShows :: Position -> String -> String
bitShows = Word64 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (Word64 -> String -> String)
-> (Position -> Word64) -> Position -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integral Position, Num Word64) => Position -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Word64

instance BitShow [Bool] where
  bitShows :: [Bool] -> String -> String
bitShows [Bool]
ws = (Char
'\"'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Bool] -> String -> String
forall a t. (BitShow a, Integral t) => t -> [a] -> String -> String
go (Int
0 :: Int) [Bool]
ws (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'\"'Char -> String -> String
forall a. a -> [a] -> [a]
:)
    where go :: t -> [a] -> String -> String
go t
_ []     = String -> String
forall a. a -> a
id
          go t
_ [a
u]    = a -> String -> String
forall a. BitShow a => a -> String -> String
bitShows a
u
          go t
n (a
u:[a]
us) = a -> String -> String
forall a. BitShow a => a -> String -> String
bitShows a
u (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String -> String
forall a. Integral a => a -> String -> String
maybePrependSeperatorat t
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [a] -> String -> String
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) [a]
us
          maybePrependSeperatorat :: a -> String -> String
maybePrependSeperatorat a
n = if a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
8 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
7 then (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) else String -> String
forall a. a -> a
id

instance BitShow BS.ByteString where
  bitShows :: ByteString -> String -> String
bitShows ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> String
forall a. a -> a
id
  bitShows ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (ByteString -> Word8
BS.head ByteString
bs)
  bitShows ByteString
bs = Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (ByteString -> Word8
BS.head ByteString
bs) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (ByteString -> ByteString
BS.tail ByteString
bs)

instance BitShow BSL.ByteString where
  bitShows :: ByteString -> String -> String
bitShows ByteString
bs | ByteString -> Position
BSL.length ByteString
bs Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
0 = String -> String
forall a. a -> a
id
  bitShows ByteString
bs | ByteString -> Position
BSL.length ByteString
bs Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
1 = Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (ByteString -> Word8
BSL.head ByteString
bs)
  bitShows ByteString
bs = Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (ByteString -> Word8
BSL.head ByteString
bs) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> String
forall a. BitShow a => a -> String -> String
bitShows (ByteString -> ByteString
BSL.tail ByteString
bs)

instance BitShow [Word8] where
  bitShows :: [Word8] -> String -> String
bitShows []     = String -> String
forall a. a -> a
id
  bitShows [Word8
w]    = Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word8
w
  bitShows (Word8
w:[Word8]
ws) = Word8 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word8
w (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows [Word8]
ws

instance BitShow [Word16] where
  bitShows :: [Word16] -> String -> String
bitShows []     = String -> String
forall a. a -> a
id
  bitShows [Word16
w]    = Word16 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word16
w
  bitShows (Word16
w:[Word16]
ws) = Word16 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word16
w (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word16] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows [Word16]
ws

instance BitShow [Word32] where
  bitShows :: [Word32] -> String -> String
bitShows []     = String -> String
forall a. a -> a
id
  bitShows [Word32
w]    = Word32 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word32
w
  bitShows (Word32
w:[Word32]
ws) = Word32 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word32
w (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows [Word32]
ws

instance BitShow [Word64] where
  bitShows :: [Word64] -> String -> String
bitShows []     = String -> String
forall a. a -> a
id
  bitShows [Word64
w]    = Word64 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word64
w
  bitShows (Word64
w:[Word64]
ws) = Word64 -> String -> String
forall a. BitShow a => a -> String -> String
bitShows Word64
w (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows [Word64]
ws

instance BitShow (DV.Vector Word8) where
  bitShows :: Vector Word8 -> String -> String
bitShows = [Word8] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word8] -> String -> String)
-> (Vector Word8 -> [Word8]) -> Vector Word8 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> [Word8]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DV.Vector Word16) where
  bitShows :: Vector Word16 -> String -> String
bitShows = [Word16] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word16] -> String -> String)
-> (Vector Word16 -> [Word16]) -> Vector Word16 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word16 -> [Word16]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DV.Vector Word32) where
  bitShows :: Vector Word32 -> String -> String
bitShows = [Word32] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word32] -> String -> String)
-> (Vector Word32 -> [Word32]) -> Vector Word32 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word32 -> [Word32]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DV.Vector Word64) where
  bitShows :: Vector Word64 -> String -> String
bitShows = [Word64] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word64] -> String -> String)
-> (Vector Word64 -> [Word64]) -> Vector Word64 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> [Word64]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DVS.Vector Word8) where
  bitShows :: Vector Word8 -> String -> String
bitShows = [Word8] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word8] -> String -> String)
-> (Vector Word8 -> [Word8]) -> Vector Word8 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> [Word8]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DVS.Vector Word16) where
  bitShows :: Vector Word16 -> String -> String
bitShows = [Word16] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word16] -> String -> String)
-> (Vector Word16 -> [Word16]) -> Vector Word16 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word16 -> [Word16]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DVS.Vector Word32) where
  bitShows :: Vector Word32 -> String -> String
bitShows = [Word32] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word32] -> String -> String)
-> (Vector Word32 -> [Word32]) -> Vector Word32 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word32 -> [Word32]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DVS.Vector Word64) where
  bitShows :: Vector Word64 -> String -> String
bitShows = [Word64] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Word64] -> String -> String)
-> (Vector Word64 -> [Word64]) -> Vector Word64 -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> [Word64]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DVU.Vector Bit.Bit) where
  bitShows :: Vector Bit -> String -> String
bitShows = [Bool] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Bool] -> String -> String)
-> (Vector Bit -> [Bool]) -> Vector Bit -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> Bool) -> [Bit] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bit -> Bool
Bit.unBit ([Bit] -> [Bool]) -> (Vector Bit -> [Bit]) -> Vector Bit -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Bit -> [Bit]
forall l. IsList l => l -> [Item l]
toList

instance BitShow (DVU.Vector BitTS.Bit) where
  bitShows :: Vector Bit -> String -> String
bitShows = [Bool] -> String -> String
forall a. BitShow a => a -> String -> String
bitShows ([Bool] -> String -> String)
-> (Vector Bit -> [Bool]) -> Vector Bit -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bit -> Bool) -> [Bit] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bit -> Bool
BitTS.unBit ([Bit] -> [Bool]) -> (Vector Bit -> [Bit]) -> Vector Bit -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Bit -> [Bit]
forall l. IsList l => l -> [Item l]
toList

bitShow :: BitShow a => a -> String
bitShow :: a -> String
bitShow a
a = a -> String -> String
forall a. BitShow a => a -> String -> String
bitShows a
a String
""