diff options
Diffstat (limited to 'src/Data/BEncode')
-rw-r--r-- | src/Data/BEncode/Internal.hs | 126 |
1 files changed, 126 insertions, 0 deletions
diff --git a/src/Data/BEncode/Internal.hs b/src/Data/BEncode/Internal.hs new file mode 100644 index 0000000..7ea61c0 --- /dev/null +++ b/src/Data/BEncode/Internal.hs | |||
@@ -0,0 +1,126 @@ | |||
1 | module Data.BEncode.Internal | ||
2 | ( decode | ||
3 | , encode | ||
4 | , ppBEncode | ||
5 | ) where | ||
6 | |||
7 | import Control.Applicative | ||
8 | import Data.Attoparsec.ByteString.Char8 (Parser) | ||
9 | import qualified Data.Attoparsec.ByteString.Char8 as P | ||
10 | import Data.ByteString as B | ||
11 | import qualified Data.ByteString.Lazy as Lazy | ||
12 | import qualified Data.ByteString.Lazy.Builder as B | ||
13 | import qualified Data.ByteString.Lazy.Builder.ASCII as B | ||
14 | import Data.ByteString.Internal as B (c2w, w2c) | ||
15 | import Data.Foldable | ||
16 | import Data.List as L | ||
17 | import Data.Monoid | ||
18 | import Text.PrettyPrint hiding ((<>)) | ||
19 | |||
20 | import Data.BEncode.Types | ||
21 | import Data.BEncode.BDict as BD | ||
22 | |||
23 | |||
24 | {-------------------------------------------------------------------- | ||
25 | -- Serialization | ||
26 | --------------------------------------------------------------------} | ||
27 | |||
28 | -- | BEncode format encoder according to specification. | ||
29 | builder :: BValue -> B.Builder | ||
30 | builder = go | ||
31 | where | ||
32 | go (BInteger i) = B.word8 (c2w 'i') <> | ||
33 | B.integerDec i <> | ||
34 | B.word8 (c2w 'e') | ||
35 | go (BString s) = buildString s | ||
36 | go (BList l) = B.word8 (c2w 'l') <> | ||
37 | foldMap go l <> | ||
38 | B.word8 (c2w 'e') | ||
39 | go (BDict d) = B.word8 (c2w 'd') <> | ||
40 | bifoldMap mkKV d <> | ||
41 | B.word8 (c2w 'e') | ||
42 | where | ||
43 | mkKV k v = buildString k <> go v | ||
44 | |||
45 | buildString s = B.intDec (B.length s) <> | ||
46 | B.word8 (c2w ':') <> | ||
47 | B.byteString s | ||
48 | {-# INLINE buildString #-} | ||
49 | |||
50 | -- | Convert bencoded value to raw bytestring according to the | ||
51 | -- specification. | ||
52 | encode :: BValue -> Lazy.ByteString | ||
53 | encode = B.toLazyByteString . builder | ||
54 | |||
55 | {-------------------------------------------------------------------- | ||
56 | -- Deserialization | ||
57 | --------------------------------------------------------------------} | ||
58 | |||
59 | -- TODO try to replace peekChar with something else | ||
60 | -- | BEncode format parser according to specification. | ||
61 | parser :: Parser BValue | ||
62 | parser = valueP | ||
63 | where | ||
64 | valueP = do | ||
65 | mc <- P.peekChar | ||
66 | case mc of | ||
67 | Nothing -> fail "end of input" | ||
68 | Just c -> | ||
69 | case c of | ||
70 | -- if we have digit it always should be string length | ||
71 | di | di <= '9' -> BString <$> stringP | ||
72 | 'i' -> P.anyChar *> ((BInteger <$> integerP) <* P.anyChar) | ||
73 | 'l' -> P.anyChar *> ((BList <$> listBodyP) <* P.anyChar) | ||
74 | 'd' -> P.anyChar *> (BDict <$> dictBodyP) <* P.anyChar | ||
75 | t -> fail ("bencode unknown tag: " ++ [t]) | ||
76 | |||
77 | dictBodyP :: Parser BDict | ||
78 | dictBodyP = Cons <$> stringP <*> valueP <*> dictBodyP | ||
79 | <|> pure Nil | ||
80 | |||
81 | listBodyP = do | ||
82 | c <- P.peekChar | ||
83 | case c of | ||
84 | Just 'e' -> return [] | ||
85 | _ -> (:) <$> valueP <*> listBodyP | ||
86 | |||
87 | stringP :: Parser ByteString | ||
88 | stringP = do | ||
89 | n <- P.decimal :: Parser Int | ||
90 | P.char ':' | ||
91 | P.take n | ||
92 | {-# INLINE stringP #-} | ||
93 | |||
94 | integerP :: Parser Integer | ||
95 | integerP = do | ||
96 | c <- P.peekChar | ||
97 | case c of | ||
98 | Just '-' -> do | ||
99 | P.anyChar | ||
100 | negate <$> P.decimal | ||
101 | _ -> P.decimal | ||
102 | {-# INLINE integerP #-} | ||
103 | |||
104 | -- | Try to convert raw bytestring to bencoded value according to | ||
105 | -- specification. | ||
106 | decode :: ByteString -> Either String BValue | ||
107 | decode = P.parseOnly parser | ||
108 | |||
109 | {-------------------------------------------------------------------- | ||
110 | Pretty Printing | ||
111 | --------------------------------------------------------------------} | ||
112 | |||
113 | ppBS :: ByteString -> Doc | ||
114 | ppBS = text . L.map w2c . B.unpack | ||
115 | |||
116 | -- | Convert to easily readable JSON-like document. Typically used for | ||
117 | -- debugging purposes. | ||
118 | ppBEncode :: BValue -> Doc | ||
119 | ppBEncode (BInteger i) = int $ fromIntegral i | ||
120 | ppBEncode (BString s) = ppBS s | ||
121 | ppBEncode (BList l) | ||
122 | = brackets $ hsep $ punctuate comma $ L.map ppBEncode l | ||
123 | ppBEncode (BDict d) | ||
124 | = braces $ vcat $ punctuate comma $ L.map ppKV $ BD.toAscList d | ||
125 | where | ||
126 | ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v | ||