packages feed

AttoBencode (empty) → 0.2

raw patch · 8 files changed

+367/−0 lines, 8 filesdep +AttoBencodedep +QuickCheckdep +attoparsecsetup-changed

Dependencies added: AttoBencode, QuickCheck, attoparsec, base, blaze-builder, blaze-textual, bytestring, containers, test-framework, test-framework-quickcheck2

Files

+ AttoBencode.cabal view
@@ -0,0 +1,52 @@+Name:                AttoBencode+Version:             0.2+Synopsis:            Fast Bencode encoding and parsing library+Homepage:            http://bitbucket.org/FlorianHartwig/attobencode+License:             BSD3+License-file:        LICENSE+Author:              Florian Hartwig <florian.j.hartwig@gmail.com>+Maintainer:          Florian Hartwig <florian.j.hartwig@gmail.com>+Category:            Data+Build-type:          Simple+Cabal-version:       >=1.8+Description:+    A library for encoding and decoding the Bencode data serialisation format+    used by BitTorrent. The focus of this library are good performance (good+    enough to be used in a BitTorrent client) and ease of+    use.++Library+  Exposed-modules:+    Data.AttoBencode,+    Data.AttoBencode.Parser+  +  Other-modules:+    Data.AttoBencode.Encode,+    Data.AttoBencode.Types++  Build-depends:+    attoparsec,+    base == 4.*,+    blaze-builder,+    blaze-textual,+    bytestring,+    containers+  +  Ghc-options: -O2 -Wall +  Hs-source-dirs: src++Test-suite tests+  Type:           exitcode-stdio-1.0+  Hs-source-dirs: tests+  Main-is:        qc.hs+  Build-depends:  AttoBencode,+                  base == 4.*, +                  bytestring,+                  containers,+                  test-framework,+                  test-framework-quickcheck2,+                  QuickCheck >= 2.4 && < 2.5++source-repository head+  Type: mercurial+  Location: https://bitbucket.org/FlorianHartwig/attobencode
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Florian Hartwig++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * 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 Florian Hartwig 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/AttoBencode.hs view
@@ -0,0 +1,27 @@+-- |+-- Module: Data.AttoBencode+-- Copyright: Florian Hartwig+-- License: BSD3+-- Maintainer: Florian Hartwig <florian.j.hartwig@gmail.com>+-- Stability: experimental+-- Portability: GHC+--+module Data.AttoBencode+    ( +    -- * BEncode Types+      BValue(..)+    , Dict+    -- * Encoding and Decoding+    , decode+    , encode+    , FromBencode(..)+    , ToBencode(..)+    -- * Convencience Functions+    , (.:)+    , dict+    , (.=)+    ) where++import Data.AttoBencode.Types+import Data.AttoBencode.Parser (decode)+import Data.AttoBencode.Encode (encode)
+ src/Data/AttoBencode/Encode.hs view
@@ -0,0 +1,41 @@+-- |+-- Module: Data.AttoBencode.Encode+-- Copyright: Florian Hartwig+-- License: BSD3+-- Maintainer: Florian Hartwig <florian.j.hartwig@gmail.com>+-- Stability: experimental+-- Portability: GHC++module Data.AttoBencode.Encode (encode) where++import Data.AttoBencode.Types+import Blaze.ByteString.Builder+import Blaze.Text.Int (integral)+import Data.Map (toAscList)+import Data.Monoid+import qualified Data.ByteString.Char8 as B+import Data.Word (Word8)++-- | Serialise a Bencode value to a (strict) ByteString+encode :: ToBencode a => a -> B.ByteString+encode = toByteString . fromBValue . toBencode++dWord, iWord, eWord, lWord, colon :: Word8+dWord = 100+eWord = 101+lWord = 108+iWord = 105+colon = 58++fromBValue :: BValue -> Builder+fromBValue (BString s) = fromString s+fromBValue (BList l)   = fromWord8 lWord <> (mconcat . map fromBValue) l <> fromWord8 eWord+fromBValue (BDict d)   = fromWord8 dWord <> (mconcat . map fromPair) (toAscList d) <> fromWord8 eWord+fromBValue (BInt n)    = fromWord8 iWord <> integral n <> fromWord8 eWord++fromString :: B.ByteString -> Builder+fromString s = integral (B.length s) <> fromWord8 colon <> fromByteString s+{-# INLINE fromString #-}++fromPair :: (B.ByteString, BValue) -> Builder+fromPair (k, v) = fromString k <> fromBValue v
+ src/Data/AttoBencode/Parser.hs view
@@ -0,0 +1,59 @@+-- |+-- Module: Data.AttoBencode.Parser+-- Copyright: Florian Hartwig+-- License: BSD3+-- Maintainer: Florian Hartwig <florian.j.hartwig@gmail.com>+-- Stability: experimental+-- Portability: GHC++{-# LANGUAGE BangPatterns #-}+module Data.AttoBencode.Parser +    ( decode+    , bValue+    ) where++import Data.AttoBencode.Types+import Prelude hiding (take)+import Data.Attoparsec (maybeResult, parse, Parser)+import Data.Attoparsec.Char8 (char, decimal, signed, take)+import Control.Applicative (many, (<$>), (<|>), (*>), (<*))+import Data.Map (fromList)+import qualified Data.ByteString as B++-- | Deserialise a bencoded ByteString.+-- If parsing or conversion fails, Nothing is returned.+decode :: (FromBencode a) => B.ByteString -> Maybe a+decode bs = maybeResult (parse bValue bs) >>= fromBencode++-- | Parser for Bencode values+bValue :: Parser BValue+bValue = stringParser <|> intParser <|> listParser <|> dictParser++bsParser :: Parser B.ByteString+bsParser =+ do l <- decimal+    _ <- char ':'+    take l+{-# INLINE bsParser #-}++stringParser :: Parser BValue+stringParser = BString <$> bsParser++intParser :: Parser BValue+intParser = BInt <$> (char 'i' *> signed decimal <* char 'e')++listParser :: Parser BValue+listParser = BList <$> (char 'l' *> many bValue <* char 'e')++pairParser :: Parser (B.ByteString, BValue)+pairParser = + do !key <- bsParser+    !value <- bValue+    return (key, value)++dictParser :: Parser BValue+dictParser = + do _ <- char 'd'+    !pairs <- many pairParser+    _ <- char 'e'+    return $ BDict $ fromList pairs -- TODO: fromAscList?
+ src/Data/AttoBencode/Types.hs view
@@ -0,0 +1,103 @@+-- |+-- Module: Data.AttoBencode.Types+-- Copyright: Florian Hartwig+-- License: BSD3+-- Maintainer: Florian Hartwig <florian.j.hartwig@gmail.com>+-- Stability: experimental+-- Portability: GHC++{-# LANGUAGE FlexibleInstances #-}++module Data.AttoBencode.Types+    ( BValue(..)+    , Dict+    , FromBencode(..)+    , ToBencode(..)+    , (.:)+    , dict+    , (.=)+    ) where++import qualified Data.Map as M+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import Data.Traversable (traverse)++-- | The Haskell data type for Bencode values+data BValue = BString !ByteString+            | BInt !Integer+            | BList ![BValue]+            | BDict !Dict+    deriving (Show, Eq)++-- | A Bencode dictionary. Dictionaries have 'ByteString' keys and 'BValue'+--   values.+type Dict = M.Map ByteString BValue++-- TODO: example+-- | A type that can be converted to a 'BValue'.+class ToBencode a where+    toBencode :: a -> BValue++-- TODO: example+-- | A type that can be converted from a 'BValue'. The conversion can fail.+class FromBencode a where+    fromBencode :: BValue -> Maybe a++instance ToBencode ByteString where+    toBencode = BString++instance ToBencode String where+    toBencode = BString . B.pack++instance ToBencode Integer where+    toBencode = BInt++instance ToBencode Int where+    toBencode = BInt . fromIntegral++instance ToBencode a => ToBencode [a] where+    toBencode = BList . map toBencode++instance ToBencode a => ToBencode (M.Map ByteString a) where+    toBencode = BDict . M.map toBencode++instance ToBencode a => ToBencode [(ByteString, a)] where+    toBencode = BDict . M.fromList . map (\(k, v) -> (k, toBencode v))++instance ToBencode BValue where+    toBencode = id+-- TODO: make sure these are inlined+++instance FromBencode ByteString where+    fromBencode (BString bs) = Just bs+    fromBencode _            = Nothing++instance FromBencode Integer where+    fromBencode (BInt n) = Just n+    fromBencode _        = Nothing++instance (FromBencode a) => FromBencode (M.Map ByteString a) where+    fromBencode (BDict d) = traverse fromBencode d+    fromBencode _         = Nothing++instance (FromBencode a) => FromBencode [a] where+    fromBencode (BList l) = mapM fromBencode l+    fromBencode _         = Nothing++-- | Look up the value corresponding to a (ByteString) key from a dictionary.+--   Returns 'Nothing' if the key is not in the dictionary or if the 'BValue'+--   cannot be converted to the expected type.+(.:) :: FromBencode a => Dict -> ByteString -> Maybe a+d .: s = M.lookup s d >>= fromBencode++-- | Make a BDict from a list of (key, value) tuples.+dict :: [(ByteString, BValue)] -> BValue+dict = BDict . M.fromList++-- | Create a (key, value) tuple from a ByteString key and some bencode-able+--   value. Can be used with the 'dict' function as a convenient way to create+--   'BDict's.+(.=) :: ToBencode a => ByteString -> a -> (ByteString, BValue)+key .= value = (key, toBencode value)
+ tests/qc.hs view
@@ -0,0 +1,53 @@+import Test.QuickCheck+import Data.AttoBencode+import Control.Monad (liftM)+import Data.Map (Map, fromList)+import Test.Framework (Test, defaultMain)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import qualified Data.ByteString.Char8 as B++instance Arbitrary BValue where+    arbitrary = sized f+        -- need to mess with size to prevent generation of infinite test cases+        -- for recursive constructors+        where f 0 = oneof [liftM BString arbitrary+                          ,liftM BInt arbitrary]+              f n = oneof [liftM BString arbitrary+                          ,liftM BInt arbitrary+                          ,liftM BList $ listOf $ f $ n `div` 5+                          ,liftM BDict $ dict $ n `div` 5]++              dict :: Int -> Gen Dict+              dict n = liftM fromList (listOf (pair n))++              pair :: Int -> Gen (B.ByteString, BValue)+              pair n = do bs <- arbitrary+                          bv <- f n+                          return (bs, bv)+                          +instance Arbitrary B.ByteString where+    arbitrary   = fmap B.pack arbitrary+++instance FromBencode BValue where+    fromBencode = Just++prop_EncodeInteger :: Integer -> Bool+prop_EncodeInteger n = encode (BInt n) == B.pack ("i" ++ show n ++ "e")++prop_EncodeString :: B.ByteString -> Bool+prop_EncodeString bs =+    encode (BString bs) == B.pack (show (B.length bs) ++ ":") `B.append` bs++prop_EncodeDecode :: BValue -> Bool+prop_EncodeDecode bv = case decode (encode bv) of+                            Just bv' -> bv == bv'+                            Nothing  -> False++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests = [testProperty "prop_EncodeInteger" prop_EncodeInteger+        ,testProperty "prop_EncodeString" prop_EncodeString+        ,testProperty "prop_EncodeDecode" prop_EncodeDecode]