diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ # hw-bits -[![v0.0-branch](https://circleci.com/gh/haskell-works/hw-bits/tree/v0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-bits/tree/v0.0-branch) +[![0.0-branch](https://circleci.com/gh/haskell-works/hw-bits/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-bits/tree/0.0-branch) Facilities for manipulating bits. diff --git a/hw-bits.cabal b/hw-bits.cabal --- a/hw-bits.cabal +++ b/hw-bits.cabal @@ -1,5 +1,5 @@ name: hw-bits -version: 0.0.0.6 +version: 0.0.0.7 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-bits#readme @@ -12,14 +12,13 @@ stability: Experimental build-type: Simple extra-source-files: README.md -cabal-version: >= 1.10 -data-files: test/data/sample.json +cabal-version: >= 1.22 executable hw-bits-example hs-source-dirs: app main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -msse4.2 - build-depends: base >= 4 && < 5 + build-depends: base >= 4 && < 5 , criterion , hw-bits , mmap @@ -38,20 +37,21 @@ , HaskellWorks.Data.Bits.BitWise , HaskellWorks.Data.Bits.ElemFixedBitSize , HaskellWorks.Data.Bits.FixedBitSize + , HaskellWorks.Data.Bits.FromBitTextByteString , HaskellWorks.Data.Bits.PopCount , HaskellWorks.Data.Bits.PopCount.PopCount0 , HaskellWorks.Data.Bits.PopCount.PopCount1 , HaskellWorks.Data.Bits.Types.Broadword , HaskellWorks.Data.Bits.Types.Builtin , HaskellWorks.Data.Bits.Word - build-depends: base >= 4.7 && < 5 + build-depends: base >= 4 && < 5 , bytestring - , hw-prim + , hw-prim >= 0.0.3 , parsec , vector default-language: Haskell2010 - ghc-options: -rtsopts -with-rtsopts=-N -Wall -O2 -msse4.2 + ghc-options: -Wall -O2 -msse4.2 test-suite hw-bits-test type: exitcode-stdio-1.0 @@ -59,9 +59,12 @@ main-is: Spec.hs other-modules: HaskellWorks.Data.Bits.BitReadSpec , HaskellWorks.Data.Bits.BitWiseSpec - build-depends: base + , HaskellWorks.Data.Bits.FromBitTextByteStringSpec + build-depends: base >= 4 && < 5 + , bytestring , hspec , hw-bits + , hw-prim , QuickCheck , vector ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall @@ -77,8 +80,8 @@ Main-Is: Main.hs GHC-Options: -Wall -O2 -msse4.2 Default-Language: Haskell2010 - Build-Depends: base >= 4 && < 5 + Build-Depends: base >= 4 && < 5 , criterion , hw-bits - , hw-prim + , hw-prim >= 0.0.3 , vector diff --git a/src/HaskellWorks/Data/Bits/FromBitTextByteString.hs b/src/HaskellWorks/Data/Bits/FromBitTextByteString.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Bits/FromBitTextByteString.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} + +module HaskellWorks.Data.Bits.FromBitTextByteString + ( FromBitTextByteString(..) + ) where + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.Bits + +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 bs = DVS.unfoldrN (BS.length bs `div` 8 + 1) gen bs + where gen :: BS.ByteString -> Maybe (Word8, BS.ByteString) + gen cs = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' 1 0 ds + Just (d, ds) | d == w1 -> gen' 1 1 ds + Just (_, ds) -> gen ds + Nothing -> Nothing + gen' :: Int -> Word8 -> BS.ByteString -> Maybe (Word8, BS.ByteString) + gen' n w cs + | n >= 8 = Just (w, cs) + | otherwise = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' (n + 1) (w .|. (0 .<. fromIntegral n)) ds + Just (d, ds) | d == w1 -> gen' (n + 1) (w .|. (1 .<. fromIntegral n)) ds + Just (_, ds) -> gen' n w ds + Nothing -> Just (w, cs) + +instance FromBitTextByteString (DVS.Vector Word16) where + fromBitTextByteString :: BS.ByteString -> DVS.Vector Word16 + fromBitTextByteString bs = DVS.unfoldrN (BS.length bs `div` 16 + 1) gen bs + where gen :: BS.ByteString -> Maybe (Word16, BS.ByteString) + gen cs = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' 1 0 ds + Just (d, ds) | d == w1 -> gen' 1 1 ds + Just (_, ds) -> gen ds + Nothing -> Nothing + gen' :: Int -> Word16 -> BS.ByteString -> Maybe (Word16, BS.ByteString) + gen' n w cs + | n >= 16 = Just (w, cs) + | otherwise = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' (n + 1) (w .|. (0 .<. fromIntegral n)) ds + Just (d, ds) | d == w1 -> gen' (n + 1) (w .|. (1 .<. fromIntegral n)) ds + Just (_, ds) -> gen' n w ds + Nothing -> Just (w, cs) + +instance FromBitTextByteString (DVS.Vector Word32) where + fromBitTextByteString :: BS.ByteString -> DVS.Vector Word32 + fromBitTextByteString bs = DVS.unfoldrN (BS.length bs `div` 32 + 1) gen bs + where gen :: BS.ByteString -> Maybe (Word32, BS.ByteString) + gen cs = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' 1 0 ds + Just (d, ds) | d == w1 -> gen' 1 1 ds + Just (_, ds) -> gen ds + Nothing -> Nothing + gen' :: Int -> Word32 -> BS.ByteString -> Maybe (Word32, BS.ByteString) + gen' n w cs + | n >= 32 = Just (w, cs) + | otherwise = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' (n + 1) (w .|. (0 .<. fromIntegral n)) ds + Just (d, ds) | d == w1 -> gen' (n + 1) (w .|. (1 .<. fromIntegral n)) ds + Just (_, ds) -> gen' n w ds + Nothing -> Just (w, cs) + +instance FromBitTextByteString (DVS.Vector Word64) where + fromBitTextByteString :: BS.ByteString -> DVS.Vector Word64 + fromBitTextByteString bs = DVS.unfoldrN (BS.length bs `div` 64 + 1) gen bs + where gen :: BS.ByteString -> Maybe (Word64, BS.ByteString) + gen cs = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' 1 0 ds + Just (d, ds) | d == w1 -> gen' 1 1 ds + Just (_, ds) -> gen ds + Nothing -> Nothing + gen' :: Int -> Word64 -> BS.ByteString -> Maybe (Word64, BS.ByteString) + gen' n w cs + | n >= 64 = Just (w, cs) + | otherwise = case BS.uncons cs of + Just (d, ds) | d == w0 -> gen' (n + 1) (w .|. (0 .<. fromIntegral n)) ds + Just (d, ds) | d == w1 -> gen' (n + 1) (w .|. (1 .<. fromIntegral n)) ds + Just (_, ds) -> gen' n w ds + Nothing -> Just (w, cs) + +w0 :: Word8 +w0 = 48 + +w1 :: Word8 +w1 = 49 diff --git a/test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs b/test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Bits/FromBitTextByteStringSpec.hs @@ -0,0 +1,94 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.Bits.FromBitTextByteStringSpec (spec) where + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import Data.Word +import HaskellWorks.Data.Bits.FromBitTextByteString +import Test.Hspec + +{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} + +spec :: Spec +spec = describe "HaskellWorks.Data.FromBitTextByteStringSpec" $ do + describe "For (DVS.Vector Word8)" $ do + it "fromBitTextByteString (BS.unpack []) :: DVS.Vector Word8" $ + let w = fromBitTextByteString (BS.pack []) ::DVS.Vector Word8 in + w `shouldBe` DVS.fromList [] + it "fromBitTextByteString (BS.unpack \"0\") :: DVS.Vector Word8" $ + let w = fromBitTextByteString "0" ::DVS.Vector Word8 in + w `shouldBe` DVS.fromList [0x0] + it "fromBitTextByteString (BS.unpack \"1\") :: DVS.Vector Word8" $ + let w = fromBitTextByteString "1" ::DVS.Vector Word8 in + w `shouldBe` DVS.fromList [0x1] + it "fromBitTextByteString (BS.unpack \"11110000\") :: DVS.Vector Word8" $ + let w = fromBitTextByteString "11110000" ::DVS.Vector Word8 in + w `shouldBe` DVS.fromList [0x0f] + it "fromBitTextByteString (BS.unpack \"111100000\") :: DVS.Vector Word8" $ + let w = fromBitTextByteString "111100000" ::DVS.Vector Word8 in + w `shouldBe` DVS.fromList [0x0f, 0x0] + it "fromBitTextByteString (BS.unpack \"111100001\") :: DVS.Vector Word8" $ + let w = fromBitTextByteString "111100001" ::DVS.Vector Word8 in + w `shouldBe` DVS.fromList [0x0f, 0x1] + describe "For (DVS.Vector Word16)" $ do + it "fromBitTextByteString (BS.unpack []) :: DVS.Vector Word16" $ + let w = fromBitTextByteString (BS.pack []) ::DVS.Vector Word16 in + w `shouldBe` DVS.fromList [] + it "fromBitTextByteString (BS.unpack \"0\") :: DVS.Vector Word16" $ + let w = fromBitTextByteString "0" ::DVS.Vector Word16 in + w `shouldBe` DVS.fromList [0x0] + it "fromBitTextByteString (BS.unpack \"1\") :: DVS.Vector Word16" $ + let w = fromBitTextByteString "1" ::DVS.Vector Word16 in + w `shouldBe` DVS.fromList [0x1] + it "fromBitTextByteString (BS.unpack \"1111000011110000\") :: DVS.Vector Word16" $ + let w = fromBitTextByteString "1111000011110000" ::DVS.Vector Word16 in + w `shouldBe` DVS.fromList [0x0f0f] + it "fromBitTextByteString (BS.unpack \"11110000111100000\") :: DVS.Vector Word16" $ + let w = fromBitTextByteString "11110000111100000" ::DVS.Vector Word16 in + w `shouldBe` DVS.fromList [0x0f0f, 0x0] + it "fromBitTextByteString (BS.unpack \"11110000111100001\") :: DVS.Vector Word16" $ + let w = fromBitTextByteString "11110000111100001" ::DVS.Vector Word16 in + w `shouldBe` DVS.fromList [0x0f0f, 0x1] + describe "For (DVS.Vector Word32)" $ do + it "fromBitTextByteString (BS.unpack []) :: DVS.Vector Word32" $ + let w = fromBitTextByteString (BS.pack []) ::DVS.Vector Word32 in + w `shouldBe` DVS.fromList [] + it "fromBitTextByteString (BS.unpack \"0\") :: DVS.Vector Word32" $ + let w = fromBitTextByteString "0" ::DVS.Vector Word32 in + w `shouldBe` DVS.fromList [0x0] + it "fromBitTextByteString (BS.unpack \"1\") :: DVS.Vector Word32" $ + let w = fromBitTextByteString "1" ::DVS.Vector Word32 in + w `shouldBe` DVS.fromList [0x1] + it "fromBitTextByteString (BS.unpack \"11110000111100001111000011110000\") :: DVS.Vector Word32" $ + let w = fromBitTextByteString "11110000111100001111000011110000" ::DVS.Vector Word32 in + w `shouldBe` DVS.fromList [0x0f0f0f0f] + it "fromBitTextByteString (BS.unpack \"111100001111000011110000111100000\") :: DVS.Vector Word32" $ + let w = fromBitTextByteString "111100001111000011110000111100000" ::DVS.Vector Word32 in + w `shouldBe` DVS.fromList [0x0f0f0f0f, 0x0] + it "fromBitTextByteString (BS.unpack \"111100001111000011110000111100001\") :: DVS.Vector Word32" $ + let w = fromBitTextByteString "111100001111000011110000111100001" ::DVS.Vector Word32 in + w `shouldBe` DVS.fromList [0x0f0f0f0f, 0x1] + describe "For (DVS.Vector Word64)" $ do + it "fromBitTextByteString (BS.unpack []) :: DVS.Vector Word64" $ + let w = fromBitTextByteString (BS.pack []) ::DVS.Vector Word64 in + w `shouldBe` DVS.fromList [] + it "fromBitTextByteString (BS.unpack \"0\") :: DVS.Vector Word64" $ + let w = fromBitTextByteString "0" ::DVS.Vector Word64 in + w `shouldBe` DVS.fromList [0x0] + it "fromBitTextByteString (BS.unpack \"1\") :: DVS.Vector Word64" $ + let w = fromBitTextByteString "1" ::DVS.Vector Word64 in + w `shouldBe` DVS.fromList [0x1] + it "fromBitTextByteString (BS.unpack \"1111000011110000111100001111000011110000111100001111000011110000\") :: DVS.Vector Word64" $ + let w = fromBitTextByteString "1111000011110000111100001111000011110000111100001111000011110000" ::DVS.Vector Word64 in + w `shouldBe` DVS.fromList [0x0f0f0f0f0f0f0f0f] + it "fromBitTextByteString (BS.unpack \"11110000111100001111000011110000111100001111000011110000111100000\") :: DVS.Vector Word64" $ + let w = fromBitTextByteString "11110000111100001111000011110000111100001111000011110000111100000" ::DVS.Vector Word64 in + w `shouldBe` DVS.fromList [0x0f0f0f0f0f0f0f0f, 0x0] + it "fromBitTextByteString (BS.unpack \"11110000111100001111000011110000111100001111000011110000111100001\") :: DVS.Vector Word64" $ + let w = fromBitTextByteString "11110000111100001111000011110000111100001111000011110000111100001" ::DVS.Vector Word64 in + w `shouldBe` DVS.fromList [0x0f0f0f0f0f0f0f0f, 0x1] diff --git a/test/data/sample.json b/test/data/sample.json deleted file mode 100644 --- a/test/data/sample.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "widget": { - "debug": "on", - "window": { - "title": "Sample Konfabulator Widget", - "name": "main_window", - "width": 500, - "height": 500 - }, - "image": { - "src": "Images/Sun.png", - "name": "sun1", - "hOffset": 250, - "vOffset": 250, - "alignment": "center" - }, - "text": { - "data": "Click Here", - "size": 36, - "style": "bold", - "name": "text1", - "hOffset": 250, - "vOffset": 100, - "alignment": "center", - "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;" - } - } -}