diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-10-01 04:14:10 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-10-01 04:14:10 +0400 |
commit | e14f03dcee1476496056ffbfe5fc5be75f2de567 (patch) | |
tree | 3d4f9618eba09c4e3d8ef0675c8d0a35cc559873 | |
parent | e908445889d638bd1e892502584775d23078a1a2 (diff) |
Document Get monad
-rw-r--r-- | src/Data/BEncode.hs | 29 |
1 files changed, 18 insertions, 11 deletions
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index eff900f..87deffa 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -593,7 +593,7 @@ data Assoc = Some !BKey BValue | |||
593 | infix 6 .=! | 593 | infix 6 .=! |
594 | 594 | ||
595 | -- | Like (.=!) but if the value is not present then the key do not | 595 | -- | Like (.=!) but if the value is not present then the key do not |
596 | -- appear in resulting bencoded dictionary. | 596 | -- appear in resulting bencode dictionary. |
597 | -- | 597 | -- |
598 | (.=?) :: BEncode a => BKey -> Maybe a -> Assoc | 598 | (.=?) :: BEncode a => BKey -> Maybe a -> Assoc |
599 | _ .=? Nothing = None | 599 | _ .=? Nothing = None |
@@ -626,17 +626,15 @@ endDict = Nil | |||
626 | 626 | ||
627 | -- | Dictionary extractor are similar to dictionary builders, but play | 627 | -- | Dictionary extractor are similar to dictionary builders, but play |
628 | -- the opposite role: they are used to define 'fromBEncode' method in | 628 | -- the opposite role: they are used to define 'fromBEncode' method in |
629 | -- declarative style. Using the same /FileInfo/ datatype 'fromBEncode' | 629 | -- declarative style. Using the same /FileInfo/ datatype the |
630 | -- looks like: | 630 | -- 'fromBEncode' function instance looks like: |
631 | -- | 631 | -- |
632 | -- > instance BEncodable FileInfo where | 632 | -- > instance BEncodable FileInfo where |
633 | -- > ... | 633 | -- > fromBEncode = fromDict $ do |
634 | -- > fromBEncode (BDict d) = | 634 | -- > FileInfo <$>! "length" |
635 | -- > FileInfo <$> d >-- "length" | 635 | -- > <*>? "md5sum" |
636 | -- > <*> d >--? "md5sum" | 636 | -- > <*>! "path" |
637 | -- > <*> d >-- "path" | 637 | -- > <*>? "tags" |
638 | -- > <*> d >--? "tags" | ||
639 | -- > fromBEncode _ = decodingError "FileInfo" | ||
640 | -- | 638 | -- |
641 | -- The /reqKey/ is used to extract required key — if lookup is failed | 639 | -- The /reqKey/ is used to extract required key — if lookup is failed |
642 | -- then whole destructuring fail. | 640 | -- then whole destructuring fail. |
@@ -644,12 +642,14 @@ endDict = Nil | |||
644 | newtype Get a = Get { runGet :: StateT BDict Result a } | 642 | newtype Get a = Get { runGet :: StateT BDict Result a } |
645 | deriving (Functor, Applicative, Alternative, Monad) | 643 | deriving (Functor, Applicative, Alternative, Monad) |
646 | 644 | ||
645 | -- | Get lexicographical successor of the current key\/value pair. | ||
647 | next :: Get BValue | 646 | next :: Get BValue |
648 | next = Get (StateT go) | 647 | next = Get (StateT go) |
649 | where | 648 | where |
650 | go Nil = throwError "no next" | 649 | go Nil = throwError "no next" |
651 | go (Cons _ v xs) = pure (v, xs) | 650 | go (Cons _ v xs) = pure (v, xs) |
652 | 651 | ||
652 | -- | Extract /required/ value from the given key. | ||
653 | req :: BKey -> Get BValue | 653 | req :: BKey -> Get BValue |
654 | req !key = Get (StateT search) | 654 | req !key = Get (StateT search) |
655 | where | 655 | where |
@@ -663,32 +663,39 @@ req !key = Get (StateT search) | |||
663 | msg = "required field `" ++ BC.unpack key ++ "' not found" | 663 | msg = "required field `" ++ BC.unpack key ++ "' not found" |
664 | {-# INLINE req #-} | 664 | {-# INLINE req #-} |
665 | 665 | ||
666 | -- | Extract optional value from the given key. | ||
666 | opt :: BKey -> Get (Maybe BValue) | 667 | opt :: BKey -> Get (Maybe BValue) |
667 | opt = optional . req | 668 | opt = optional . req |
668 | {-# INLINE opt #-} | 669 | {-# INLINE opt #-} |
669 | 670 | ||
670 | {-# SPECIALIZE field :: Get BValue -> Get BValue #-} | 671 | -- | Reconstruct a bencodable value from bencode value. |
671 | field :: BEncode a => Get BValue -> Get a | 672 | field :: BEncode a => Get BValue -> Get a |
673 | {-# SPECIALIZE field :: Get BValue -> Get BValue #-} | ||
672 | field m = Get $ do | 674 | field m = Get $ do |
673 | v <- runGet m | 675 | v <- runGet m |
674 | either throwError pure $ fromBEncode v | 676 | either throwError pure $ fromBEncode v |
675 | 677 | ||
678 | -- | Shorthand for /f <$> field (req k)/. | ||
676 | (<$>!) :: BEncode a => (a -> b) -> BKey -> Get b | 679 | (<$>!) :: BEncode a => (a -> b) -> BKey -> Get b |
677 | f <$>! k = f <$> field (req k) | 680 | f <$>! k = f <$> field (req k) |
678 | {-# INLINE (<$>!) #-} | 681 | {-# INLINE (<$>!) #-} |
679 | 682 | ||
683 | -- | Shorthand for /f <$> optional (field (req k))/. | ||
680 | (<$>?) :: BEncode a => (Maybe a -> b) -> BKey -> Get b | 684 | (<$>?) :: BEncode a => (Maybe a -> b) -> BKey -> Get b |
681 | f <$>? k = f <$> optional (field (req k)) | 685 | f <$>? k = f <$> optional (field (req k)) |
682 | {-# INLINE (<$>?) #-} | 686 | {-# INLINE (<$>?) #-} |
683 | 687 | ||
688 | -- | Shorthand for /f <*> field (req k)/. | ||
684 | (<*>!) :: BEncode a => Get (a -> b) -> BKey -> Get b | 689 | (<*>!) :: BEncode a => Get (a -> b) -> BKey -> Get b |
685 | f <*>! k = f <*> field (req k) | 690 | f <*>! k = f <*> field (req k) |
686 | {-# INLINE (<*>!) #-} | 691 | {-# INLINE (<*>!) #-} |
687 | 692 | ||
693 | -- | Shorthand for /f <*> optional (field (req k))/. | ||
688 | (<*>?) :: BEncode a => Get (Maybe a -> b) -> BKey -> Get b | 694 | (<*>?) :: BEncode a => Get (Maybe a -> b) -> BKey -> Get b |
689 | f <*>? k = f <*> optional (field (req k)) | 695 | f <*>? k = f <*> optional (field (req k)) |
690 | {-# INLINE (<*>?) #-} | 696 | {-# INLINE (<*>?) #-} |
691 | 697 | ||
698 | -- | Run a 'Get' monad. | ||
692 | fromDict :: forall a. Typeable a => Get a -> BValue -> Result a | 699 | fromDict :: forall a. Typeable a => Get a -> BValue -> Result a |
693 | fromDict m (BDict d) = evalStateT (runGet m) d | 700 | fromDict m (BDict d) = evalStateT (runGet m) d |
694 | fromDict _ _ = decodingError (show (typeOf inst)) | 701 | fromDict _ _ = decodingError (show (typeOf inst)) |