{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving         #-}

module HaskellWorks.Data.Bits.BitShown
  ( BitShown(..)
  , bitShown
  ) where

import Control.DeepSeq
import Data.Maybe
import Data.String
import Data.Word
import GHC.Generics
import HaskellWorks.Data.Bits.BitRead
import HaskellWorks.Data.Bits.BitShow
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.FromByteString

import qualified Data.ByteString as BS

-- | Tag for a value describe the value as being able to be shown as a bit string
newtype BitShown a = BitShown { BitShown a -> a
unBitShown :: a } deriving (BitShown a -> BitShown a -> Bool
(BitShown a -> BitShown a -> Bool)
-> (BitShown a -> BitShown a -> Bool) -> Eq (BitShown a)
forall a. Eq a => BitShown a -> BitShown a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitShown a -> BitShown a -> Bool
$c/= :: forall a. Eq a => BitShown a -> BitShown a -> Bool
== :: BitShown a -> BitShown a -> Bool
$c== :: forall a. Eq a => BitShown a -> BitShown a -> Bool
Eq, String -> Maybe (BitShown a)
(String -> Maybe (BitShown a)) -> BitRead (BitShown a)
forall a. BitRead a => String -> Maybe (BitShown a)
forall a. (String -> Maybe a) -> BitRead a
bitRead :: String -> Maybe (BitShown a)
$cbitRead :: forall a. BitRead a => String -> Maybe (BitShown a)
BitRead, BitShown a -> String -> String
(BitShown a -> String -> String) -> BitShow (BitShown a)
forall a. BitShow a => BitShown a -> String -> String
forall a. (a -> String -> String) -> BitShow a
bitShows :: BitShown a -> String -> String
$cbitShows :: forall a. BitShow a => BitShown a -> String -> String
BitShow, (forall x. BitShown a -> Rep (BitShown a) x)
-> (forall x. Rep (BitShown a) x -> BitShown a)
-> Generic (BitShown a)
forall x. Rep (BitShown a) x -> BitShown a
forall x. BitShown a -> Rep (BitShown a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BitShown a) x -> BitShown a
forall a x. BitShown a -> Rep (BitShown a) x
$cto :: forall a x. Rep (BitShown a) x -> BitShown a
$cfrom :: forall a x. BitShown a -> Rep (BitShown a) x
Generic, BitShown a -> ()
(BitShown a -> ()) -> NFData (BitShown a)
forall a. NFData a => BitShown a -> ()
forall a. (a -> ()) -> NFData a
rnf :: BitShown a -> ()
$crnf :: forall a. NFData a => BitShown a -> ()
NFData)

deriving instance Functor BitShown

instance BitRead a => IsString (BitShown a) where
  fromString :: String -> BitShown a
fromString = Maybe (BitShown a) -> BitShown a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (BitShown a) -> BitShown a)
-> (String -> Maybe (BitShown a)) -> String -> BitShown a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (BitShown a)
forall a. BitRead a => String -> Maybe a
bitRead

instance BitShow a => Show (BitShown a) where
  show :: BitShown a -> String
show BitShown a
a = BitShown a -> String -> String
forall a. BitShow a => a -> String -> String
bitShows BitShown a
a String
""

-- | Show the value as a bit string
bitShown :: BitShown a -> a
bitShown :: BitShown a -> a
bitShown (BitShown a
a) = a
a

deriving instance TestBit a => TestBit (BitShown a)

instance FromByteString (BitShown [Bool]) where
  fromByteString :: ByteString -> BitShown [Bool]
fromByteString = [Bool] -> BitShown [Bool]
forall a. a -> BitShown a
BitShown ([Bool] -> BitShown [Bool])
-> (ByteString -> [Bool]) -> ByteString -> BitShown [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [Bool] -> [Bool]) -> [Bool] -> ByteString -> [Bool]
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr Word8 -> [Bool] -> [Bool]
gen []
    where gen :: Word8 -> [Bool] -> [Bool]
          gen :: Word8 -> [Bool] -> [Bool]
gen Word8
w [Bool]
bs =
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x01 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x02 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x04 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x08 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x10 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x20 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x40 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
            (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
bs