Commits

FlorianHartwig committed d4aadca

Clean up, rewrite encoding for better performance.

  • Participants
  • Parent commits 3c412bc

Comments (0)

Files changed (4)

src/Data/AttoBencode.hs

-{-# LANGUAGE OverloadedStrings #-}
-
 module Data.AttoBencode 
     ( BValue(..) 
     , Dict
     , encode
     ) where
 
-import qualified Data.ByteString.Char8 as B
-import Data.Bencode.Types
-import Data.Map (toAscList)
-import Data.Bencode.Parser
-import qualified Data.Map as M
-
--- Encoding
--- TODO: do this in a way that is not hilariously inefficient
-encode :: BValue -> B.ByteString
-encode (BString s) = B.concat [(B.pack . show . B.length) s, ":", s]
-encode (BInt n)    = B.pack ('i':show n) `B.snoc` 'e'
-encode (BList l)   = B.concat ["l", B.concat (map encode l), "e"]
-encode (BDict d)   = 
-    B.concat ["d", B.concat (map encodePair (toAscList d)), "e"]
-
-encodePair :: (B.ByteString, BValue) -> B.ByteString
-encodePair (key, value) = (encode (BString key)) `B.append` encode value
-
--- testing
-testString, testInt, testDict, testList :: BValue
-testString = BString "Blabla"
-testInt = BInt 25
-testDict = BDict $ M.singleton "Blub" testInt
-testList = BList [testString, testInt]
-
--- parse and re-encode torrent file, check that encoded string == parsed file
-testParser :: String -> IO ()
-testParser f =
-  do s <- B.readFile f
-     let r = decode s
-     case r of
-         Nothing -> return ()
-         Just t ->
-           do print $ encode t == s
-     return ()
+import Data.AttoBencode.Types
+import Data.AttoBencode.Parser (decode)
+import Data.AttoBencode.Encode (encode)

src/Data/AttoBencode/Encode.hs

+module Data.AttoBencode.Encode (encode) where
+
+import Data.AttoBencode.Types
+import Blaze.ByteString.Builder
+import Data.Map (toAscList)
+import Data.Monoid
+import qualified Data.ByteString.Char8 as B
+
+encode :: BValue -> B.ByteString
+encode = toByteString . fromBValue
+
+-- TODO: check out associativity of <>
+-- TODO: get rid of magic numbers
+fromBValue :: BValue -> Builder
+fromBValue (BString s) = fromString s
+fromBValue (BList l)   = fromWord8 108 <> (mconcat . map fromBValue) l <> fromWord8 101
+fromBValue (BDict d)   = fromWord8 100 <> (mconcat . map fromPair) (toAscList d) <> fromWord8 101
+fromBValue (BInt n)    = fromWord8 105 <> toBuilder n <> fromWord8 101
+
+fromString :: B.ByteString -> Builder
+fromString s = toBuilder (B.length s) <> fromWord8 58 <> fromByteString s
+{-# INLINE fromString #-}
+
+fromPair :: (B.ByteString, BValue) -> Builder
+fromPair (k, v) = fromString k <> fromBValue v
+
+-- TODO: this is awful, find better way to do this
+toBuilder :: Show a => a -> Builder
+toBuilder = fromByteString . B.pack . show
+{-# INLINE toBuilder #-}
+{-# SPECIALISE toBuilder :: Integer -> Builder #-}
+{-# SPECIALISE toBuilder :: Int -> Builder #-}
+-- TODO: see if specialising and inlining make a difference

src/Data/AttoBencode/Parser.hs

     , getList
     , getDict
     , getInteger
+    , getString
     , bValue
     ) where
 
 bsParser :: Parser B.ByteString
 bsParser =
  do l <- decimal
-    char ':'
+    _ <-char ':'
     take l
 {-# INLINE bsParser #-}
 
 
 dictParser :: Parser BValue
 dictParser = 
- do char 'd'
+ do _ <- char 'd'
     !pairs <- many pairParser
-    char 'e'
+    _ <- char 'e'
     return $ BDict $ fromList pairs -- TODO: fromAscList?

src/Data/AttoBencode/Types.hs

 module Data.AttoBencode.Types where
 
-import Data.Map
+import Data.Map (Map)
 import qualified Data.ByteString as B
 
 data BValue = BString !B.ByteString
-           | BInt !Integer
-           | BList ![BValue]
-           | BDict !Dict
+            | BInt !Integer
+            | BList ![BValue]
+            | BDict !Dict
     deriving (Show, Eq)
 
 type Dict = Map B.ByteString BValue