{-# 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
class BitShow a where
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
""