diff options
-rw-r--r-- | src/Data/BEncode.hs | 84 |
1 files changed, 48 insertions, 36 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index a866a6e..2494166 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -17,7 +17,7 @@ | |||
17 | -- | 17 | -- |
18 | -- * lists - represented as ordinary lists; | 18 | -- * lists - represented as ordinary lists; |
19 | -- | 19 | -- |
20 | -- * dictionaries — represented as 'Map'; | 20 | -- * dictionaries — represented as 'BDictMap'; |
21 | -- | 21 | -- |
22 | -- To serialize any other types we need to make conversion. To | 22 | -- To serialize any other types we need to make conversion. To |
23 | -- make conversion more convenient there is type class for it: | 23 | -- make conversion more convenient there is type class for it: |
@@ -40,7 +40,9 @@ | |||
40 | -- > <DIGIT> ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" | 40 | -- > <DIGIT> ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" |
41 | -- | 41 | -- |
42 | -- | 42 | -- |
43 | -- This module is considered to be imported qualified. | 43 | -- This module is considered to be imported qualified, for example: |
44 | -- | ||
45 | -- > import Data.BEncode as BE | ||
44 | -- | 46 | -- |
45 | {-# LANGUAGE FlexibleInstances #-} | 47 | {-# LANGUAGE FlexibleInstances #-} |
46 | {-# LANGUAGE Trustworthy #-} | 48 | {-# LANGUAGE Trustworthy #-} |
@@ -125,7 +127,7 @@ type Result = Either String | |||
125 | -- the following datatype: | 127 | -- the following datatype: |
126 | -- | 128 | -- |
127 | -- > data List a = C { _head :: a | 129 | -- > data List a = C { _head :: a |
128 | -- > , __tail :: List a } | 130 | -- > , __tail :: List a } |
129 | -- > | N | 131 | -- > | N |
130 | -- > deriving Generic | 132 | -- > deriving Generic |
131 | -- | 133 | -- |
@@ -140,7 +142,8 @@ type Result = Either String | |||
140 | -- > > toBEncode (C 123 $ C 1 N) | 142 | -- > > toBEncode (C 123 $ C 1 N) |
141 | -- > BDict (fromList [("head",BInteger 123),("tail",BList [])]) | 143 | -- > BDict (fromList [("head",BInteger 123),("tail",BList [])]) |
142 | -- | 144 | -- |
143 | -- Note that '_' prefixes are omitted since they are used for lens. | 145 | -- Note that prefixed underscore characters are omitted since they |
146 | -- are usually used for lens. | ||
144 | -- | 147 | -- |
145 | class BEncode a where | 148 | class BEncode a where |
146 | -- | See an example of implementation here 'Assoc' | 149 | -- | See an example of implementation here 'Assoc' |
@@ -559,28 +562,34 @@ instance (BEncode a, BEncode b, BEncode c, BEncode d, BEncode e) | |||
559 | -- optional keys. Suppose we have we following datatype we want to | 562 | -- optional keys. Suppose we have we following datatype we want to |
560 | -- serialize: | 563 | -- serialize: |
561 | -- | 564 | -- |
562 | -- > data FileInfo = FileInfo | 565 | -- @ |
563 | -- > { fileLength :: Integer | 566 | -- data FileInfo = FileInfo |
564 | -- > , fileMD5sum :: Maybe ByteString | 567 | -- { fileLength :: Integer |
565 | -- > , filePath :: [ByteString] | 568 | -- , fileMD5sum :: Maybe ByteString |
566 | -- > , fileTags :: Maybe [Text] | 569 | -- , filePath :: [ByteString] |
567 | -- > } deriving (Show, Read, Eq) | 570 | -- , fileTags :: Maybe [Text] |
571 | -- } deriving (Show, Read, Eq) | ||
572 | -- @ | ||
568 | -- | 573 | -- |
569 | -- We need to make /instance BEncode FileInfo/, though we don't want | 574 | -- We need to make @instance 'BEncode' FileInfo@, though we don't want |
570 | -- to check the both /maybes/ manually. The more declarative and | 575 | -- to check the both 'Maybe's manually. The more declarative and |
571 | -- convenient way to define the 'toBEncode' method is to use | 576 | -- convenient way to define the 'toBEncode' method is to use |
572 | -- dictionary builders: | 577 | -- dictionary builders: |
573 | -- | 578 | -- |
574 | -- > instance BEncode FileInfo where | 579 | -- @ |
575 | -- > toBEncode FileInfo {..} = toDict $ | 580 | -- instance 'BEncode' FileInfo where |
576 | -- > "length" .=! fileLength | 581 | -- 'toBEncode' FileInfo {..} = 'toDict' $ |
577 | -- > .: "md5sum" .=? fileMD5sum | 582 | -- \"length\" '.=!' fileLength |
578 | -- > .: "path" .=! filePath | 583 | -- '.:' \"md5sum\" '.=?' fileMD5sum |
579 | -- > .: "tags" .=? fileTags | 584 | -- '.:' \"path\" '.=!' filePath |
580 | -- > .: endDict | 585 | -- '.:' \"tags\" '.=?' fileTags |
586 | -- '.:' 'endDict' | ||
587 | -- @ | ||
588 | -- | ||
589 | -- NOTE: the list of pairs MUST be sorted lexicographically by keys, | ||
590 | -- like so: | ||
581 | -- | 591 | -- |
582 | -- NOTE: the list of pairs SHOULD be sorted lexicographically by | 592 | -- \"length\" '<' \"md5sum\" '<' \"path\" '<' \"tags\" |
583 | -- keys, so: "length" < "md5sum" < "path" < "tags". | ||
584 | -- | 593 | -- |
585 | data Assoc = Some !BKey BValue | 594 | data Assoc = Some !BKey BValue |
586 | | None | 595 | | None |
@@ -592,8 +601,8 @@ data Assoc = Some !BKey BValue | |||
592 | 601 | ||
593 | infix 6 .=! | 602 | infix 6 .=! |
594 | 603 | ||
595 | -- | Like (.=!) but if the value is not present then the key do not | 604 | -- | Like the ('.=!') operator but if the value is not present then |
596 | -- appear in resulting bencode dictionary. | 605 | -- the key do not appear in resulting bencode dictionary. |
597 | -- | 606 | -- |
598 | (.=?) :: BEncode a => BKey -> Maybe a -> Assoc | 607 | (.=?) :: BEncode a => BKey -> Maybe a -> Assoc |
599 | _ .=? Nothing = None | 608 | _ .=? Nothing = None |
@@ -629,18 +638,21 @@ endDict = Nil | |||
629 | -- declarative style. Using the same /FileInfo/ datatype the | 638 | -- declarative style. Using the same /FileInfo/ datatype the |
630 | -- 'fromBEncode' function instance looks like: | 639 | -- 'fromBEncode' function instance looks like: |
631 | -- | 640 | -- |
632 | -- > instance BEncodable FileInfo where | 641 | -- @ |
633 | -- > fromBEncode = fromDict $ do | 642 | -- instance 'BEncode' FileInfo where |
634 | -- > FileInfo <$>! "length" | 643 | -- 'fromBEncode' = 'fromDict' $ do |
635 | -- > <*>? "md5sum" | 644 | -- FileInfo '<$>!' \"length\" |
636 | -- > <*>! "path" | 645 | -- '<*>?' \"md5sum\" |
637 | -- > <*>? "tags" | 646 | -- '<*>!' \"path\" |
647 | -- '<*>?' \"tags\" | ||
648 | -- @ | ||
638 | -- | 649 | -- |
639 | -- The /reqKey/ is used to extract required key — if lookup is failed | 650 | -- The /reqKey/ is used to extract required key — if lookup is failed |
640 | -- then whole destructuring fail. | 651 | -- then whole destructuring fail. |
641 | -- | 652 | -- |
642 | -- NOTE: the actions SHOULD be sorted lexicographically by keys, so: | 653 | -- NOTE: the actions MUST be sorted lexicographically by keys, like so: |
643 | -- "length" < "md5sum" < "path" < "tags". | 654 | -- |
655 | -- \"length\" '<' \"md5sum\" '<' \"path\" '<' \"tags\" | ||
644 | -- | 656 | -- |
645 | newtype Get a = Get { runGet :: StateT BDict Result a } | 657 | newtype Get a = Get { runGet :: StateT BDict Result a } |
646 | deriving (Functor, Applicative, Alternative) | 658 | deriving (Functor, Applicative, Alternative) |
@@ -692,35 +704,35 @@ field m = Get $ do | |||
692 | v <- runGet m | 704 | v <- runGet m |
693 | either throwError pure $ fromBEncode v | 705 | either throwError pure $ fromBEncode v |
694 | 706 | ||
695 | -- | Shorthand for /f <$> field (req k)/. | 707 | -- | Shorthand for: @f '<$>' 'field' ('req' k)@. |
696 | (<$>!) :: BEncode a => (a -> b) -> BKey -> Get b | 708 | (<$>!) :: BEncode a => (a -> b) -> BKey -> Get b |
697 | f <$>! k = f <$> field (req k) | 709 | f <$>! k = f <$> field (req k) |
698 | {-# INLINE (<$>!) #-} | 710 | {-# INLINE (<$>!) #-} |
699 | 711 | ||
700 | infixl 4 <$>! | 712 | infixl 4 <$>! |
701 | 713 | ||
702 | -- | Shorthand for /f <$> optional (field (req k))/. | 714 | -- | Shorthand for: @f '<$>' 'optional' ('field' ('req' k))@. |
703 | (<$>?) :: BEncode a => (Maybe a -> b) -> BKey -> Get b | 715 | (<$>?) :: BEncode a => (Maybe a -> b) -> BKey -> Get b |
704 | f <$>? k = f <$> optional (field (req k)) | 716 | f <$>? k = f <$> optional (field (req k)) |
705 | {-# INLINE (<$>?) #-} | 717 | {-# INLINE (<$>?) #-} |
706 | 718 | ||
707 | infixl 4 <$>? | 719 | infixl 4 <$>? |
708 | 720 | ||
709 | -- | Shorthand for /f <*> field (req k)/. | 721 | -- | Shorthand for: @f '<*>' 'field' ('req' k)@. |
710 | (<*>!) :: BEncode a => Get (a -> b) -> BKey -> Get b | 722 | (<*>!) :: BEncode a => Get (a -> b) -> BKey -> Get b |
711 | f <*>! k = f <*> field (req k) | 723 | f <*>! k = f <*> field (req k) |
712 | {-# INLINE (<*>!) #-} | 724 | {-# INLINE (<*>!) #-} |
713 | 725 | ||
714 | infixl 4 <*>! | 726 | infixl 4 <*>! |
715 | 727 | ||
716 | -- | Shorthand for /f <*> optional (field (req k))/. | 728 | -- | Shorthand for: @f '<*>' 'optional' ('field' ('req' k))@. |
717 | (<*>?) :: BEncode a => Get (Maybe a -> b) -> BKey -> Get b | 729 | (<*>?) :: BEncode a => Get (Maybe a -> b) -> BKey -> Get b |
718 | f <*>? k = f <*> optional (field (req k)) | 730 | f <*>? k = f <*> optional (field (req k)) |
719 | {-# INLINE (<*>?) #-} | 731 | {-# INLINE (<*>?) #-} |
720 | 732 | ||
721 | infixl 4 <*>? | 733 | infixl 4 <*>? |
722 | 734 | ||
723 | -- | Run a 'Get' monad. | 735 | -- | Run a 'Get' monad. See 'Get' for usage. |
724 | fromDict :: forall a. Typeable a => Get a -> BValue -> Result a | 736 | fromDict :: forall a. Typeable a => Get a -> BValue -> Result a |
725 | fromDict m (BDict d) = evalStateT (runGet m) d | 737 | fromDict m (BDict d) = evalStateT (runGet m) d |
726 | fromDict _ _ = decodingError (show (typeOf inst)) | 738 | fromDict _ _ = decodingError (show (typeOf inst)) |