diff options
-rw-r--r-- | src/Data/BEncode.hs | 112 | ||||
-rw-r--r-- | src/Data/BEncode/Internal.hs | 126 |
2 files changed, 127 insertions, 111 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 4d7b6c5..1969595 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -65,7 +65,6 @@ module Data.BEncode | |||
65 | , BKey | 65 | , BKey |
66 | 66 | ||
67 | , BValue (..) | 67 | , BValue (..) |
68 | , ppBEncode | ||
69 | 68 | ||
70 | -- * Conversion | 69 | -- * Conversion |
71 | , BEncode (..) | 70 | , BEncode (..) |
@@ -97,10 +96,6 @@ module Data.BEncode | |||
97 | , isString | 96 | , isString |
98 | , isList | 97 | , isList |
99 | , isDict | 98 | , isDict |
100 | |||
101 | -- * Extra | ||
102 | , builder | ||
103 | , parser | ||
104 | ) where | 99 | ) where |
105 | 100 | ||
106 | 101 | ||
@@ -118,20 +113,14 @@ import Data.Map (Map) | |||
118 | import qualified Data.Map as M | 113 | import qualified Data.Map as M |
119 | import Data.Set (Set) | 114 | import Data.Set (Set) |
120 | import qualified Data.Set as S | 115 | import qualified Data.Set as S |
121 | import Data.Attoparsec.ByteString.Char8 (Parser) | ||
122 | import qualified Data.Attoparsec.ByteString.Char8 as P | ||
123 | import Data.ByteString (ByteString) | 116 | import Data.ByteString (ByteString) |
124 | import qualified Data.ByteString as B | 117 | import qualified Data.ByteString as B |
125 | import qualified Data.ByteString.Char8 as BC | 118 | import qualified Data.ByteString.Char8 as BC |
126 | import qualified Data.ByteString.Lazy as Lazy | 119 | import qualified Data.ByteString.Lazy as Lazy |
127 | import qualified Data.ByteString.Lazy.Builder as B | ||
128 | import qualified Data.ByteString.Lazy.Builder.ASCII as B | ||
129 | import Data.ByteString.Internal as B (c2w, w2c) | ||
130 | import Data.Text (Text) | 120 | import Data.Text (Text) |
131 | import qualified Data.Text.Encoding as T | 121 | import qualified Data.Text.Encoding as T |
132 | import Data.Typeable | 122 | import Data.Typeable |
133 | import Data.Version | 123 | import Data.Version |
134 | import Text.PrettyPrint hiding ((<>)) | ||
135 | import qualified Text.ParserCombinators.ReadP as ReadP | 124 | import qualified Text.ParserCombinators.ReadP as ReadP |
136 | 125 | ||
137 | #if __GLASGOW_HASKELL__ >= 702 | 126 | #if __GLASGOW_HASKELL__ >= 702 |
@@ -139,6 +128,7 @@ import GHC.Generics | |||
139 | #endif | 128 | #endif |
140 | 129 | ||
141 | import Data.BEncode.BDict as BD | 130 | import Data.BEncode.BDict as BD |
131 | import Data.BEncode.Internal | ||
142 | import Data.BEncode.Types | 132 | import Data.BEncode.Types |
143 | 133 | ||
144 | 134 | ||
@@ -709,16 +699,6 @@ isDict _ = False | |||
709 | Encoding | 699 | Encoding |
710 | --------------------------------------------------------------------} | 700 | --------------------------------------------------------------------} |
711 | 701 | ||
712 | -- | Convert bencoded value to raw bytestring according to the | ||
713 | -- specification. | ||
714 | encode :: BValue -> Lazy.ByteString | ||
715 | encode = B.toLazyByteString . builder | ||
716 | |||
717 | -- | Try to convert raw bytestring to bencoded value according to | ||
718 | -- specification. | ||
719 | decode :: ByteString -> Result BValue | ||
720 | decode = P.parseOnly parser | ||
721 | |||
722 | -- | The same as 'decode' but returns any bencodable value. | 702 | -- | The same as 'decode' but returns any bencodable value. |
723 | decoded :: BEncode a => ByteString -> Result a | 703 | decoded :: BEncode a => ByteString -> Result a |
724 | decoded = decode >=> fromBEncode | 704 | decoded = decode >=> fromBEncode |
@@ -726,93 +706,3 @@ decoded = decode >=> fromBEncode | |||
726 | -- | The same as 'encode' but takes any bencodable value. | 706 | -- | The same as 'encode' but takes any bencodable value. |
727 | encoded :: BEncode a => a -> Lazy.ByteString | 707 | encoded :: BEncode a => a -> Lazy.ByteString |
728 | encoded = encode . toBEncode | 708 | encoded = encode . toBEncode |
729 | |||
730 | {-------------------------------------------------------------------- | ||
731 | Internals | ||
732 | --------------------------------------------------------------------} | ||
733 | |||
734 | -- | BEncode format encoder according to specification. | ||
735 | builder :: BValue -> B.Builder | ||
736 | builder = go | ||
737 | where | ||
738 | go (BInteger i) = B.word8 (c2w 'i') <> | ||
739 | B.integerDec i <> | ||
740 | B.word8 (c2w 'e') | ||
741 | go (BString s) = buildString s | ||
742 | go (BList l) = B.word8 (c2w 'l') <> | ||
743 | foldMap go l <> | ||
744 | B.word8 (c2w 'e') | ||
745 | go (BDict d) = B.word8 (c2w 'd') <> | ||
746 | bifoldMap mkKV d <> | ||
747 | B.word8 (c2w 'e') | ||
748 | where | ||
749 | mkKV k v = buildString k <> go v | ||
750 | |||
751 | buildString s = B.intDec (B.length s) <> | ||
752 | B.word8 (c2w ':') <> | ||
753 | B.byteString s | ||
754 | {-# INLINE buildString #-} | ||
755 | |||
756 | -- TODO try to replace peekChar with something else | ||
757 | -- | BEncode format parser according to specification. | ||
758 | parser :: Parser BValue | ||
759 | parser = valueP | ||
760 | where | ||
761 | valueP = do | ||
762 | mc <- P.peekChar | ||
763 | case mc of | ||
764 | Nothing -> fail "end of input" | ||
765 | Just c -> | ||
766 | case c of | ||
767 | -- if we have digit it always should be string length | ||
768 | di | di <= '9' -> BString <$> stringP | ||
769 | 'i' -> P.anyChar *> ((BInteger <$> integerP) <* P.anyChar) | ||
770 | 'l' -> P.anyChar *> ((BList <$> listBodyP) <* P.anyChar) | ||
771 | 'd' -> P.anyChar *> (BDict <$> dictBodyP) <* P.anyChar | ||
772 | t -> fail ("bencode unknown tag: " ++ [t]) | ||
773 | |||
774 | dictBodyP :: Parser BDict | ||
775 | dictBodyP = Cons <$> stringP <*> valueP <*> dictBodyP | ||
776 | <|> pure Nil | ||
777 | |||
778 | listBodyP = do | ||
779 | c <- P.peekChar | ||
780 | case c of | ||
781 | Just 'e' -> return [] | ||
782 | _ -> (:) <$> valueP <*> listBodyP | ||
783 | |||
784 | stringP :: Parser ByteString | ||
785 | stringP = do | ||
786 | n <- P.decimal :: Parser Int | ||
787 | P.char ':' | ||
788 | P.take n | ||
789 | {-# INLINE stringP #-} | ||
790 | |||
791 | integerP :: Parser Integer | ||
792 | integerP = do | ||
793 | c <- P.peekChar | ||
794 | case c of | ||
795 | Just '-' -> do | ||
796 | P.anyChar | ||
797 | negate <$> P.decimal | ||
798 | _ -> P.decimal | ||
799 | {-# INLINE integerP #-} | ||
800 | |||
801 | {-------------------------------------------------------------------- | ||
802 | Pretty Printing | ||
803 | --------------------------------------------------------------------} | ||
804 | |||
805 | ppBS :: ByteString -> Doc | ||
806 | ppBS = text . L.map w2c . B.unpack | ||
807 | |||
808 | -- | Convert to easily readable JSON-like document. Typically used for | ||
809 | -- debugging purposes. | ||
810 | ppBEncode :: BValue -> Doc | ||
811 | ppBEncode (BInteger i) = int $ fromIntegral i | ||
812 | ppBEncode (BString s) = ppBS s | ||
813 | ppBEncode (BList l) | ||
814 | = brackets $ hsep $ punctuate comma $ L.map ppBEncode l | ||
815 | ppBEncode (BDict d) | ||
816 | = braces $ vcat $ punctuate comma $ L.map ppKV $ BD.toAscList d | ||
817 | where | ||
818 | ppKV (k, v) = ppBS k <+> colon <+> ppBEncode v | ||
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 | ||