bencoding 0.2.2.0 → 0.3.0.0
raw patch · 5 files changed
+92/−92 lines, 5 files
Files
- NEWS.md +4/−0
- bench/Main.hs +1/−1
- bencoding.cabal +4/−9
- src/Data/BEncode.hs +78/−77
- tests/properties.hs +5/−5
+ NEWS.md view
@@ -0,0 +1,4 @@+* 0.1.0.0: Initial version.+* 0.2.0.0: Added default decoders/encoders using GHC Generics.+* 0.2.2.0: Arbitrary length integers. (by specification)+* 0.3.0.0: Rename BEncode to BValue and BEncodable to BEncode.
bench/Main.hs view
@@ -37,7 +37,7 @@ data List a = Cons a (List a) | Nil deriving Generic -instance BEncodable a => BEncodable (List a)+instance C.BEncode a => C.BEncode (List a) instance NFData a => NFData (List a) where rnf Nil = ()
bencoding.cabal view
@@ -1,5 +1,5 @@ name: bencoding-version: 0.2.2.0+version: 0.3.0.0 license: BSD3 license-file: LICENSE author: Sam Truzjan@@ -18,15 +18,10 @@ A library for encoding and decoding of BEncode data. .- [/Release notes/]- .- * /0.1.0.0:/ Initial version.- .- * /0.2.0.0:/ Added default decoders/encoders using GHC Generics.- .- * /0.2.2.0:/ Arbitrary length integers. (by specification)+ See NEWS.md for release notes. extra-source-files: README.md+ , NEWS.md source-repository head type: git@@ -37,7 +32,7 @@ type: git location: git://github.com/cobit/bencoding.git branch: master- tag: v0.2.2.0+ tag: v0.3.0.0 library default-language: Haskell2010
src/Data/BEncode.hs view
@@ -62,11 +62,11 @@ , BDict , BKey - , BEncode(..)+ , BValue (..) , ppBEncode -- * Conversion- , BEncodable (..)+ , BEncode (..) , Result -- * Serialization@@ -138,8 +138,8 @@ type BInteger = Integer type BString = ByteString-type BList = [BEncode]-type BDict = Map BKey BEncode+type BList = [BValue]+type BDict = Map BKey BValue type BKey = ByteString -- | 'BEncode' is straightforward ADT for b-encoded values. Please@@ -147,13 +147,14 @@ -- compare BEncoded values without serialization and vice versa. -- Lists is not required to be sorted through. ---data BEncode = BInteger !BInteger -- ^ bencode integers;- | BString !BString -- ^ bencode strings;- | BList BList -- ^ list of bencode values;- | BDict BDict -- ^ bencode key-value dictionary.- deriving (Show, Read, Eq, Ord)+data BValue+ = BInteger !BInteger -- ^ bencode integers;+ | BString !BString -- ^ bencode strings;+ | BList BList -- ^ list of bencode values;+ | BDict BDict -- ^ bencode key-value dictionary.+ deriving (Show, Read, Eq, Ord) -instance NFData BEncode where+instance NFData BValue where rnf (BInteger i) = rnf i rnf (BString s) = rnf s rnf (BList l) = rnf l@@ -186,27 +187,27 @@ -- -- Note that '_' prefixes are omitted. ---class BEncodable a where+class BEncode a where -- | See an example of implementation here 'Assoc'- toBEncode :: a -> BEncode+ toBEncode :: a -> BValue #if __GLASGOW_HASKELL__ >= 702 default toBEncode :: Generic a- => GBEncodable (Rep a) BEncode- => a -> BEncode+ => GBEncodable (Rep a) BValue+ => a -> BValue toBEncode = gto . from #endif -- | See an example of implementation here 'reqKey'.- fromBEncode :: BEncode -> Result a+ fromBEncode :: BValue -> Result a #if __GLASGOW_HASKELL__ >= 702 default fromBEncode :: Generic a- => GBEncodable (Rep a) BEncode- => BEncode -> Result a+ => GBEncodable (Rep a) BValue+ => BValue -> Result a fromBEncode x = to <$> gfrom x #endif@@ -236,8 +237,8 @@ gto :: f a -> e gfrom :: e -> Result (f a) -instance BEncodable f- => GBEncodable (K1 R f) BEncode where+instance BEncode f+ => GBEncodable (K1 R f) BValue where {-# INLINE gto #-} gto = toBEncode . unK1 @@ -291,7 +292,7 @@ selRename = dropWhile ('_'==) gfromM1S :: forall c. Selector c- => GBEncodable f BEncode+ => GBEncodable f BValue => BDict -> Result (M1 i c f p) gfromM1S dict | Just va <- M.lookup (BC.pack (selRename name)) dict = M1 <$> gfrom va@@ -299,7 +300,7 @@ where name = selName (error "gfromM1S: impossible" :: M1 i c f p) -instance (Selector s, GBEncodable f BEncode)+instance (Selector s, GBEncodable f BValue) => GBEncodable (M1 S s f) BDict where {-# INLINE gto #-} gto s @ (M1 x) = BC.pack (selRename (selName s)) `M.singleton` gto x@@ -308,7 +309,7 @@ gfrom = gfromM1S -- TODO DList-instance GBEncodable f BEncode+instance GBEncodable f BValue => GBEncodable (M1 S s f) BList where {-# INLINE gto #-} gto (M1 x) = [gto x]@@ -318,7 +319,7 @@ {-# INLINE gfrom #-} instance (Constructor c, GBEncodable f BDict, GBEncodable f BList)- => GBEncodable (M1 C c f) BEncode where+ => GBEncodable (M1 C c f) BValue where {-# INLINE gto #-} gto con @ (M1 x) | conIsRecord con = BDict (gto x)@@ -343,14 +344,14 @@ -- Native instances --------------------------------------------------------------------} -instance BEncodable BEncode where+instance BEncode BValue where toBEncode = id {-# INLINE toBEncode #-} fromBEncode = pure {-# INLINE fromBEncode #-} -instance BEncodable BInteger where+instance BEncode BInteger where toBEncode = BInteger {-# INLINE toBEncode #-} @@ -358,7 +359,7 @@ fromBEncode _ = decodingError "BInteger" {-# INLINE fromBEncode #-} -instance BEncodable BString where+instance BEncode BString where toBEncode = BString {-# INLINE toBEncode #-} @@ -393,81 +394,81 @@ requires -XUndecidableInstances, so we avoid it -} -toBEncodeIntegral :: Integral a => a -> BEncode+toBEncodeIntegral :: Integral a => a -> BValue toBEncodeIntegral = BInteger . fromIntegral {-# INLINE toBEncodeIntegral #-} -fromBEncodeIntegral :: forall a. Typeable a => Integral a => BEncode -> Result a+fromBEncodeIntegral :: forall a. Typeable a => Integral a => BValue -> Result a fromBEncodeIntegral (BInteger i) = pure (fromIntegral i) fromBEncodeIntegral _ = decodingError $ show $ typeOf (undefined :: a) {-# INLINE fromBEncodeIntegral #-} -instance BEncodable Word8 where+instance BEncode Word8 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Word16 where+instance BEncode Word16 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Word32 where+instance BEncode Word32 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Word64 where+instance BEncode Word64 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Word where+instance BEncode Word where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Int8 where+instance BEncode Int8 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Int16 where+instance BEncode Int16 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Int32 where+instance BEncode Int32 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Int64 where+instance BEncode Int64 where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} -instance BEncodable Int where+instance BEncode Int where toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} @@ -478,7 +479,7 @@ -- Derived instances --------------------------------------------------------------------} -instance BEncodable Bool where+instance BEncode Bool where toBEncode = toBEncode . fromEnum {-# INLINE toBEncode #-} @@ -490,15 +491,15 @@ _ -> decodingError "Bool" {-# INLINE fromBEncode #-} -instance BEncodable Text where+instance BEncode Text where toBEncode = toBEncode . T.encodeUtf8 {-# INLINE toBEncode #-} fromBEncode b = T.decodeUtf8 <$> fromBEncode b {-# INLINE fromBEncode #-} -instance BEncodable a => BEncodable [a] where- {-# SPECIALIZE instance BEncodable BList #-}+instance BEncode a => BEncode [a] where+ {-# SPECIALIZE instance BEncode BList #-} toBEncode = BList . map toBEncode {-# INLINE toBEncode #-} @@ -506,8 +507,8 @@ fromBEncode _ = decodingError "list" {-# INLINE fromBEncode #-} -instance BEncodable a => BEncodable (Map ByteString a) where- {-# SPECIALIZE instance BEncodable BDict #-}+instance BEncode a => BEncode (Map BKey a) where+ {-# SPECIALIZE instance BEncode BDict #-} toBEncode = BDict . M.map toBEncode {-# INLINE toBEncode #-} @@ -515,8 +516,8 @@ fromBEncode _ = decodingError "dictionary" {-# INLINE fromBEncode #-} -instance (Eq a, BEncodable a) => BEncodable (Set a) where- {-# SPECIALIZE instance BEncodable (Set BEncode) #-}+instance (Eq a, BEncode a) => BEncode (Set a) where+ {-# SPECIALIZE instance BEncode (Set BValue) #-} toBEncode = BList . map toBEncode . S.toAscList {-# INLINE toBEncode #-} @@ -524,7 +525,7 @@ fromBEncode _ = decodingError "Data.Set" {-# INLINE fromBEncode #-} -instance BEncodable Version where+instance BEncode Version where toBEncode = toBEncode . BC.pack . showVersion {-# INLINE toBEncode #-} @@ -538,7 +539,7 @@ -- Tuple instances --------------------------------------------------------------------} -instance BEncodable () where+instance BEncode () where toBEncode () = BList [] {-# INLINE toBEncode #-} @@ -546,10 +547,10 @@ fromBEncode _ = decodingError "Unable to decode unit value" {-# INLINE fromBEncode #-} -instance (BEncodable a, BEncodable b) => BEncodable (a, b) where- {-# SPECIALIZE instance (BEncodable b) => BEncodable (BEncode, b) #-}- {-# SPECIALIZE instance (BEncodable a) => BEncodable (a, BEncode) #-}- {-# SPECIALIZE instance BEncodable (BEncode, BEncode) #-}+instance (BEncode a, BEncode b) => BEncode (a, b) where+ {-# SPECIALIZE instance (BEncode b) => BEncode (BValue, b) #-}+ {-# SPECIALIZE instance (BEncode a) => BEncode (a, BValue) #-}+ {-# SPECIALIZE instance BEncode (BValue, BValue) #-} toBEncode (a, b) = BList [toBEncode a, toBEncode b] {-# INLINE toBEncode #-} @@ -557,7 +558,7 @@ fromBEncode _ = decodingError "Unable to decode a pair." {-# INLINE fromBEncode #-} -instance (BEncodable a, BEncodable b, BEncodable c) => BEncodable (a, b, c) where+instance (BEncode a, BEncode b, BEncode c) => BEncode (a, b, c) where toBEncode (a, b, c) = BList [toBEncode a, toBEncode b, toBEncode c] {-# INLINE toBEncode #-} @@ -566,8 +567,8 @@ fromBEncode _ = decodingError "Unable to decode a triple" {-# INLINE fromBEncode #-} -instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d)- => BEncodable (a, b, c, d) where+instance (BEncode a, BEncode b, BEncode c, BEncode d)+ => BEncode (a, b, c, d) where toBEncode (a, b, c, d) = BList [ toBEncode a, toBEncode b , toBEncode c, toBEncode d ]@@ -579,8 +580,8 @@ fromBEncode _ = decodingError "Unable to decode a tuple4" {-# INLINE fromBEncode #-} -instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d, BEncodable e)- => BEncodable (a, b, c, d, e) where+instance (BEncode a, BEncode b, BEncode c, BEncode d, BEncode e)+ => BEncode (a, b, c, d, e) where toBEncode (a, b, c, d, e) = BList [ toBEncode a, toBEncode b , toBEncode c, toBEncode d , toBEncode e@@ -622,28 +623,28 @@ -- > ] -- > ... ---newtype Assoc = Assoc { unAssoc :: Maybe (ByteString, BEncode) }+newtype Assoc = Assoc { unAssoc :: Maybe (ByteString, BValue) } -- | Make required key value pair.-(-->) :: BEncodable a => ByteString -> a -> Assoc+(-->) :: BEncode a => BKey -> a -> Assoc key --> val = Assoc $ Just $ (key, toBEncode val) {-# INLINE (-->) #-} -- | Like (-->) but if the value is not present then the key do not -- appear in resulting bencoded dictionary. ---(-->?) :: BEncodable a => ByteString -> Maybe a -> Assoc+(-->?) :: BEncode a => BKey -> Maybe a -> Assoc key -->? mval = Assoc $ ((,) key . toBEncode) <$> mval {-# INLINE (-->?) #-} -- | Build BEncode dictionary using key -> value description.-fromAssocs :: [Assoc] -> BEncode+fromAssocs :: [Assoc] -> BValue fromAssocs = BDict . M.fromList . mapMaybe unAssoc {-# INLINE fromAssocs #-} -- | A faster version of 'fromAssocs'. Should be used only when keys -- in builder list are sorted by ascending.-fromAscAssocs :: [Assoc] -> BEncode+fromAscAssocs :: [Assoc] -> BValue fromAscAssocs = BDict . M.fromAscList . mapMaybe unAssoc {-# INLINE fromAscAssocs #-} @@ -667,7 +668,7 @@ -- -- The /reqKey/ is used to extract required key — if lookup is failed -- then whole destructuring fail.-reqKey :: BEncodable a => BDict -> BKey -> Result a+reqKey :: BEncode a => BDict -> BKey -> Result a reqKey d key | Just b <- M.lookup key d = fromBEncode b | otherwise = Left msg@@ -676,19 +677,19 @@ -- | Used to extract optional key — if lookup is failed returns -- 'Nothing'.-optKey :: BEncodable a => BDict -> BKey -> Result (Maybe a)+optKey :: BEncode a => BDict -> BKey -> Result (Maybe a) optKey d key | Just b <- M.lookup key d , Right r <- fromBEncode b = return (Just r) | otherwise = return Nothing -- | Infix version of the 'reqKey'.-(>--) :: BEncodable a => BDict -> BKey -> Result a+(>--) :: BEncode a => BDict -> BKey -> Result a (>--) = reqKey {-# INLINE (>--) #-} -- | Infix version of the 'optKey'.-(>--?) :: BEncodable a => BDict -> BKey -> Result (Maybe a)+(>--?) :: BEncode a => BDict -> BKey -> Result (Maybe a) (>--?) = optKey {-# INLINE (>--?) #-} @@ -697,25 +698,25 @@ --------------------------------------------------------------------} -- | Test if bencoded value is an integer.-isInteger :: BEncode -> Bool+isInteger :: BValue -> Bool isInteger (BInteger _) = True isInteger _ = False {-# INLINE isInteger #-} -- | Test if bencoded value is a string, both raw and utf8 encoded.-isString :: BEncode -> Bool+isString :: BValue -> Bool isString (BString _) = True isString _ = False {-# INLINE isString #-} -- | Test if bencoded value is a list.-isList :: BEncode -> Bool+isList :: BValue -> Bool isList (BList _) = True isList _ = False {-# INLINE isList #-} -- | Test if bencoded value is a dictionary.-isDict :: BEncode -> Bool+isDict :: BValue -> Bool isDict (BList _) = True isDict _ = False {-# INLINE isDict #-}@@ -726,20 +727,20 @@ -- | Convert bencoded value to raw bytestring according to the -- specification.-encode :: BEncode -> Lazy.ByteString+encode :: BValue -> Lazy.ByteString encode = B.toLazyByteString . builder -- | Try to convert raw bytestring to bencoded value according to -- specification.-decode :: ByteString -> Result BEncode+decode :: ByteString -> Result BValue decode = P.parseOnly parser -- | The same as 'decode' but returns any bencodable value.-decoded :: BEncodable a => ByteString -> Result a+decoded :: BEncode a => ByteString -> Result a decoded = decode >=> fromBEncode -- | The same as 'encode' but takes any bencodable value.-encoded :: BEncodable a => a -> Lazy.ByteString+encoded :: BEncode a => a -> Lazy.ByteString encoded = encode . toBEncode {--------------------------------------------------------------------@@ -747,7 +748,7 @@ --------------------------------------------------------------------} -- | BEncode format encoder according to specification.-builder :: BEncode -> B.Builder+builder :: BValue -> B.Builder builder = go where go (BInteger i) = B.word8 (c2w 'i') <>@@ -770,7 +771,7 @@ -- TODO try to replace peekChar with something else -- | BEncode format parser according to specification.-parser :: Parser BEncode+parser :: Parser BValue parser = valueP where valueP = do@@ -822,7 +823,7 @@ -- | Convert to easily readable JSON-like document. Typically used for -- debugging purposes.-ppBEncode :: BEncode -> Doc+ppBEncode :: BValue -> Doc ppBEncode (BInteger i) = int $ fromIntegral i ppBEncode (BString s) = ppBS s ppBEncode (BList l) = brackets $ hsep $ punctuate comma $ map ppBEncode l
tests/properties.hs view
@@ -16,7 +16,7 @@ instance Arbitrary B.ByteString where arbitrary = fmap B.pack arbitrary -instance Arbitrary BEncode where+instance Arbitrary BValue where arbitrary = frequency [ (50, BInteger <$> arbitrary) , (40, BString <$> arbitrary)@@ -24,7 +24,7 @@ ] -prop_EncDec :: BEncode -> Bool+prop_EncDec :: BValue -> Bool prop_EncDec x = case decode (L.toStrict (encode x)) of Left _ -> False Right x' -> x == x'@@ -32,7 +32,7 @@ data List a = Cons a (List a) | Nil deriving (Show, Eq, Generic) -instance BEncodable a => BEncodable (List a)+instance BEncode a => BEncode (List a) instance Arbitrary a => Arbitrary (List a) where arbitrary = frequency@@ -46,14 +46,14 @@ , fiMD5Sum :: B.ByteString } deriving (Show, Eq, Generic) -instance BEncodable FileInfo+instance BEncode FileInfo instance Arbitrary FileInfo where arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary data T a = T -prop_bencodable :: Eq a => BEncodable a => T a -> a -> Bool+prop_bencodable :: Eq a => BEncode a => T a -> a -> Bool prop_bencodable _ x = decoded (L.toStrict (encoded x)) == Right x -- All tests are (encode >>> decode = id)