bencode (empty) → 0.1
raw patch · 6 files changed
+351/−0 lines, 6 filesdep +basedep +parsecbuild-type:Customsetup-changed
Dependencies added: base, parsec
Files
- LICENSE +35/−0
- Setup.hs +2/−0
- bencode.cabal +18/−0
- src/Data/BEncode.hs +134/−0
- src/Data/BEncode/Lexer.hs +41/−0
- src/Data/BEncode/Parser.hs +121/−0
+ LICENSE view
@@ -0,0 +1,35 @@+Copyright (c) 2005-2007, David Himmelstrup+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++ * Redistributions of source code must retain+ the above copyright notice, this list of+ conditions and the following disclaimer.+ * Redistributions in binary form must reproduce+ the above copyright notice, this list of+ conditions and the following disclaimer in the+ documentation and/or other materials provided+ with the distribution.+ * Neither the name of David Himmelstrup nor the+ names of other contributors may be used to+ endorse or promote products derived from this+ software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ bencode.cabal view
@@ -0,0 +1,18 @@+Name: bencode+Version: 0.1+Maintainer: Lemmih (lemmih@gmail.com)+Author: Lemmih (lemmih@gmail.com), Jesper Louis Andersen+Copyright: 2005-2007, Lemmih+License-File: LICENSE+License: BSD3+Build-Depends: base, parsec+Category: Text+Synopsis: Parser and printer for bencoded data.+Tested-with: GHC ==6.6+Extensions: PatternGuards+Exposed-Modules:+ Data.BEncode+ Data.BEncode.Lexer+ Data.BEncode.Parser+GHC-Options: -Wall -Werror+Hs-Source-Dirs: src
+ src/Data/BEncode.hs view
@@ -0,0 +1,134 @@+{-++ Copyright (c) 2005 Jesper Louis Andersen <jlouis@mongers.org>+ Lemmih <lemmih@gmail.com>++ Permission to use, copy, modify, and distribute this software for any+ purpose with or without fee is hereby granted, provided that the above+ copyright notice and this permission notice appear in all copies.++ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+ WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+ MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.++-}+-----------------------------------------------------------------------------+-- |+-- Module : BEncode+-- Copyright : (c) Jesper Louis Andersen, 2005. (c) Lemmih, 2006+-- License : BSD-style+-- +-- Maintainer : lemmih@gmail.com+-- Stability : believed to be stable+-- Portability : portable+-- +-- Provides a BEncode data type is well as functions for converting this+-- data type to and from a String.+--+-- Also supplies a number of properties which the module must satisfy.+-----------------------------------------------------------------------------+module Data.BEncode+ (+ -- * Data types+ BEncode(..), + -- * Functions+ bRead, + bShow, + )+where++import qualified Data.Map as Map+import Data.Map (Map)+import Text.ParserCombinators.Parsec+import qualified Data.ByteString.Char8 as BS+import Data.ByteString (ByteString)++import Data.BEncode.Lexer ( Token (..), lexer )++type BParser a = GenParser Token () a++{- | The B-coding defines an abstract syntax tree given as a simple+ data type here+-}+data BEncode = BInt Int+ | BString ByteString+ | BList [BEncode]+ | BDict (Map String BEncode)+ deriving (Eq, Ord, Show)++-- Source possition is pretty useless in BEncoded data. FIXME+updatePos :: (SourcePos -> Token -> [Token] -> SourcePos)+updatePos pos _ _ = pos++bToken :: Token -> BParser ()+bToken t = tokenPrim show updatePos fn+ where fn t' | t' == t = Just ()+ fn _ = Nothing++token' :: (Token -> Maybe a) -> BParser a+token' = tokenPrim show updatePos++tnumber :: BParser Int+tnumber = token' fn+ where fn (TNumber i) = Just i+ fn _ = Nothing++tstring :: BParser ByteString+tstring = token' fn+ where fn (TString str) = Just str+ fn _ = Nothing++withToken :: Token -> BParser a -> BParser a+withToken tok+ = between (bToken tok) (bToken TEnd)++--------------------------------------------------------------+--------------------------------------------------------------++bInt :: BParser BEncode+bInt = withToken TInt $ fmap BInt tnumber++bString :: BParser BEncode+bString = fmap BString tstring++bList :: BParser BEncode+bList = withToken TList $ fmap BList (many bParse)++bDict :: BParser BEncode+bDict = withToken TDict $ fmap (BDict . Map.fromAscList) (many1 bAssocList)+ where bAssocList+ = do str <- tstring+ value <- bParse+ return (BS.unpack str,value)++bParse :: BParser BEncode+bParse = bDict <|> bList <|> bString <|> bInt++{- | bRead is a conversion routine. It assumes a B-coded string as input+ and attempts a parse of it into a BEncode data type+-}+bRead :: ByteString -> Maybe BEncode+bRead str = case parse bParse "" (lexer str) of+ Left _err -> Nothing+ Right b -> Just b++-- | Render a BEncode structure to a B-coded string+bShow :: BEncode -> ShowS+bShow be = bShow' be+ where+ sc = showChar+ ss = showString+ sKV (k,v) = sString k (length k) . bShow' v+ sDict dict = foldr (.) id (map sKV (Map.toAscList dict)) + sList list = foldr (.) id (map bShow' list)+ sString str len = shows len . sc ':' . ss str+ bShow' b =+ case b of+ BInt i -> sc 'i' . shows i . sc 'e'+ BString s -> sString (BS.unpack s) (BS.length s)+ BList bl -> sc 'l' . sList bl . sc 'e'+ BDict bd -> sc 'd' . sDict bd . sc 'e'
+ src/Data/BEncode/Lexer.hs view
@@ -0,0 +1,41 @@+module Data.BEncode.Lexer where++import Data.Char++import qualified Data.ByteString.Char8 as BS+import Data.ByteString (ByteString)++data Token+ = TDict+ | TList+ | TInt+ | TString ByteString+ | TNumber Int+ | TEnd+ deriving (Show,Eq)+++lexer :: ByteString -> [Token]+lexer fs | BS.null fs = []+lexer fs+ = case ch of+ 'd' -> TDict : lexer rest+ 'l' -> TList : lexer rest+ 'i' -> TInt : lexer rest+ 'e' -> TEnd : lexer rest+ '-' -> let (digits,rest') = BS.span isDigit rest+ number = read (BS.unpack digits)+ in TNumber (-number) : lexer rest'+ _ | isDigit ch+ -> let (digits,rest') = BS.span isDigit fs+ number = read (BS.unpack digits)+ in if BS.null rest'+ then [TNumber number]+ else case BS.head rest' of+ ':' -> let (str, rest'') = BS.splitAt number (BS.tail rest')+ in TString str : lexer rest''+ _ -> TNumber number : lexer rest'+ | otherwise -> error "Lexer error."+ where ch = BS.head fs+ rest = BS.tail fs+
+ src/Data/BEncode/Parser.hs view
@@ -0,0 +1,121 @@+{-++ Copyright (c) 2005 Lemmih <lemmih@gmail.com>++ Permission to use, copy, modify, and distribute this software for any+ purpose with or without fee is hereby granted, provided that the above+ copyright notice and this permission notice appear in all copies.++ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+ WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+ MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.++-}+-----------------------------------------------------------------------------+-- |+-- Module : BParser+-- Copyright : (c) Lemmih, 2005+-- License : BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer : lemmih@gmail.com+-- Stability : stable+-- Portability : portable+-- +-- A parsec style parser for BEncoded data+-----------------------------------------------------------------------------+module Data.BEncode.Parser+ ( BParser+ , runParser+ , token+ , dict+ , list+ , optional+ , bstring+ , bfaststring+ , bint+ , setInput+ , (<|>)+ ) where+++import Data.BEncode+import qualified Data.Map as Map+import qualified Data.ByteString.Char8 as BS+import Control.Monad++data BParser a+ = BParser (BEncode -> Reply a)++runB :: BParser a -> BEncode -> Reply a+runB (BParser b) = b++data Reply a+ = Ok a BEncode+ | Error String++instance Monad BParser where+ (BParser p) >>= f = BParser $ \b -> case p b of+ Ok a b' -> runB (f a) b'+ Error str -> Error str+ return val = BParser $ Ok val+ fail str = BParser $ \_ -> Error str++(<|>) :: BParser a -> BParser a -> BParser a+(BParser b1) <|> (BParser b2)+ = BParser $ \b -> case b1 b of+ Ok a b' -> Ok a b'+ _ -> b2 b++runParser :: BParser a -> BEncode -> Either String a+runParser parser b = case runB parser b of+ Ok a _ -> Right a+ Error str -> Left str++token :: BParser BEncode+token = BParser $ \b -> Ok b b++dict :: String -> BParser BEncode+dict name = BParser $ \b -> case b of+ BDict bmap | Just code <- Map.lookup name bmap+ -> Ok code b+ BDict _ -> Error $ "Name not found in dictionary: " ++ name+ _ -> Error $ "Not a dictionary: " ++ name++list :: String -> BParser a -> BParser [a]+list name p+ = dict name >>= \lst ->+ BParser $ \b -> case lst of+ BList bs -> foldr cat (Ok [] b) (map (runB p) bs)+ _ -> Error $ "Not a list: " ++ name+ where cat (Ok v _) (Ok vs b) = Ok (v:vs) b+ cat (Ok _ _) (Error str) = Error str+ cat (Error str) _ = Error str++optional :: BParser a -> BParser (Maybe a)+optional p = liftM Just p <|> return Nothing++bstring :: BParser BEncode -> BParser String+bstring p = do b <- p+ case b of+ BString str -> return (BS.unpack str)+ _ -> fail $ "Expected BString, found: " ++ show b++bfaststring :: BParser BEncode -> BParser BS.ByteString+bfaststring p = do b <- p+ case b of+ BString str -> return str+ _ -> fail $ "Expected BString, found: " ++ show b++bint :: BParser BEncode -> BParser Int+bint p = do b <- p+ case b of+ BInt int -> return int+ _ -> fail $ "Expected BInt, found: " ++ show b++setInput :: BEncode -> BParser ()+setInput b = BParser $ \_ -> Ok () b+