diff --git a/bytestring-from.cabal b/bytestring-from.cabal --- a/bytestring-from.cabal +++ b/bytestring-from.cabal @@ -1,5 +1,5 @@ name: bytestring-from -version: 0.1.1 +version: 0.2 synopsis: A type-class to convert values from ByteString. license: OtherLicense license-file: LICENSE @@ -26,7 +26,9 @@ ghc-options: -Wall -O2 -fwarn-tabs ghc-prof-options: -prof -auto-all - exposed-modules: Data.ByteString.From + exposed-modules: + Data.ByteString.From + Data.ByteString.From.Hex build-depends: base == 4.* diff --git a/src/Data/ByteString/From.hs b/src/Data/ByteString/From.hs --- a/src/Data/ByteString/From.hs +++ b/src/Data/ByteString/From.hs @@ -12,8 +12,7 @@ import Control.Applicative import Control.Monad import Data.Attoparsec.ByteString -import Data.Attoparsec.ByteString.Char8 (signed, decimal, hexadecimal, double) -import Data.Bits (Bits) +import Data.Attoparsec.ByteString.Char8 (signed, decimal, double) import Data.ByteString (ByteString, elem) import Data.Int import Data.Maybe (isJust) @@ -66,38 +65,60 @@ instance FromByteString Double where parser = signed double <|> fail "Invalid Double" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Integer where - parser = hexLiteral <|> fail "Invalid Integer" + parser = signed decimal <|> fail "Invalid Integer" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Int where - parser = hexLiteral <|> fail "Invalid Int" + parser = signed decimal <|> fail "Invalid Int" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Int8 where - parser = hexLiteral <|> fail "Invalid Int8" + parser = signed decimal <|> fail "Invalid Int8" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Int16 where - parser = hexLiteral <|> fail "Invalid Int16" + parser = signed decimal <|> fail "Invalid Int16" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Int32 where - parser = hexLiteral <|> fail "Invalid Int32" + parser = signed decimal <|> fail "Invalid Int32" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Int64 where - parser = hexLiteral <|> fail "Invalid Int64" + parser = signed decimal <|> fail "Invalid Int64" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Word where - parser = hexLiteral <|> fail "Invalid Word" + parser = signed decimal <|> fail "Invalid Word" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Word8 where - parser = hexLiteral <|> fail "Invalid Word8" + parser = signed decimal <|> fail "Invalid Word8" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Word16 where - parser = hexLiteral <|> fail "Invalid Word16" + parser = signed decimal <|> fail "Invalid Word16" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Word32 where - parser = hexLiteral <|> fail "Invalid Word32" + parser = signed decimal <|> fail "Invalid Word32" +-- | (signed) decimal literals +-- (see "Data.ByteString.From.Hex" for hexadecimal parsing) instance FromByteString Word64 where - parser = hexLiteral <|> fail "Invalid Word64" + parser = signed decimal <|> fail "Invalid Word64" ----------------------------------------------------------------------------- -- Implementation Helpers @@ -122,9 +143,4 @@ text :: ByteString -> Parser Text text = either (fail . ("Invalid UTF-8: " ++) . show) return . decodeUtf8' - -hexLiteral :: (Integral a, Bits a) => Parser a -hexLiteral = signed (try hex <|> decimal) - where - hex = word8 0x30 *> satisfy (`elem` "xX") *> hexadecimal diff --git a/src/Data/ByteString/From/Hex.hs b/src/Data/ByteString/From/Hex.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/From/Hex.hs @@ -0,0 +1,38 @@ +-- This Source Code Form is subject to the terms of the Mozilla Public +-- License, v. 2.0. If a copy of the MPL was not distributed with this +-- file, You can obtain one at http://mozilla.org/MPL/2.0/. + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.ByteString.From.Hex where + +import Control.Applicative +import Data.Attoparsec.ByteString +import Data.Attoparsec.ByteString.Char8 (signed, hexadecimal) +import Data.ByteString.From +import Data.Bits (Bits) +import Data.ByteString (elem) +import Prelude hiding (elem) +import Text.Printf (PrintfArg) + +-- | Newtype wrapper to parse integral numbers in hexadecimal +-- format, optionally with a @0x@ or @0X@ prefix. +newtype Hex a = Hex { fromHex :: a } + deriving ( Eq + , Ord + , Num + , Read + , Show + , Bounded + , Integral + , Bits + , PrintfArg + , Enum + , Real ) + +instance (Integral a, Bits a) => FromByteString (Hex a) where + parser = Hex <$> signed (optional prefix *> hexadecimal) + where + prefix = word8 0x30 *> satisfy (`elem` "xX") + diff --git a/test/Properties.hs b/test/Properties.hs --- a/test/Properties.hs +++ b/test/Properties.hs @@ -2,8 +2,10 @@ module Properties (tests) where +import Control.Applicative import Data.ByteString.Char8 (pack) import Data.ByteString.From +import Data.ByteString.From.Hex import Data.Int import Data.List (intercalate) import Data.Maybe (fromMaybe) @@ -28,16 +30,16 @@ , testProperty "Word64" (\a -> Just (a :: Word64) == readBack a) ] , testGroup "Hexadecimals" - [ testProperty "Int" (\a -> Just (a :: Int) == readBackHex a) - , testProperty "Int8" (\a -> Just (a :: Int8) == readBackHex a) - , testProperty "Int16" (\a -> Just (a :: Int16) == readBackHex a) - , testProperty "Int32" (\a -> Just (a :: Int32) == readBackHex a) - , testProperty "Int64" (\a -> Just (a :: Int64) == readBackHex a) - , testProperty "Word" (\a -> Just (a :: Word) == readBackHex a) - , testProperty "Word8 " (\a -> Just (a :: Word8) == readBackHex a) - , testProperty "Word16" (\a -> Just (a :: Word16) == readBackHex a) - , testProperty "Word32" (\a -> Just (a :: Word32) == readBackHex a) - , testProperty "Word64" (\a -> Just (a :: Word64) == readBackHex a) + [ testProperty "Int" (\a -> Just (a :: Hex Int) == readBackHex a) + , testProperty "Int8" (\a -> Just (a :: Hex Int8) == readBackHex a) + , testProperty "Int16" (\a -> Just (a :: Hex Int16) == readBackHex a) + , testProperty "Int32" (\a -> Just (a :: Hex Int32) == readBackHex a) + , testProperty "Int64" (\a -> Just (a :: Hex Int64) == readBackHex a) + , testProperty "Word" (\a -> Just (a :: Hex Word) == readBackHex a) + , testProperty "Word8 " (\a -> Just (a :: Hex Word8) == readBackHex a) + , testProperty "Word16" (\a -> Just (a :: Hex Word16) == readBackHex a) + , testProperty "Word32" (\a -> Just (a :: Hex Word32) == readBackHex a) + , testProperty "Word64" (\a -> Just (a :: Hex Word64) == readBackHex a) ] , testGroup "Bool" [ testProperty "True" readBackTrue @@ -78,7 +80,7 @@ where csv = intercalate "," . map show -readHexCSV :: [Hex] -> Bool +readHexCSV :: [HexStr] -> Bool readHexCSV lst = Just (map (snd . hex) lst) == fromByteString (pack (csv lst)) where csv = intercalate "," . map (fst . hex) @@ -89,10 +91,16 @@ where csv = intercalate "," . map show -newtype Hex = Hex { hex :: (String, Int) } deriving (Show) +newtype HexStr = HexStr + { hex :: (String, Hex Int) + } deriving (Show) -instance Arbitrary Hex where +instance Arbitrary HexStr where arbitrary = do i <- arbitrary x <- elements ['x', 'X'] - return $ Hex (printf ('+':'0':x:"%x") i, i) + return $ HexStr (printf ('+':'0':x:"%x") i, i) + +instance Arbitrary a => Arbitrary (Hex a) where + arbitrary = Hex <$> arbitrary +