summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Exchange/Block.hs15
1 files changed, 14 insertions, 1 deletions
diff --git a/src/Network/BitTorrent/Exchange/Block.hs b/src/Network/BitTorrent/Exchange/Block.hs
index 4f49c6c9..0f437381 100644
--- a/src/Network/BitTorrent/Exchange/Block.hs
+++ b/src/Network/BitTorrent/Exchange/Block.hs
@@ -46,6 +46,7 @@ module Network.BitTorrent.Exchange.Block
46 , Network.BitTorrent.Exchange.Block.insert 46 , Network.BitTorrent.Exchange.Block.insert
47 , Network.BitTorrent.Exchange.Block.insertLazy 47 , Network.BitTorrent.Exchange.Block.insertLazy
48 , Network.BitTorrent.Exchange.Block.merge 48 , Network.BitTorrent.Exchange.Block.merge
49 , Network.BitTorrent.Exchange.Block.fromList
49 50
50 -- ** Rendering 51 -- ** Rendering
51 , Network.BitTorrent.Exchange.Block.toPiece 52 , Network.BitTorrent.Exchange.Block.toPiece
@@ -62,9 +63,10 @@ import Data.ByteString.Lazy as BL hiding (span)
62import Data.ByteString.Lazy.Builder as BS 63import Data.ByteString.Lazy.Builder as BS
63import Data.Default 64import Data.Default
64import Data.Monoid 65import Data.Monoid
65import Data.List hiding (span) 66import Data.List as L hiding (span)
66import Data.Serialize as S 67import Data.Serialize as S
67import Data.Typeable 68import Data.Typeable
69import Numeric
68import Text.PrettyPrint as PP hiding ((<>)) 70import Text.PrettyPrint as PP hiding ((<>))
69import Text.PrettyPrint.Class 71import Text.PrettyPrint.Class
70 72
@@ -217,6 +219,13 @@ data Bucket
217 | Span {-# UNPACK #-} !ChunkSize !Bucket 219 | Span {-# UNPACK #-} !ChunkSize !Bucket
218 | Fill {-# UNPACK #-} !ChunkSize !Builder !Bucket 220 | Fill {-# UNPACK #-} !ChunkSize !Builder !Bucket
219 221
222instance Show Bucket where
223 showsPrec i Nil = showString ""
224 showsPrec i (Span s xs) = showString "Span " <> showInt s
225 <> showString " " <> showsPrec i xs
226 showsPrec i (Fill s _ xs) = showString "Fill " <> showInt s
227 <> showString " " <> showsPrec i xs
228
220-- | INVARIANT: 'Nil' should appear only after 'Span' of 'Fill'. 229-- | INVARIANT: 'Nil' should appear only after 'Span' of 'Fill'.
221nilInvFailed :: a 230nilInvFailed :: a
222nilInvFailed = error "Nil: bucket invariant failed" 231nilInvFailed = error "Nil: bucket invariant failed"
@@ -344,6 +353,10 @@ insert dstPos bs bucket = go 0 bucket
344 | intersects curPos sz = bkt 353 | intersects curPos sz = bkt
345 | otherwise = fill sz br (go (curPos + sz) xs) 354 | otherwise = fill sz br (go (curPos + sz) xs)
346 355
356fromList :: PieceSize -> [(Pos, BS.ByteString)] -> Bucket
357fromList s = L.foldr (uncurry Network.BitTorrent.Exchange.Block.insert)
358 (Network.BitTorrent.Exchange.Block.empty s)
359
347-- TODO zero-copy 360-- TODO zero-copy
348insertLazy :: Pos -> BL.ByteString -> Bucket -> Bucket 361insertLazy :: Pos -> BL.ByteString -> Bucket -> Bucket
349insertLazy pos bl = Network.BitTorrent.Exchange.Block.insert pos (BL.toStrict bl) 362insertLazy pos bl = Network.BitTorrent.Exchange.Block.insert pos (BL.toStrict bl)