summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2013-10-01 04:14:10 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2013-10-01 04:14:10 +0400
commite14f03dcee1476496056ffbfe5fc5be75f2de567 (patch)
tree3d4f9618eba09c4e3d8ef0675c8d0a35cc559873
parente908445889d638bd1e892502584775d23078a1a2 (diff)
Document Get monad
-rw-r--r--src/Data/BEncode.hs29
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
593infix 6 .=! 593infix 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
644newtype Get a = Get { runGet :: StateT BDict Result a } 642newtype 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.
647next :: Get BValue 646next :: Get BValue
648next = Get (StateT go) 647next = 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.
653req :: BKey -> Get BValue 653req :: BKey -> Get BValue
654req !key = Get (StateT search) 654req !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.
666opt :: BKey -> Get (Maybe BValue) 667opt :: BKey -> Get (Maybe BValue)
667opt = optional . req 668opt = 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.
671field :: BEncode a => Get BValue -> Get a 672field :: BEncode a => Get BValue -> Get a
673{-# SPECIALIZE field :: Get BValue -> Get BValue #-}
672field m = Get $ do 674field 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
677f <$>! k = f <$> field (req k) 680f <$>! 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
681f <$>? k = f <$> optional (field (req k)) 685f <$>? 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
685f <*>! k = f <*> field (req k) 690f <*>! 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
689f <*>? k = f <*> optional (field (req k)) 695f <*>? k = f <*> optional (field (req k))
690{-# INLINE (<*>?) #-} 696{-# INLINE (<*>?) #-}
691 697
698-- | Run a 'Get' monad.
692fromDict :: forall a. Typeable a => Get a -> BValue -> Result a 699fromDict :: forall a. Typeable a => Get a -> BValue -> Result a
693fromDict m (BDict d) = evalStateT (runGet m) d 700fromDict m (BDict d) = evalStateT (runGet m) d
694fromDict _ _ = decodingError (show (typeOf inst)) 701fromDict _ _ = decodingError (show (typeOf inst))