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

module HaskellWorks.Data.Bits.BitRead
  ( BitRead(..)
  , unsafeBitRead
  ) where

import Data.Maybe
import Data.Word
import HaskellWorks.Data.Bits.BitParse
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

-- | Bit string reader that produces a value of a type
class BitRead a where
  -- | Read a bit string into a value
  bitRead :: String -> Maybe a

-- | Read a bit string into a value.
--
-- This function is unsafe because it is a partial function that errors if the input string is an invaild bit string
unsafeBitRead :: BitRead a => String -> a
unsafeBitRead :: String -> a
unsafeBitRead String
s = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"Invalid bit string") (String -> Maybe a
forall a. BitRead a => String -> Maybe a
bitRead String
s)

bitRead' :: BitParse a => String -> Maybe a
bitRead' :: String -> Maybe a
bitRead' String
s = (a, String) -> a
forall a b. (a, b) -> a
fst ((a, String) -> a) -> Maybe (a, String) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [(a, String)] -> Maybe (a, String)
forall a. [a] -> Maybe a
listToMaybe (Parser a -> String -> [(a, String)]
forall a. Parser a -> String -> [(a, String)]
parse Parser a
forall a. BitParse a => Parser a
bitParse0 ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
s))

bitCharToBool :: Char -> Maybe Bool
bitCharToBool :: Char -> Maybe Bool
bitCharToBool Char
'1' = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
bitCharToBool Char
'0' = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
bitCharToBool Char
_   = Maybe Bool
forall a. Maybe a
Nothing

instance BitRead Word8 where
  bitRead :: String -> Maybe Word8
bitRead = String -> Maybe Word8
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead Word16 where
  bitRead :: String -> Maybe Word16
bitRead = String -> Maybe Word16
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead Word32 where
  bitRead :: String -> Maybe Word32
bitRead = String -> Maybe Word32
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead Word64 where
  bitRead :: String -> Maybe Word64
bitRead = String -> Maybe Word64
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead BS.ByteString where
  bitRead :: String -> Maybe ByteString
bitRead = String -> Maybe ByteString
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead [Word8] where
  bitRead :: String -> Maybe [Word8]
bitRead = String -> Maybe [Word8]
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead [Word16] where
  bitRead :: String -> Maybe [Word16]
bitRead = String -> Maybe [Word16]
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead [Word32] where
  bitRead :: String -> Maybe [Word32]
bitRead = String -> Maybe [Word32]
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead [Word64] where
  bitRead :: String -> Maybe [Word64]
bitRead = String -> Maybe [Word64]
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DV.Vector Word8) where
  bitRead :: String -> Maybe (Vector Word8)
bitRead = String -> Maybe (Vector Word8)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DV.Vector Word16) where
  bitRead :: String -> Maybe (Vector Word16)
bitRead = String -> Maybe (Vector Word16)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DV.Vector Word32) where
  bitRead :: String -> Maybe (Vector Word32)
bitRead = String -> Maybe (Vector Word32)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DV.Vector Word64) where
  bitRead :: String -> Maybe (Vector Word64)
bitRead = String -> Maybe (Vector Word64)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DVS.Vector Word8) where
  bitRead :: String -> Maybe (Vector Word8)
bitRead = String -> Maybe (Vector Word8)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DVS.Vector Word16) where
  bitRead :: String -> Maybe (Vector Word16)
bitRead = String -> Maybe (Vector Word16)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DVS.Vector Word32) where
  bitRead :: String -> Maybe (Vector Word32)
bitRead = String -> Maybe (Vector Word32)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DVS.Vector Word64) where
  bitRead :: String -> Maybe (Vector Word64)
bitRead = String -> Maybe (Vector Word64)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DVU.Vector Bit.Bit) where
  bitRead :: String -> Maybe (Vector Bit)
bitRead = String -> Maybe (Vector Bit)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead (DVU.Vector BitTS.Bit) where
  bitRead :: String -> Maybe (Vector Bit)
bitRead = String -> Maybe (Vector Bit)
forall a. BitParse a => String -> Maybe a
bitRead'

instance BitRead [Bool] where
  bitRead :: String -> Maybe [Bool]
bitRead = [Maybe Bool] -> Maybe [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe Bool] -> Maybe [Bool])
-> (String -> [Maybe Bool]) -> String -> Maybe [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Bool) -> String -> [Maybe Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Maybe Bool
bitCharToBool (String -> [Maybe Bool])
-> (String -> String) -> String -> [Maybe Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')