diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-09-28 00:25:20 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-09-28 00:25:20 +0400 |
commit | abd06172c9baa1a0a4013ea56de83a2d49d84c3a (patch) | |
tree | 62c86434220d3962c12f964967d0243a2c0f4e77 | |
parent | de857a4b8e96c2a9ea4cec974442f08a93cb0098 (diff) |
Add type synonyms.
-rw-r--r-- | TODO.org | 6 | ||||
-rw-r--r-- | src/Data/BEncode.hs | 52 |
2 files changed, 34 insertions, 24 deletions
@@ -5,5 +5,9 @@ | |||
5 | * DONE documentation | 5 | * DONE documentation |
6 | * DONE document generics | 6 | * DONE document generics |
7 | * DONE v0.2.0.0 (reason: dictAssoc is hidded now) | 7 | * DONE v0.2.0.0 (reason: dictAssoc is hidded now) |
8 | * TODO use HashMap | 8 | * TODO fix portability issues |
9 | make int's instances platform independent so we can make library | ||
10 | portable. | ||
11 | * TODO rename BEncode to BValue | ||
12 | * TODO use HashMap for dicts | ||
9 | * TODO CPS Result | 13 | * TODO CPS Result |
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 5fb7e1e..715393f 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -1,6 +1,3 @@ | |||
1 | -- TODO: make int's instances platform independent so we can make | ||
2 | -- library portable. | ||
3 | |||
4 | -- | | 1 | -- | |
5 | -- Copyright : (c) Sam Truzjan 2013 | 2 | -- Copyright : (c) Sam Truzjan 2013 |
6 | -- License : BSD3 | 3 | -- License : BSD3 |
@@ -60,8 +57,13 @@ | |||
60 | 57 | ||
61 | module Data.BEncode | 58 | module Data.BEncode |
62 | ( -- * Datatype | 59 | ( -- * Datatype |
63 | BEncode(..) | 60 | BInteger |
64 | , Dict | 61 | , BString |
62 | , BList | ||
63 | , BDict | ||
64 | , BKey | ||
65 | |||
66 | , BEncode(..) | ||
65 | , ppBEncode | 67 | , ppBEncode |
66 | 68 | ||
67 | -- * Conversion | 69 | -- * Conversion |
@@ -133,18 +135,22 @@ import qualified Text.ParserCombinators.ReadP as ReadP | |||
133 | import GHC.Generics | 135 | import GHC.Generics |
134 | #endif | 136 | #endif |
135 | 137 | ||
136 | -- | BEncode key-value dictionary. | 138 | |
137 | type Dict = Map ByteString BEncode | 139 | type BInteger = Int64 |
140 | type BString = ByteString | ||
141 | type BList = [BEncode] | ||
142 | type BDict = Map BKey BEncode | ||
143 | type BKey = ByteString | ||
138 | 144 | ||
139 | -- | 'BEncode' is straightforward ADT for b-encoded values. Please | 145 | -- | 'BEncode' is straightforward ADT for b-encoded values. Please |
140 | -- note that since dictionaries are sorted, in most cases we can | 146 | -- note that since dictionaries are sorted, in most cases we can |
141 | -- compare BEncoded values without serialization and vice versa. | 147 | -- compare BEncoded values without serialization and vice versa. |
142 | -- Lists is not required to be sorted through. | 148 | -- Lists is not required to be sorted through. |
143 | -- | 149 | -- |
144 | data BEncode = BInteger {-# UNPACK #-} !Int64 | 150 | data BEncode = BInteger {-# UNPACK #-} !BInteger -- ^ bencode integers; |
145 | | BString !ByteString | 151 | | BString {-# UNPACK #-} !BString -- ^ bencode strings; |
146 | | BList [BEncode] | 152 | | BList BList -- ^ list of bencode values; |
147 | | BDict Dict | 153 | | BDict BDict -- ^ bencode key-value dictionary. |
148 | deriving (Show, Read, Eq, Ord) | 154 | deriving (Show, Read, Eq, Ord) |
149 | 155 | ||
150 | instance NFData BEncode where | 156 | instance NFData BEncode where |
@@ -248,8 +254,8 @@ instance (Eq e, Monoid e) | |||
248 | | x == mempty = pure U1 | 254 | | x == mempty = pure U1 |
249 | | otherwise = decodingError "U1" | 255 | | otherwise = decodingError "U1" |
250 | 256 | ||
251 | instance (GBEncodable a [BEncode], GBEncodable b [BEncode]) | 257 | instance (GBEncodable a BList, GBEncodable b BList) |
252 | => GBEncodable (a :*: b) [BEncode] where | 258 | => GBEncodable (a :*: b) BList where |
253 | {-# INLINE gto #-} | 259 | {-# INLINE gto #-} |
254 | gto (a :*: b) = gto a ++ gto b | 260 | gto (a :*: b) = gto a ++ gto b |
255 | 261 | ||
@@ -257,8 +263,8 @@ instance (GBEncodable a [BEncode], GBEncodable b [BEncode]) | |||
257 | gfrom (x : xs) = (:*:) <$> gfrom [x] <*> gfrom xs | 263 | gfrom (x : xs) = (:*:) <$> gfrom [x] <*> gfrom xs |
258 | gfrom [] = decodingError "generic: not enough fields" | 264 | gfrom [] = decodingError "generic: not enough fields" |
259 | 265 | ||
260 | instance (GBEncodable a Dict, GBEncodable b Dict) | 266 | instance (GBEncodable a BDict, GBEncodable b BDict) |
261 | => GBEncodable (a :*: b) Dict where | 267 | => GBEncodable (a :*: b) BDict where |
262 | {-# INLINE gto #-} | 268 | {-# INLINE gto #-} |
263 | gto (a :*: b) = gto a <> gto b | 269 | gto (a :*: b) = gto a <> gto b |
264 | 270 | ||
@@ -286,7 +292,7 @@ selRename = dropWhile ('_'==) | |||
286 | 292 | ||
287 | gfromM1S :: forall c. Selector c | 293 | gfromM1S :: forall c. Selector c |
288 | => GBEncodable f BEncode | 294 | => GBEncodable f BEncode |
289 | => Dict -> Result (M1 i c f p) | 295 | => BDict -> Result (M1 i c f p) |
290 | gfromM1S dict | 296 | gfromM1S dict |
291 | | Just va <- M.lookup (BC.pack (selRename name)) dict = M1 <$> gfrom va | 297 | | Just va <- M.lookup (BC.pack (selRename name)) dict = M1 <$> gfrom va |
292 | | otherwise = decodingError $ "generic: Selector not found " ++ show name | 298 | | otherwise = decodingError $ "generic: Selector not found " ++ show name |
@@ -294,7 +300,7 @@ gfromM1S dict | |||
294 | name = selName (error "gfromM1S: impossible" :: M1 i c f p) | 300 | name = selName (error "gfromM1S: impossible" :: M1 i c f p) |
295 | 301 | ||
296 | instance (Selector s, GBEncodable f BEncode) | 302 | instance (Selector s, GBEncodable f BEncode) |
297 | => GBEncodable (M1 S s f) Dict where | 303 | => GBEncodable (M1 S s f) BDict where |
298 | {-# INLINE gto #-} | 304 | {-# INLINE gto #-} |
299 | gto s @ (M1 x) = BC.pack (selRename (selName s)) `M.singleton` gto x | 305 | gto s @ (M1 x) = BC.pack (selRename (selName s)) `M.singleton` gto x |
300 | 306 | ||
@@ -303,7 +309,7 @@ instance (Selector s, GBEncodable f BEncode) | |||
303 | 309 | ||
304 | -- TODO DList | 310 | -- TODO DList |
305 | instance GBEncodable f BEncode | 311 | instance GBEncodable f BEncode |
306 | => GBEncodable (M1 S s f) [BEncode] where | 312 | => GBEncodable (M1 S s f) BList where |
307 | {-# INLINE gto #-} | 313 | {-# INLINE gto #-} |
308 | gto (M1 x) = [gto x] | 314 | gto (M1 x) = [gto x] |
309 | 315 | ||
@@ -311,7 +317,7 @@ instance GBEncodable f BEncode | |||
311 | gfrom _ = decodingError "generic: empty selector" | 317 | gfrom _ = decodingError "generic: empty selector" |
312 | {-# INLINE gfrom #-} | 318 | {-# INLINE gfrom #-} |
313 | 319 | ||
314 | instance (Constructor c, GBEncodable f Dict, GBEncodable f [BEncode]) | 320 | instance (Constructor c, GBEncodable f BDict, GBEncodable f BList) |
315 | => GBEncodable (M1 C c f) BEncode where | 321 | => GBEncodable (M1 C c f) BEncode where |
316 | {-# INLINE gto #-} | 322 | {-# INLINE gto #-} |
317 | gto con @ (M1 x) | 323 | gto con @ (M1 x) |
@@ -568,7 +574,7 @@ fromAscAssocs = BDict . M.fromAscList . mapMaybe unAssoc | |||
568 | -- | 574 | -- |
569 | -- The /reqKey/ is used to extract required key — if lookup is failed | 575 | -- The /reqKey/ is used to extract required key — if lookup is failed |
570 | -- then whole destructuring fail. | 576 | -- then whole destructuring fail. |
571 | reqKey :: BEncodable a => Dict -> ByteString -> Result a | 577 | reqKey :: BEncodable a => BDict -> BKey -> Result a |
572 | reqKey d key | 578 | reqKey d key |
573 | | Just b <- M.lookup key d = fromBEncode b | 579 | | Just b <- M.lookup key d = fromBEncode b |
574 | | otherwise = Left msg | 580 | | otherwise = Left msg |
@@ -577,19 +583,19 @@ reqKey d key | |||
577 | 583 | ||
578 | -- | Used to extract optional key — if lookup is failed returns | 584 | -- | Used to extract optional key — if lookup is failed returns |
579 | -- 'Nothing'. | 585 | -- 'Nothing'. |
580 | optKey :: BEncodable a => Dict -> ByteString -> Result (Maybe a) | 586 | optKey :: BEncodable a => BDict -> BKey -> Result (Maybe a) |
581 | optKey d key | 587 | optKey d key |
582 | | Just b <- M.lookup key d | 588 | | Just b <- M.lookup key d |
583 | , Right r <- fromBEncode b = return (Just r) | 589 | , Right r <- fromBEncode b = return (Just r) |
584 | | otherwise = return Nothing | 590 | | otherwise = return Nothing |
585 | 591 | ||
586 | -- | Infix version of the 'reqKey'. | 592 | -- | Infix version of the 'reqKey'. |
587 | (>--) :: BEncodable a => Dict -> ByteString -> Result a | 593 | (>--) :: BEncodable a => BDict -> BKey -> Result a |
588 | (>--) = reqKey | 594 | (>--) = reqKey |
589 | {-# INLINE (>--) #-} | 595 | {-# INLINE (>--) #-} |
590 | 596 | ||
591 | -- | Infix version of the 'optKey'. | 597 | -- | Infix version of the 'optKey'. |
592 | (>--?) :: BEncodable a => Dict -> ByteString -> Result (Maybe a) | 598 | (>--?) :: BEncodable a => BDict -> BKey -> Result (Maybe a) |
593 | (>--?) = optKey | 599 | (>--?) = optKey |
594 | {-# INLINE (>--?) #-} | 600 | {-# INLINE (>--?) #-} |
595 | 601 | ||