Implements functions to convert to and from raw bytes
This commit is contained in:
parent
1962b0a137
commit
31fa13f7ca
2 changed files with 29 additions and 16 deletions
|
@ -1,8 +1,10 @@
|
|||
module Data.HexString ( HexString
|
||||
, hexString
|
||||
, toHex
|
||||
, fromHex
|
||||
, asText ) where
|
||||
, fromBinary
|
||||
, toBinary
|
||||
, fromBytes
|
||||
, toBytes
|
||||
, toText ) where
|
||||
|
||||
import Data.Word (Word8)
|
||||
|
||||
|
@ -36,13 +38,23 @@ hexString bs =
|
|||
else error ("Not a valid hex string: " ++ show bs)
|
||||
|
||||
-- | Converts a 'B.Binary' to a 'HexString' value
|
||||
toHex :: B.Binary a => a -> HexString
|
||||
toHex = hexString . BS16.encode . BSL.toStrict . B.encode
|
||||
fromBinary :: B.Binary a => a -> HexString
|
||||
fromBinary = hexString . BS16.encode . BSL.toStrict . B.encode
|
||||
|
||||
-- | Converts a 'HexString' to a 'B.Binary' value
|
||||
fromHex :: B.Binary a => HexString -> a
|
||||
fromHex (HexString bs) = B.decode . BSL.fromStrict . fst . BS16.decode $ bs
|
||||
toBinary :: B.Binary a => HexString -> a
|
||||
toBinary (HexString bs) = B.decode . BSL.fromStrict . fst . BS16.decode $ bs
|
||||
|
||||
-- | Reads a 'BS.ByteString' as raw bytes and converts to hex representation. We
|
||||
-- cannot use the instance Binary of 'BS.ByteString' because it provides
|
||||
-- a leading length, which is not what we want when dealing with raw bytes.
|
||||
fromBytes :: BS.ByteString -> HexString
|
||||
fromBytes = hexString . BS16.encode
|
||||
|
||||
-- | Access to the raw bytes in a 'BS.ByteString' format.
|
||||
toBytes :: HexString -> BS.ByteString
|
||||
toBytes (HexString bs) = (fst . BS16.decode) bs
|
||||
|
||||
-- | Access to a 'T.Text' representation of the 'HexString'
|
||||
asText :: HexString -> T.Text
|
||||
asText (HexString bs) = TE.decodeUtf8 bs
|
||||
toText :: HexString -> T.Text
|
||||
toText (HexString bs) = TE.decodeUtf8 bs
|
||||
|
|
|
@ -1,15 +1,10 @@
|
|||
module Data.HexStringSpec where
|
||||
|
||||
import Data.HexString ( hexString
|
||||
, toHex
|
||||
, fromHex
|
||||
, asText )
|
||||
, fromBytes
|
||||
, toBytes )
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as BS8
|
||||
import qualified Data.Text as T
|
||||
|
||||
import qualified Data.Binary as B ( encode )
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
|
@ -24,3 +19,9 @@ spec = do
|
|||
putStrLn (show (hexString (BS8.pack ":"))) `shouldThrow` anyErrorCall
|
||||
putStrLn (show (hexString (BS8.pack "`"))) `shouldThrow` anyErrorCall
|
||||
putStrLn (show (hexString (BS8.pack "g"))) `shouldThrow` anyErrorCall
|
||||
|
||||
describe "when interpreting a hex string" $ do
|
||||
it "should convert the hex string properly when interpreting as bytes" $
|
||||
toBytes (hexString (BS8.pack "ffff")) `shouldBe` BS8.pack "\255\255"
|
||||
it "should convert bytes to the proper hex string" $
|
||||
fromBytes (BS8.pack "\255\255") `shouldBe` hexString (BS8.pack "ffff")
|
||||
|
|
Loading…
Reference in a new issue