bencoding 0.2.0.0 → 0.2.1.0
raw patch · 5 files changed
+225/−181 lines, 5 filesdep ~bytestring
Dependency ranges changed: bytestring
Files
- .travis.yml +0/−10
- LICENSE +27/−16
- bencoding.cabal +20/−20
- pp/pp.hs +0/−14
- src/Data/BEncode.hs +178/−121
− .travis.yml
@@ -1,10 +0,0 @@-language: haskell--notifications:- email: false--install:- cabal install --enable-tests --enable-benchmark --force-reinstalls --only-dependencies--script:- cabal configure --enable-tests --enable-benchmark && cabal build && cabal test
LICENSE view
@@ -1,19 +1,30 @@-Copyright (c) 2012 Sam T.+Copyright (c) 2013, Sam Truzjan -Permission is hereby granted, free of charge, to any person obtaining a copy of-this software and associated documentation files (the "Software"), to deal in-the Software without restriction, including without limitation the rights to-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies-of the Software, and to permit persons to whom the Software is furnished to do-so, subject to the following conditions:+All rights reserved. -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Sam Truzjan nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
bencoding.cabal view
@@ -1,17 +1,19 @@ name: bencoding-version: 0.2.0.0-synopsis: A library for encoding and decoding of BEncode data.-homepage: https://github.com/cobit/bencoding-bug-reports: https://github.com/cobit/bencoding/issues-license: MIT+version: 0.2.1.0+license: BSD3 license-file: LICENSE-author: Sam T.-maintainer: Sam T. <pxqr.sta@gmail.com>-copyright: (c) 2013, Sam T.+author: Sam Truzjan+maintainer: Sam Truzjan <pxqr.sta@gmail.com>+copyright: (c) 2013, Sam Truzjan category: Data build-type: Simple+stability: Experimental cabal-version: >= 1.10-tested-with: GHC==7.4.1, GHC==7.6.3+tested-with: GHC==7.4.1+ , GHC==7.6.3+homepage: https://github.com/cobit/bencoding+bug-reports: https://github.com/cobit/bencoding/issues+synopsis: A library for encoding and decoding of BEncode data. description: A library for encoding and decoding of BEncode data.@@ -21,15 +23,22 @@ * /0.1.0.0:/ Initial version. . * /0.2.0.0:/ Added default decoders/encoders using GHC Generics.-+ .+ * /0.2.1.0:/ Arbitrary length integers. (by specification) extra-source-files: README.md- .travis.yml source-repository head type: git location: git://github.com/cobit/bencoding.git+ branch: master +source-repository this+ type: git+ location: git://github.com/cobit/bencoding.git+ branch: master+ tag: v0.2.1.0+ library default-language: Haskell2010 default-extensions: PatternGuards@@ -44,15 +53,6 @@ , text >= 0.11 , pretty ghc-options: -Wall -fno-warn-unused-do-bind--executable pp- default-language: Haskell2010- hs-source-dirs: pp- main-is: pp.hs- build-depends: base == 4.*- , bytestring- , bencoding- ghc-options: -Wall test-suite properties
− pp/pp.hs
@@ -1,14 +0,0 @@-module Main (main) where--import Data.BEncode-import qualified Data.ByteString as B-import System.IO-import System.Environment--main :: IO ()-main = do- path : _ <- getArgs- content <- B.readFile path- case decode content of- Left e -> hPutStrLn stderr e- Right be -> print $ ppBEncode be
src/Data/BEncode.hs view
@@ -1,12 +1,9 @@--- TODO: make int's instances platform independent so we can make--- library portable.- -- |--- Copyright : (c) Sam T. 2013--- License : MIT+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3 -- Maintainer : pxqr.sta@gmail.com -- Stability : stable--- Portability : non-portable+-- Portability : portable -- -- This module provides convinient and fast way to serialize, -- deserealize and construct/destructure Bencoded values with@@ -53,15 +50,19 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} #endif module Data.BEncode ( -- * Datatype- BEncode(..)- , Dict+ BInteger+ , BString+ , BList+ , BDict+ , BKey++ , BEncode(..) , ppBEncode -- * Conversion@@ -106,7 +107,7 @@ import Control.Monad import Data.Int import Data.Maybe (mapMaybe)-import Data.Monoid -- (mempty, (<>))+import Data.Monoid import Data.Foldable (foldMap) import Data.Traversable (traverse) import Data.Word (Word8, Word16, Word32, Word64, Word)@@ -125,6 +126,7 @@ import Data.ByteString.Internal as B (c2w, w2c) import Data.Text (Text) import qualified Data.Text.Encoding as T+import Data.Typeable import Data.Version import Text.PrettyPrint hiding ((<>)) import qualified Text.ParserCombinators.ReadP as ReadP@@ -133,18 +135,22 @@ import GHC.Generics #endif --- | BEncode key-value dictionary.-type Dict = Map ByteString BEncode +type BInteger = Integer+type BString = ByteString+type BList = [BEncode]+type BDict = Map BKey BEncode+type BKey = ByteString+ -- | 'BEncode' is straightforward ADT for b-encoded values. Please -- note that since dictionaries are sorted, in most cases we can -- compare BEncoded values without serialization and vice versa. -- Lists is not required to be sorted through. ---data BEncode = BInteger {-# UNPACK #-} !Int64- | BString !ByteString- | BList [BEncode]- | BDict Dict+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) instance NFData BEncode where@@ -248,8 +254,8 @@ | x == mempty = pure U1 | otherwise = decodingError "U1" -instance (GBEncodable a [BEncode], GBEncodable b [BEncode])- => GBEncodable (a :*: b) [BEncode] where+instance (GBEncodable a BList, GBEncodable b BList)+ => GBEncodable (a :*: b) BList where {-# INLINE gto #-} gto (a :*: b) = gto a ++ gto b @@ -257,8 +263,8 @@ gfrom (x : xs) = (:*:) <$> gfrom [x] <*> gfrom xs gfrom [] = decodingError "generic: not enough fields" -instance (GBEncodable a Dict, GBEncodable b Dict)- => GBEncodable (a :*: b) Dict where+instance (GBEncodable a BDict, GBEncodable b BDict)+ => GBEncodable (a :*: b) BDict where {-# INLINE gto #-} gto (a :*: b) = gto a <> gto b @@ -286,7 +292,7 @@ gfromM1S :: forall c. Selector c => GBEncodable f BEncode- => Dict -> Result (M1 i c f p)+ => BDict -> Result (M1 i c f p) gfromM1S dict | Just va <- M.lookup (BC.pack (selRename name)) dict = M1 <$> gfrom va | otherwise = decodingError $ "generic: Selector not found " ++ show name@@ -294,7 +300,7 @@ name = selName (error "gfromM1S: impossible" :: M1 i c f p) instance (Selector s, GBEncodable f BEncode)- => GBEncodable (M1 S s f) Dict where+ => GBEncodable (M1 S s f) BDict where {-# INLINE gto #-} gto s @ (M1 x) = BC.pack (selRename (selName s)) `M.singleton` gto x @@ -303,7 +309,7 @@ -- TODO DList instance GBEncodable f BEncode- => GBEncodable (M1 S s f) [BEncode] where+ => GBEncodable (M1 S s f) BList where {-# INLINE gto #-} gto (M1 x) = [gto x] @@ -311,7 +317,7 @@ gfrom _ = decodingError "generic: empty selector" {-# INLINE gfrom #-} -instance (Constructor c, GBEncodable f Dict, GBEncodable f [BEncode])+instance (Constructor c, GBEncodable f BDict, GBEncodable f BList) => GBEncodable (M1 C c f) BEncode where {-# INLINE gto #-} gto con @ (M1 x)@@ -334,56 +340,153 @@ #endif {--------------------------------------------------------------------- Basic instances+-- Native instances --------------------------------------------------------------------} instance BEncodable BEncode where- {-# SPECIALIZE instance BEncodable BEncode #-} toBEncode = id {-# INLINE toBEncode #-} - fromBEncode = Right+ fromBEncode = pure {-# INLINE fromBEncode #-} -instance BEncodable Int where- {-# SPECIALIZE instance BEncodable Int #-}- toBEncode = BInteger . fromIntegral+instance BEncodable BInteger where+ toBEncode = BInteger {-# INLINE toBEncode #-} - fromBEncode (BInteger i) = Right (fromIntegral i)- fromBEncode _ = decodingError "integer"+ fromBEncode (BInteger i) = pure i+ fromBEncode _ = decodingError "BInteger" {-# INLINE fromBEncode #-} -instance BEncodable Bool where- toBEncode = toBEncode . fromEnum+instance BEncodable BString where+ toBEncode = BString {-# INLINE toBEncode #-} - fromBEncode b = do- i <- fromBEncode b- case i :: Int of- 0 -> return False- 1 -> return True- _ -> decodingError "bool"+ fromBEncode (BString s) = pure s+ fromBEncode _ = decodingError "BString" {-# INLINE fromBEncode #-} +instance BEncodable BList where+ toBEncode = BList+ {-# INLINE toBEncode #-} -instance BEncodable Integer where- toBEncode = BInteger . fromIntegral+ fromBEncode (BList xs) = pure xs+ fromBEncode _ = decodingError "BList"+ {-# INLINE fromBEncode #-}++instance BEncodable BDict where+ toBEncode = BDict {-# INLINE toBEncode #-} - fromBEncode b = fromIntegral <$> (fromBEncode b :: Result Int)+ fromBEncode (BDict d) = pure d+ fromBEncode _ = decodingError "BDict" {-# INLINE fromBEncode #-} +{--------------------------------------------------------------------+-- Integral instances+--------------------------------------------------------------------} -instance BEncodable ByteString where- toBEncode = BString+{- NOTE: instance Integral a => BEncodable a+ requires -XUndecidableInstances, so we avoid it+-}++toBEncodeIntegral :: Integral a => a -> BEncode+toBEncodeIntegral = BInteger . fromIntegral+{-# INLINE toBEncodeIntegral #-}++fromBEncodeIntegral :: forall a. Typeable a => Integral a => BEncode -> Result a+fromBEncodeIntegral (BInteger i) = pure (fromIntegral i)+fromBEncodeIntegral _+ = decodingError $ show $ typeOf (undefined :: a)+{-# INLINE fromBEncodeIntegral #-}+++instance BEncodable Word8 where+ toBEncode = toBEncodeIntegral {-# INLINE toBEncode #-} - fromBEncode (BString s) = Right s- fromBEncode _ = decodingError "string"+ fromBEncode = fromBEncodeIntegral {-# INLINE fromBEncode #-} +instance BEncodable Word16 where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-} + fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Word32 where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Word64 where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Word where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Int8 where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Int16 where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Int32 where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Int64 where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++instance BEncodable Int where+ toBEncode = toBEncodeIntegral+ {-# INLINE toBEncode #-}++ fromBEncode = fromBEncodeIntegral+ {-# INLINE fromBEncode #-}++{--------------------------------------------------------------------+-- Derived instances+--------------------------------------------------------------------}++instance BEncodable Bool where+ toBEncode = toBEncode . fromEnum+ {-# INLINE toBEncode #-}++ fromBEncode b = do+ i <- fromBEncode b+ case i :: Int of+ 0 -> return False+ 1 -> return True+ _ -> decodingError "Bool"+ {-# INLINE fromBEncode #-}+ instance BEncodable Text where toBEncode = toBEncode . T.encodeUtf8 {-# INLINE toBEncode #-}@@ -393,7 +496,6 @@ instance BEncodable a => BEncodable [a] where {-# SPECIALIZE instance BEncodable [BEncode] #-}- toBEncode = BList . map toBEncode {-# INLINE toBEncode #-} @@ -401,10 +503,8 @@ fromBEncode _ = decodingError "list" {-# INLINE fromBEncode #-} - instance BEncodable a => BEncodable (Map ByteString a) where {-# SPECIALIZE instance BEncodable (Map ByteString BEncode) #-}- toBEncode = BDict . M.map toBEncode {-# INLINE toBEncode #-} @@ -413,7 +513,7 @@ {-# INLINE fromBEncode #-} instance (Eq a, BEncodable a) => BEncodable (Set a) where- {-# SPECIALIZE instance (Eq a, BEncodable a) => BEncodable (Set a) #-}+ {-# SPECIALIZE instance BEncodable (Set BEncode) #-} toBEncode = BList . map toBEncode . S.toAscList {-# INLINE toBEncode #-} @@ -421,8 +521,21 @@ fromBEncode _ = decodingError "Data.Set" {-# INLINE fromBEncode #-} +instance BEncodable Version where+ toBEncode = toBEncode . BC.pack . showVersion+ {-# INLINE toBEncode #-}++ fromBEncode (BString bs)+ | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs)+ = return v+ fromBEncode _ = decodingError "Data.Version"+ {-# INLINE fromBEncode #-}++{--------------------------------------------------------------------+-- Tuple instances+--------------------------------------------------------------------}+ instance BEncodable () where- {-# SPECIALIZE instance BEncodable () #-} toBEncode () = BList [] {-# INLINE toBEncode #-} @@ -431,7 +544,9 @@ {-# INLINE fromBEncode #-} instance (BEncodable a, BEncodable b) => BEncodable (a, b) where- {-# SPECIALIZE instance (BEncodable a, BEncodable b) => BEncodable (a, b) #-}+ {-# SPECIALIZE instance (BEncodable b) => BEncodable (BEncode, b) #-}+ {-# SPECIALIZE instance (BEncodable a) => BEncodable (a, BEncode) #-}+ {-# SPECIALIZE instance BEncodable (BEncode, BEncode) #-} toBEncode (a, b) = BList [toBEncode a, toBEncode b] {-# INLINE toBEncode #-} @@ -440,10 +555,8 @@ {-# INLINE fromBEncode #-} instance (BEncodable a, BEncodable b, BEncodable c) => BEncodable (a, b, c) where- {-# SPECIALIZE instance (BEncodable a, BEncodable b, BEncodable c)- => BEncodable (a, b, c) #-}- {-# INLINE toBEncode #-} toBEncode (a, b, c) = BList [toBEncode a, toBEncode b, toBEncode c]+ {-# INLINE toBEncode #-} fromBEncode (BList [a, b, c]) = (,,) <$> fromBEncode a <*> fromBEncode b <*> fromBEncode c@@ -452,12 +565,10 @@ instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d) => BEncodable (a, b, c, d) where- {-# SPECIALIZE instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d)- => BEncodable (a, b, c, d) #-}- {-# INLINE toBEncode #-} toBEncode (a, b, c, d) = BList [ toBEncode a, toBEncode b , toBEncode c, toBEncode d ]+ {-# INLINE toBEncode #-} fromBEncode (BList [a, b, c, d]) = (,,,) <$> fromBEncode a <*> fromBEncode b@@ -466,16 +577,12 @@ {-# INLINE fromBEncode #-} instance (BEncodable a, BEncodable b, BEncodable c, BEncodable d, BEncodable e)- => BEncodable (a, b, c, d, e) where- {-# SPECIALIZE instance ( BEncodable a, BEncodable b- , BEncodable c, BEncodable d- , BEncodable e)- => BEncodable (a, b, c, d, e) #-}- {-# INLINE toBEncode #-}+ => BEncodable (a, b, c, d, e) where toBEncode (a, b, c, d, e) = BList [ toBEncode a, toBEncode b , toBEncode c, toBEncode d , toBEncode e ]+ {-# INLINE toBEncode #-} fromBEncode (BList [a, b, c, d, e]) = (,,,,) <$> fromBEncode a <*> fromBEncode b@@ -483,17 +590,6 @@ fromBEncode _ = decodingError "Unable to decode a tuple5" {-# INLINE fromBEncode #-} -instance BEncodable Version where- {-# SPECIALIZE instance BEncodable Version #-}- {-# INLINE toBEncode #-}- toBEncode = toBEncode . BC.pack . showVersion-- fromBEncode (BString bs)- | [(v, _)] <- ReadP.readP_to_S parseVersion (BC.unpack bs)- = return v- fromBEncode _ = decodingError "Data.Version"- {-# INLINE fromBEncode #-}- {-------------------------------------------------------------------- Building dictionaries --------------------------------------------------------------------}@@ -568,7 +664,7 @@ -- -- The /reqKey/ is used to extract required key — if lookup is failed -- then whole destructuring fail.-reqKey :: BEncodable a => Dict -> ByteString -> Result a+reqKey :: BEncodable a => BDict -> BKey -> Result a reqKey d key | Just b <- M.lookup key d = fromBEncode b | otherwise = Left msg@@ -577,19 +673,19 @@ -- | Used to extract optional key — if lookup is failed returns -- 'Nothing'.-optKey :: BEncodable a => Dict -> ByteString -> Result (Maybe a)+optKey :: BEncodable 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 => Dict -> ByteString -> Result a+(>--) :: BEncodable a => BDict -> BKey -> Result a (>--) = reqKey {-# INLINE (>--) #-} -- | Infix version of the 'optKey'.-(>--?) :: BEncodable a => Dict -> ByteString -> Result (Maybe a)+(>--?) :: BEncodable a => BDict -> BKey -> Result (Maybe a) (>--?) = optKey {-# INLINE (>--?) #-} @@ -652,7 +748,7 @@ builder = go where go (BInteger i) = B.word8 (c2w 'i') <>- B.int64Dec i <>+ B.integerDec i <> B.word8 (c2w 'e') go (BString s) = buildString s go (BList l) = B.word8 (c2w 'l') <>@@ -704,7 +800,7 @@ P.take n {-# INLINE stringP #-} - integerP :: Parser Int64+ integerP :: Parser Integer integerP = do c <- P.peekChar case c of@@ -731,42 +827,3 @@ = braces $ vcat $ punctuate comma $ map ppKV $ M.toAscList d where ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v--{--------------------------------------------------------------------- Other instances---------------------------------------------------------------------}--instance BEncodable Word8 where- {-# SPECIALIZE instance BEncodable Word8 #-}- toBEncode = toBEncode . (fromIntegral :: Word8 -> Word64)- {-# INLINE toBEncode #-}- fromBEncode b = (fromIntegral :: Word64 -> Word8) <$> fromBEncode b- {-# INLINE fromBEncode #-}--instance BEncodable Word16 where- {-# SPECIALIZE instance BEncodable Word16 #-}- toBEncode = toBEncode . (fromIntegral :: Word16 -> Word64)- {-# INLINE toBEncode #-}- fromBEncode b = (fromIntegral :: Word64 -> Word16) <$> fromBEncode b- {-# INLINE fromBEncode #-}--instance BEncodable Word32 where- {-# SPECIALIZE instance BEncodable Word32 #-}- toBEncode = toBEncode . (fromIntegral :: Word32 -> Word64)- {-# INLINE toBEncode #-}- fromBEncode b = (fromIntegral :: Word64 -> Word32) <$> fromBEncode b- {-# INLINE fromBEncode #-}--instance BEncodable Word64 where- {-# SPECIALIZE instance BEncodable Word64 #-}- toBEncode = toBEncode . (fromIntegral :: Word64 -> Int)- {-# INLINE toBEncode #-}- fromBEncode b = (fromIntegral :: Int -> Word64) <$> fromBEncode b- {-# INLINE fromBEncode #-}--instance BEncodable Word where -- TODO: make platform independent- {-# SPECIALIZE instance BEncodable Word #-}- toBEncode = toBEncode . (fromIntegral :: Word -> Int)- {-# INLINE toBEncode #-}- fromBEncode b = (fromIntegral :: Int -> Word) <$> fromBEncode b- {-# INLINE fromBEncode #-}