bencode 0.3 → 0.4
raw patch · 6 files changed
+39/−27 lines, 6 filesdep ~basesetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.BEncode.Parser: instance Functor BParser
+ Data.BEncode.Parser: instance MonadPlus BParser
Files
- Setup.hs +0/−2
- Setup.lhs +5/−0
- bencode.cabal +5/−5
- src/Data/BEncode.hs +12/−9
- src/Data/BEncode/Lexer.hs +2/−4
- src/Data/BEncode/Parser.hs +15/−7
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMainWithHooks defaultUserHooks
+ Setup.lhs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMainWithHooks defaultUserHooks
bencode.cabal view
@@ -1,19 +1,19 @@ Name: bencode-Version: 0.3+Version: 0.4 Maintainer: Lemmih (lemmih@gmail.com) Author: Lemmih (lemmih@gmail.com), Jesper Louis Andersen-Copyright: 2005-2007, Lemmih+Copyright: 2005-2009, Lemmih License-File: LICENSE License: BSD3-Build-Depends: base, parsec, bytestring, containers, binary+Build-Depends: base<5, parsec, bytestring, containers, binary Build-Type: Simple Category: Text Synopsis: Parser and printer for bencoded data.-Tested-with: GHC ==6.8.1+Tested-with: GHC ==6.8.1, GHC ==6.10.2 Extensions: PatternGuards Exposed-Modules: Data.BEncode Data.BEncode.Lexer Data.BEncode.Parser-GHC-Options: -Wall -Werror+GHC-Options: -Wall Hs-Source-Dirs: src
src/Data/BEncode.hs view
@@ -44,10 +44,10 @@ import qualified Data.Map as Map import Data.Map (Map)+import Data.List (sort) import Text.ParserCombinators.Parsec import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Char8 as BS-import Data.ByteString (ByteString) import Data.Binary import Data.BEncode.Lexer ( Token (..), lexer )@@ -59,7 +59,7 @@ data type here -} data BEncode = BInt Int- | BString ByteString+ | BString L.ByteString | BList [BEncode] | BDict (Map String BEncode) deriving (Eq, Ord, Show)@@ -88,7 +88,7 @@ where fn (TNumber i) = Just i fn _ = Nothing -tstring :: BParser ByteString+tstring :: BParser L.ByteString tstring = token' fn where fn (TString str) = Just str fn _ = Nothing@@ -110,11 +110,14 @@ bList = withToken TList $ fmap BList (many bParse) bDict :: BParser BEncode-bDict = withToken TDict $ fmap (BDict . Map.fromAscList) (many1 bAssocList)- where bAssocList+bDict = withToken TDict $ fmap (BDict . Map.fromAscList) (checkList =<< many1 bAssocList)+ where checkList lst = if (lst /= sort lst)+ then fail "dictionary not sorted"+ else return lst+ bAssocList = do str <- tstring value <- bParse- return (BS.unpack str,value)+ return (L.unpack str,value) bParse :: BParser BEncode bParse = bDict <|> bList <|> bString <|> bInt@@ -140,7 +143,7 @@ bShow' b = case b of BInt i -> sc 'i' . shows i . sc 'e'- BString s -> sString (BS.unpack s) (BS.length s)+ BString s -> sString (L.unpack s) (L.length s) BList bl -> sc 'l' . sList bl . sc 'e' BDict bd -> sc 'd' . sDict bd . sc 'e' @@ -151,10 +154,10 @@ endTag = BS.pack "e" listTag = BS.pack "l" dictTag = BS.pack "d"- sString s r = BS.pack (show (BS.length s)) : colonTag : s : r+ sString s r = BS.pack (show (L.length s)) : colonTag : L.toChunks s ++ r bPack' (BInt i) r = intTag : BS.pack (show i) : endTag : r bPack' (BString s) r = sString s r bPack' (BList bl) r = listTag : foldr bPack' (endTag : r) bl- bPack' (BDict bd) r = dictTag : foldr (\(k,v) -> sString (BS.pack k) . bPack' v) (endTag : r) (Map.toAscList bd)+ bPack' (BDict bd) r = dictTag : foldr (\(k,v) -> sString (L.pack k) . bPack' v) (endTag : r) (Map.toAscList bd) --check be = bShow be "" == L.unpack (bPack be)
src/Data/BEncode/Lexer.hs view
@@ -3,14 +3,12 @@ import Data.Char import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.ByteString.Char8 as BS-import Data.ByteString (ByteString) data Token = TDict | TList | TInt- | TString ByteString+ | TString L.ByteString | TNumber Int | TEnd deriving (Show,Eq)@@ -34,7 +32,7 @@ then [TNumber number] else case L.head rest' of ':' -> let (str, rest'') = L.splitAt (fromIntegral number) (L.tail rest')- in TString (BS.concat $ L.toChunks str) : lexer rest''+ in TString str : lexer rest'' _ -> TNumber number : lexer rest' | otherwise -> error "Lexer error." where ch = L.head fs
src/Data/BEncode/Parser.hs view
@@ -44,12 +44,19 @@ import Data.BEncode import qualified Data.Map as Map-import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as L import Control.Monad data BParser a = BParser (BEncode -> Reply a) +instance MonadPlus BParser where+ mzero = BParser $ \_ -> Error "mzero"+ mplus (BParser a) (BParser b) = BParser $ \st -> case a st of+ Error _err -> b st+ ok -> ok+ + runB :: BParser a -> BEncode -> Reply a runB (BParser b) = b @@ -64,11 +71,12 @@ return val = BParser $ Ok val fail str = BParser $ \_ -> Error str +instance Functor BParser where+ fmap fn p = do a <- p+ return (fn a)+ (<|>) :: BParser a -> BParser a -> BParser a-(BParser b1) <|> (BParser b2)- = BParser $ \b -> case b1 b of- Ok a b' -> Ok a b'- _ -> b2 b+a <|> b = a `mplus` b runParser :: BParser a -> BEncode -> Either String a runParser parser b = case runB parser b of@@ -101,10 +109,10 @@ bstring :: BParser BEncode -> BParser String bstring p = do b <- p case b of- BString str -> return (BS.unpack str)+ BString str -> return (L.unpack str) _ -> fail $ "Expected BString, found: " ++ show b -bbytestring :: BParser BEncode -> BParser BS.ByteString+bbytestring :: BParser BEncode -> BParser L.ByteString bbytestring p = do b <- p case b of BString str -> return str