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

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

import Control.Applicative
import Data.Word
import GHC.Exts
import HaskellWorks.Data.Bits.BitLength
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.String.Parse

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

-- | Parsers for bit strings
class BitParse a where
  -- | Version of bit string parser that can consume no inputs
  bitParse0       :: Parser a
  -- | Version of bit string parser that must consume at least one input
  bitParse1       :: Parser a

p0 :: Parser Bool
p0 :: Parser Bool
p0 = Char -> Parser Char
char Char
'1' Parser Char -> Parser Bool -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

p1 :: Parser Bool
p1 :: Parser Bool
p1 = Char -> Parser Char
char Char
'0' Parser Char -> Parser Bool -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

instance BitParse Bool where
  bitParse0 :: Parser Bool
bitParse0 = Parser Bool
forall a. BitParse a => Parser a
bitParse1 Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  bitParse1 :: Parser Bool
bitParse1 = Parser Bool
p0 Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Bool
p1

instance BitParse Word8 where
  bitParse0 :: Parser Word8
bitParse0 = Parser Word8
forall a. BitParse a => Parser a
bitParse1 Parser Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> Parser Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
0
  bitParse1 :: Parser Word8
bitParse1 = do
    Bool
a :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse1
    Bool
b :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse0
    Bool
c :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse0
    Bool
d :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse0
    Bool
e :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse0
    Bool
f :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse0
    Bool
g :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse0
    Bool
h :: Bool <- Parser Bool
forall a. BitParse a => Parser a
bitParse0
    Word8 -> Parser Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Parser Word8) -> Word8 -> Parser Word8
forall a b. (a -> b) -> a -> b
$
      (if Bool
a then Word8
0x01 else Word8
0) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|.
      (if Bool
b then Word8
0x02 else Word8
0) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|.
      (if Bool
c then Word8
0x04 else Word8
0) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|.
      (if Bool
d then Word8
0x08 else Word8
0) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|.
      (if Bool
e then Word8
0x10 else Word8
0) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|.
      (if Bool
f then Word8
0x20 else Word8
0) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|.
      (if Bool
g then Word8
0x40 else Word8
0) Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|.
      (if Bool
h then Word8
0x80 else Word8
0)

instance BitParse Word16 where
  bitParse0 :: Parser Word16
bitParse0 = Parser Word16
forall a. BitParse a => Parser a
bitParse1 Parser Word16 -> Parser Word16 -> Parser Word16
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word16 -> Parser Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
0
  bitParse1 :: Parser Word16
bitParse1 = do
    (Word8
a :: Word8) <- Parser Word8
forall a. BitParse a => Parser a
bitParse1
    (Word8
b :: Word8) <- Parser Word8
forall a. BitParse a => Parser a
bitParse0
    Word16 -> Parser Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Parser Word16) -> Word16 -> Parser Word16
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word16 -> Count -> Word16
forall a. Shift a => a -> Count -> a
.<. Word8 -> Count
forall v. BitLength v => v -> Count
bitLength Word8
a) Word16 -> Word16 -> Word16
forall a. BitWise a => a -> a -> a
.|. Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a

instance BitParse Word32 where
  bitParse0 :: Parser Word32
bitParse0 = Parser Word32
forall a. BitParse a => Parser a
bitParse1 Parser Word32 -> Parser Word32 -> Parser Word32
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word32 -> Parser Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
  bitParse1 :: Parser Word32
bitParse1 = do
    (Word16
a :: Word16) <- Parser Word16
forall a. BitParse a => Parser a
bitParse1
    (Word16
b :: Word16) <- Parser Word16
forall a. BitParse a => Parser a
bitParse0
    Word32 -> Parser Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Parser Word32) -> Word32 -> Parser Word32
forall a b. (a -> b) -> a -> b
$ (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
b Word32 -> Count -> Word32
forall a. Shift a => a -> Count -> a
.<. Word16 -> Count
forall v. BitLength v => v -> Count
bitLength Word16
a) Word32 -> Word32 -> Word32
forall a. BitWise a => a -> a -> a
.|. Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a

instance BitParse Word64 where
  bitParse0 :: Parser Count
bitParse0 = Parser Count
forall a. BitParse a => Parser a
bitParse1 Parser Count -> Parser Count -> Parser Count
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Count -> Parser Count
forall (m :: * -> *) a. Monad m => a -> m a
return Count
0
  bitParse1 :: Parser Count
bitParse1 = do
    (Word32
a :: Word32) <- Parser Word32
forall a. BitParse a => Parser a
bitParse1
    (Word32
b :: Word32) <- Parser Word32
forall a. BitParse a => Parser a
bitParse0
    Count -> Parser Count
forall (m :: * -> *) a. Monad m => a -> m a
return (Count -> Parser Count) -> Count -> Parser Count
forall a b. (a -> b) -> a -> b
$ (Word32 -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
b Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.<. Word32 -> Count
forall v. BitLength v => v -> Count
bitLength Word32
a) Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.|. Word32 -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a

instance BitParse BS.ByteString where
  bitParse0 :: Parser ByteString
bitParse0 = ([Word8] -> ByteString) -> Parser [Word8] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack Parser [Word8]
forall a. BitParse a => Parser a
bitParse0
  bitParse1 :: Parser ByteString
bitParse1 = ([Word8] -> ByteString) -> Parser [Word8] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack Parser [Word8]
forall a. BitParse a => Parser a
bitParse1

instance BitParse [Word8] where
  bitParse0 :: Parser [Word8]
bitParse0 = Parser [Word8]
forall a. BitParse a => Parser a
bitParse1 Parser [Word8] -> Parser [Word8] -> Parser [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Word8] -> Parser [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  bitParse1 :: Parser [Word8]
bitParse1 = Parser Word8 -> Parser [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Word8
forall a. BitParse a => Parser a
bitParse1

instance BitParse [Word16] where
  bitParse0 :: Parser [Word16]
bitParse0 = Parser [Word16]
forall a. BitParse a => Parser a
bitParse1 Parser [Word16] -> Parser [Word16] -> Parser [Word16]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Word16] -> Parser [Word16]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  bitParse1 :: Parser [Word16]
bitParse1 = Parser Word16 -> Parser [Word16]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Word16
forall a. BitParse a => Parser a
bitParse1

instance BitParse [Word32] where
  bitParse0 :: Parser [Word32]
bitParse0 = Parser [Word32]
forall a. BitParse a => Parser a
bitParse1 Parser [Word32] -> Parser [Word32] -> Parser [Word32]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Word32] -> Parser [Word32]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  bitParse1 :: Parser [Word32]
bitParse1 = Parser Word32 -> Parser [Word32]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Word32
forall a. BitParse a => Parser a
bitParse1

instance BitParse [Word64] where
  bitParse0 :: Parser [Count]
bitParse0 = Parser [Count]
forall a. BitParse a => Parser a
bitParse1 Parser [Count] -> Parser [Count] -> Parser [Count]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Count] -> Parser [Count]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  bitParse1 :: Parser [Count]
bitParse1 = Parser Count -> Parser [Count]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Count
forall a. BitParse a => Parser a
bitParse1

instance BitParse (DV.Vector Word8) where
  bitParse0 :: Parser (Vector Word8)
bitParse0 = Parser (Vector Word8)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Word8)
-> Parser (Vector Word8) -> Parser (Vector Word8)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Word8 -> Parser (Vector Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Word8
forall a. Vector a
DV.empty
  bitParse1 :: Parser (Vector Word8)
bitParse1 = [Word8] -> Vector Word8
forall l. IsList l => [Item l] -> l
fromList ([Word8] -> Vector Word8)
-> Parser [Word8] -> Parser (Vector Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Word8]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DV.Vector Word16) where
  bitParse0 :: Parser (Vector Word16)
bitParse0 = Parser (Vector Word16)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Word16)
-> Parser (Vector Word16) -> Parser (Vector Word16)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Word16 -> Parser (Vector Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Word16
forall a. Vector a
DV.empty
  bitParse1 :: Parser (Vector Word16)
bitParse1 = [Word16] -> Vector Word16
forall l. IsList l => [Item l] -> l
fromList ([Word16] -> Vector Word16)
-> Parser [Word16] -> Parser (Vector Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Word16]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DV.Vector Word32) where
  bitParse0 :: Parser (Vector Word32)
bitParse0 = Parser (Vector Word32)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Word32)
-> Parser (Vector Word32) -> Parser (Vector Word32)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Word32 -> Parser (Vector Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Word32
forall a. Vector a
DV.empty
  bitParse1 :: Parser (Vector Word32)
bitParse1 = [Word32] -> Vector Word32
forall l. IsList l => [Item l] -> l
fromList ([Word32] -> Vector Word32)
-> Parser [Word32] -> Parser (Vector Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Word32]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DV.Vector Word64) where
  bitParse0 :: Parser (Vector Count)
bitParse0 = Parser (Vector Count)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Count)
-> Parser (Vector Count) -> Parser (Vector Count)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Count -> Parser (Vector Count)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Count
forall a. Vector a
DV.empty
  bitParse1 :: Parser (Vector Count)
bitParse1 = [Count] -> Vector Count
forall l. IsList l => [Item l] -> l
fromList ([Count] -> Vector Count)
-> Parser [Count] -> Parser (Vector Count)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Count]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DVS.Vector Word8) where
  bitParse0 :: Parser (Vector Word8)
bitParse0 = Parser (Vector Word8)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Word8)
-> Parser (Vector Word8) -> Parser (Vector Word8)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Word8 -> Parser (Vector Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Word8
forall a. Storable a => Vector a
DVS.empty
  bitParse1 :: Parser (Vector Word8)
bitParse1 = [Word8] -> Vector Word8
forall l. IsList l => [Item l] -> l
fromList ([Word8] -> Vector Word8)
-> Parser [Word8] -> Parser (Vector Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Word8]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DVS.Vector Word16) where
  bitParse0 :: Parser (Vector Word16)
bitParse0 = Parser (Vector Word16)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Word16)
-> Parser (Vector Word16) -> Parser (Vector Word16)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Word16 -> Parser (Vector Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Word16
forall a. Storable a => Vector a
DVS.empty
  bitParse1 :: Parser (Vector Word16)
bitParse1 = [Word16] -> Vector Word16
forall l. IsList l => [Item l] -> l
fromList ([Word16] -> Vector Word16)
-> Parser [Word16] -> Parser (Vector Word16)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Word16]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DVS.Vector Word32) where
  bitParse0 :: Parser (Vector Word32)
bitParse0 = Parser (Vector Word32)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Word32)
-> Parser (Vector Word32) -> Parser (Vector Word32)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Word32 -> Parser (Vector Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Word32
forall a. Storable a => Vector a
DVS.empty
  bitParse1 :: Parser (Vector Word32)
bitParse1 = [Word32] -> Vector Word32
forall l. IsList l => [Item l] -> l
fromList ([Word32] -> Vector Word32)
-> Parser [Word32] -> Parser (Vector Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Word32]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DVS.Vector Word64) where
  bitParse0 :: Parser (Vector Count)
bitParse0 = Parser (Vector Count)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Count)
-> Parser (Vector Count) -> Parser (Vector Count)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Count -> Parser (Vector Count)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Count
forall a. Storable a => Vector a
DVS.empty
  bitParse1 :: Parser (Vector Count)
bitParse1 = [Count] -> Vector Count
forall l. IsList l => [Item l] -> l
fromList ([Count] -> Vector Count)
-> Parser [Count] -> Parser (Vector Count)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Parser [Count]
forall a. BitParse a => Parser a
bitParse0

instance BitParse (DVU.Vector Bit.Bit) where
  bitParse0 :: Parser (Vector Bit)
bitParse0 = Parser (Vector Bit)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Bit) -> Parser (Vector Bit) -> Parser (Vector Bit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Bit -> Parser (Vector Bit)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Bit
forall a. Unbox a => Vector a
DVU.empty
  bitParse1 :: Parser (Vector Bit)
bitParse1 = [Bit] -> Vector Bit
forall l. IsList l => [Item l] -> l
fromList ([Bit] -> Vector Bit) -> ([Bool] -> [Bit]) -> [Bool] -> Vector Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bit) -> [Bool] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map Bool -> Bit
Bit.Bit ([Bool] -> Vector Bit) -> Parser [Bool] -> Parser (Vector Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool -> Parser [Bool]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Bool
forall a. BitParse a => Parser a
bitParse1

instance BitParse (DVU.Vector BitTS.Bit) where
  bitParse0 :: Parser (Vector Bit)
bitParse0 = Parser (Vector Bit)
forall a. BitParse a => Parser a
bitParse1 Parser (Vector Bit) -> Parser (Vector Bit) -> Parser (Vector Bit)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Bit -> Parser (Vector Bit)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Bit
forall a. Unbox a => Vector a
DVU.empty
  bitParse1 :: Parser (Vector Bit)
bitParse1 = [Bit] -> Vector Bit
forall l. IsList l => [Item l] -> l
fromList ([Bit] -> Vector Bit) -> ([Bool] -> [Bit]) -> [Bool] -> Vector Bit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bit) -> [Bool] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map Bool -> Bit
BitTS.Bit ([Bool] -> Vector Bit) -> Parser [Bool] -> Parser (Vector Bit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool -> Parser [Bool]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Bool
forall a. BitParse a => Parser a
bitParse1