{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs      #-}

module HaskellWorks.Data.Bits.FromBitTextByteString
    ( FromBitTextByteString(..)
    ) where

import Data.Word
import HaskellWorks.Data.Bits

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

class FromBitTextByteString a where
  -- | Convert a binary byte string to a value of type @a
  fromBitTextByteString :: BS.ByteString -> a

instance FromBitTextByteString (DVS.Vector Word8) where
  fromBitTextByteString :: BS.ByteString -> DVS.Vector Word8
  fromBitTextByteString :: ByteString -> Vector Word8
fromBitTextByteString ByteString
bs = Int
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Vector Word8
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString -> Maybe (Word8, ByteString)
gen ByteString
bs
    where gen :: BS.ByteString -> Maybe (Word8, BS.ByteString)
          gen :: ByteString -> Maybe (Word8, ByteString)
gen ByteString
cs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Word8 -> ByteString -> Maybe (Word8, ByteString)
gen' Int
1 Word8
0 ByteString
ds
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Word8 -> ByteString -> Maybe (Word8, ByteString)
gen' Int
1 Word8
1 ByteString
ds
            Just (Word8
_, ByteString
ds) -> ByteString -> Maybe (Word8, ByteString)
gen ByteString
ds
            Maybe (Word8, ByteString)
Nothing      -> Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
          gen' :: Int -> Word8 -> BS.ByteString -> Maybe (Word8, BS.ByteString)
          gen' :: Int -> Word8 -> ByteString -> Maybe (Word8, ByteString)
gen' Int
n Word8
w ByteString
cs
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8   = (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
w, ByteString
cs)
            | Bool
otherwise = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Word8 -> ByteString -> Maybe (Word8, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. (Word8
0 Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Word8 -> ByteString -> Maybe (Word8, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. (Word8
1 Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
_, ByteString
ds) -> Int -> Word8 -> ByteString -> Maybe (Word8, ByteString)
gen' Int
n Word8
w ByteString
ds
                Maybe (Word8, ByteString)
Nothing      -> (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (Word8
w, ByteString
cs)

instance FromBitTextByteString (DVS.Vector Word16) where
  fromBitTextByteString :: BS.ByteString -> DVS.Vector Word16
  fromBitTextByteString :: ByteString -> Vector Word16
fromBitTextByteString ByteString
bs = Int
-> (ByteString -> Maybe (Word16, ByteString))
-> ByteString
-> Vector Word16
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString -> Maybe (Word16, ByteString)
gen ByteString
bs
    where gen :: BS.ByteString -> Maybe (Word16, BS.ByteString)
          gen :: ByteString -> Maybe (Word16, ByteString)
gen ByteString
cs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Word16 -> ByteString -> Maybe (Word16, ByteString)
gen' Int
1 Word16
0 ByteString
ds
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Word16 -> ByteString -> Maybe (Word16, ByteString)
gen' Int
1 Word16
1 ByteString
ds
            Just (Word8
_, ByteString
ds) -> ByteString -> Maybe (Word16, ByteString)
gen ByteString
ds
            Maybe (Word8, ByteString)
Nothing      -> Maybe (Word16, ByteString)
forall a. Maybe a
Nothing
          gen' :: Int -> Word16 -> BS.ByteString -> Maybe (Word16, BS.ByteString)
          gen' :: Int -> Word16 -> ByteString -> Maybe (Word16, ByteString)
gen' Int
n Word16
w ByteString
cs
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16   = (Word16, ByteString) -> Maybe (Word16, ByteString)
forall a. a -> Maybe a
Just (Word16
w, ByteString
cs)
            | Bool
otherwise = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Word16 -> ByteString -> Maybe (Word16, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word16
w Word16 -> Word16 -> Word16
forall a. BitWise a => a -> a -> a
.|. (Word16
0 Word16 -> Count -> Word16
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Word16 -> ByteString -> Maybe (Word16, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word16
w Word16 -> Word16 -> Word16
forall a. BitWise a => a -> a -> a
.|. (Word16
1 Word16 -> Count -> Word16
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
_, ByteString
ds) -> Int -> Word16 -> ByteString -> Maybe (Word16, ByteString)
gen' Int
n Word16
w ByteString
ds
                Maybe (Word8, ByteString)
Nothing      -> (Word16, ByteString) -> Maybe (Word16, ByteString)
forall a. a -> Maybe a
Just (Word16
w, ByteString
cs)

instance FromBitTextByteString (DVS.Vector Word32) where
  fromBitTextByteString :: BS.ByteString -> DVS.Vector Word32
  fromBitTextByteString :: ByteString -> Vector Word32
fromBitTextByteString ByteString
bs = Int
-> (ByteString -> Maybe (Word32, ByteString))
-> ByteString
-> Vector Word32
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString -> Maybe (Word32, ByteString)
gen ByteString
bs
    where gen :: BS.ByteString -> Maybe (Word32, BS.ByteString)
          gen :: ByteString -> Maybe (Word32, ByteString)
gen ByteString
cs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Word32 -> ByteString -> Maybe (Word32, ByteString)
gen' Int
1 Word32
0 ByteString
ds
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Word32 -> ByteString -> Maybe (Word32, ByteString)
gen' Int
1 Word32
1 ByteString
ds
            Just (Word8
_, ByteString
ds) -> ByteString -> Maybe (Word32, ByteString)
gen ByteString
ds
            Maybe (Word8, ByteString)
Nothing      -> Maybe (Word32, ByteString)
forall a. Maybe a
Nothing
          gen' :: Int -> Word32 -> BS.ByteString -> Maybe (Word32, BS.ByteString)
          gen' :: Int -> Word32 -> ByteString -> Maybe (Word32, ByteString)
gen' Int
n Word32
w ByteString
cs
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32   = (Word32, ByteString) -> Maybe (Word32, ByteString)
forall a. a -> Maybe a
Just (Word32
w, ByteString
cs)
            | Bool
otherwise = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Word32 -> ByteString -> Maybe (Word32, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word32
w Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|. (Word32
0 Word32 -> Count -> Word32
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Word32 -> ByteString -> Maybe (Word32, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word32
w Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|. (Word32
1 Word32 -> Count -> Word32
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
_, ByteString
ds) -> Int -> Word32 -> ByteString -> Maybe (Word32, ByteString)
gen' Int
n Word32
w ByteString
ds
                Maybe (Word8, ByteString)
Nothing      -> (Word32, ByteString) -> Maybe (Word32, ByteString)
forall a. a -> Maybe a
Just (Word32
w, ByteString
cs)

instance FromBitTextByteString (DVS.Vector Word64) where
  fromBitTextByteString :: BS.ByteString -> DVS.Vector Word64
  fromBitTextByteString :: ByteString -> Vector Count
fromBitTextByteString ByteString
bs = Int
-> (ByteString -> Maybe (Count, ByteString))
-> ByteString
-> Vector Count
forall a b.
Storable a =>
Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVS.unfoldrN (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString -> Maybe (Count, ByteString)
gen ByteString
bs
    where gen :: BS.ByteString -> Maybe (Word64, BS.ByteString)
          gen :: ByteString -> Maybe (Count, ByteString)
gen ByteString
cs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Count -> ByteString -> Maybe (Count, ByteString)
gen' Int
1 Count
0 ByteString
ds
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Count -> ByteString -> Maybe (Count, ByteString)
gen' Int
1 Count
1 ByteString
ds
            Just (Word8
_, ByteString
ds) -> ByteString -> Maybe (Count, ByteString)
gen ByteString
ds
            Maybe (Word8, ByteString)
Nothing      -> Maybe (Count, ByteString)
forall a. Maybe a
Nothing
          gen' :: Int -> Word64 -> BS.ByteString -> Maybe (Word64, BS.ByteString)
          gen' :: Int -> Count -> ByteString -> Maybe (Count, ByteString)
gen' Int
n Count
w ByteString
cs
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
64   = (Count, ByteString) -> Maybe (Count, ByteString)
forall a. a -> Maybe a
Just (Count
w, ByteString
cs)
            | Bool
otherwise = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> Int -> Count -> ByteString -> Maybe (Count, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Count
w Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.|. (Count
0 Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> Int -> Count -> ByteString -> Maybe (Count, ByteString)
gen' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Count
w Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.|. (Count
1 Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.<. Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) ByteString
ds
                Just (Word8
_, ByteString
ds) -> Int -> Count -> ByteString -> Maybe (Count, ByteString)
gen' Int
n Count
w ByteString
ds
                Maybe (Word8, ByteString)
Nothing      -> (Count, ByteString) -> Maybe (Count, ByteString)
forall a. a -> Maybe a
Just (Count
w, ByteString
cs)

instance FromBitTextByteString (DVU.Vector Bit.Bit) where
  fromBitTextByteString :: BS.ByteString -> DVU.Vector Bit.Bit
  fromBitTextByteString :: ByteString -> Vector Bit
fromBitTextByteString ByteString
bs = Int
-> (ByteString -> Maybe (Bit, ByteString))
-> ByteString
-> Vector Bit
forall a b. Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVU.unfoldrN (ByteString -> Int
BS.length ByteString
bs) ByteString -> Maybe (Bit, ByteString)
gen ByteString
bs
    where gen :: BS.ByteString -> Maybe (Bit.Bit, BS.ByteString)
          gen :: ByteString -> Maybe (Bit, ByteString)
gen ByteString
cs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> (Bit, ByteString) -> Maybe (Bit, ByteString)
forall a. a -> Maybe a
Just (Bool -> Bit
Bit.Bit Bool
False, ByteString
ds)
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> (Bit, ByteString) -> Maybe (Bit, ByteString)
forall a. a -> Maybe a
Just (Bool -> Bit
Bit.Bit Bool
True,  ByteString
ds)
            Just (Word8
_, ByteString
ds) -> ByteString -> Maybe (Bit, ByteString)
gen ByteString
ds
            Maybe (Word8, ByteString)
Nothing      -> Maybe (Bit, ByteString)
forall a. Maybe a
Nothing

instance FromBitTextByteString (DVU.Vector BitTS.Bit) where
  fromBitTextByteString :: BS.ByteString -> DVU.Vector BitTS.Bit
  fromBitTextByteString :: ByteString -> Vector Bit
fromBitTextByteString ByteString
bs = Int
-> (ByteString -> Maybe (Bit, ByteString))
-> ByteString
-> Vector Bit
forall a b. Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a
DVU.unfoldrN (ByteString -> Int
BS.length ByteString
bs) ByteString -> Maybe (Bit, ByteString)
gen ByteString
bs
    where gen :: BS.ByteString -> Maybe (BitTS.Bit, BS.ByteString)
          gen :: ByteString -> Maybe (Bit, ByteString)
gen ByteString
cs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
cs of
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w0  -> (Bit, ByteString) -> Maybe (Bit, ByteString)
forall a. a -> Maybe a
Just (Bool -> Bit
BitTS.Bit Bool
False, ByteString
ds)
            Just (Word8
d, ByteString
ds) | Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w1  -> (Bit, ByteString) -> Maybe (Bit, ByteString)
forall a. a -> Maybe a
Just (Bool -> Bit
BitTS.Bit Bool
True,  ByteString
ds)
            Just (Word8
_, ByteString
ds) -> ByteString -> Maybe (Bit, ByteString)
gen ByteString
ds
            Maybe (Word8, ByteString)
Nothing      -> Maybe (Bit, ByteString)
forall a. Maybe a
Nothing

w0 :: Word8
w0 :: Word8
w0 = Word8
48

w1 :: Word8
w1 :: Word8
w1 = Word8
49