From: Abhiranjan Kumar Date: Sun, 12 Apr 2015 21:35:51 +0000 (+0530) Subject: Follow up #21. Applying fmap (alternative) on getters X-Git-Url: https://git.rkrishnan.org/vdrive/%5B/%5D%20/uri/status?a=commitdiff_plain;h=98dc02f2be38e699869be5266eeb6b241f4b3686;p=functorrent.git Follow up #21. Applying fmap (alternative) on getters --- diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs index 96600e2..bbeca65 100644 --- a/src/FuncTorrent/Bencode.hs +++ b/src/FuncTorrent/Bencode.hs @@ -1,10 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} -module FuncTorrent.Bencode - (BVal(..), - InfoDict, - bstrToString, - encode, - decode +module FuncTorrent.Bencode ( + BVal(..) + , InfoDict + , bstrToString + , bValToInteger + , bValToInfoDict + , bValToBList + , bValToBstr + , encode + , decode ) where import Prelude hiding (length, concat) @@ -23,6 +27,26 @@ data BVal = Bint Integer | Bdict InfoDict deriving (Ord, Eq, Show) +-- getters +bValToInteger :: BVal -> Maybe Integer +bValToInteger (Bint x) = Just x +bValToInteger _ = Nothing + +bValToBstr :: BVal -> Maybe ByteString +bValToBstr (Bstr bs) = Just bs +bValToBstr _ = Nothing + +bValToBList :: BVal -> Maybe [BVal] +bValToBList (Blist lst) = Just lst +bValToBList _ = Nothing + +bValToInfoDict :: BVal -> Maybe InfoDict +bValToInfoDict (Bdict dict) = Just dict +bValToInfoDict _ = Nothing + +bstrToString :: BVal -> Maybe String +bstrToString bval = unpack <$> bValToBstr bval + type InfoDict = Map String BVal -- $setup @@ -140,8 +164,3 @@ encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs encode (Bint i) = pack $ "i" ++ show i ++ "e" encode (Blist xs) = pack $ "l" ++ unpack (concat $ map encode xs) ++ "e" encode (Bdict d) = concat [concat ["d", encode . Bstr . pack $ k , encode (d ! k) , "e"] | k <- keys d] - --- getters -bstrToString :: BVal -> Maybe String -bstrToString (Bstr s) = Just $ unpack s -bstrToString _ = Nothing diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index dfedb59..1695b59 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -12,7 +12,7 @@ import Data.Map as M ((!), lookup) import Crypto.Hash.SHA1 (hash) import Data.Maybe (maybeToList) -import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString) +import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString, bValToInteger) -- only single file mode supported for the time being. data Info = Info { pieceLength :: !Integer @@ -46,30 +46,24 @@ mkInfo (Bdict m) = let (Bint pieceLength') = m ! "piece length" , md5sum = md5sum'} mkInfo _ = Nothing -maybeBstrToString :: Maybe BVal -> Maybe String -maybeBstrToString (Just (Bstr bs)) = Just $ unpack bs -maybeBstrToString _ = Nothing - -maybeBstrToInteger :: Maybe BVal -> Maybe Integer -maybeBstrToInteger (Just (Bint bs)) = Just bs -maybeBstrToInteger _ = Nothing - -mkMetaInfo :: BVal -> Maybe Metainfo -mkMetaInfo (Bdict m) = let (Just info') = mkInfo $ m ! "info" - announce' = lookup "announce" m - announceList' = lookup "announce-list" m - creationDate' = lookup "creation date" m - comment' = lookup "comment" m - createdBy' = lookup "created by" m - encoding' = lookup "encoding" m - in Just Metainfo { info = info' - , announceList = maybeToList (announce' >>= bstrToString) - ++ getAnnounceList announceList' - , creationDate = maybeBstrToInteger creationDate' - , comment = maybeBstrToString comment' - , createdBy = maybeBstrToString createdBy' - , encoding = maybeBstrToString encoding' - } +mkMetaInfo :: BVal -> Maybe Metainfo +mkMetaInfo (Bdict m) = + let (Just info') = mkInfo $ m ! "info" + announce' = lookup "announce" m + announceList' = lookup "announce-list" m + creationDate' = lookup "creation date" m + comment' = lookup "comment" m + createdBy' = lookup "created by" m + encoding' = lookup "encoding" m + in Just Metainfo { + info = info' + , announceList = maybeToList (announce' >>= bstrToString) + ++ getAnnounceList announceList' + , creationDate = bValToInteger =<< creationDate' + , comment = bstrToString =<< comment' + , createdBy = bstrToString =<< createdBy' + , encoding = bstrToString =<< encoding' + } mkMetaInfo _ = Nothing getAnnounceList :: Maybe BVal -> [String]