sexpr 0.1.1 → 0.1.2

raw patch · 4 files changed

+234/−55 lines, 4 filesdep +binarydep +bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: binary, bytestring

API changes (from Hackage documentation)

Files

• Codec/Sexpr.hs +83/−10
• Codec/Sexpr/Parser.hs +74/−36
• Codec/Sexpr/Printer.hs +75/−7
• sexpr.cabal +2/−2

@@ -1,50 +1,123 @@-module Codec.Sexpr (Sexpr,-                    atom,-                    hintedAtom,-                    list,+-- |A Sexpr is an S-expressionin the style of Rivest's Canonical+-- S-expressions.  Atoms may be of any type, but String and+-- ByteString have special support.  Rivest's implementation of+-- S-expressions is unusual in supporting MIME type hints for each+-- atom.  See http://people.csail.mit.edu/rivest/Sexp.txt++module Codec.Sexpr (-- * Basics+                    Sexpr,                     isAtom,                     isList,-                    hint,-                    defaultHint,+                    atom,+                    list,                     unAtom,                     unList,+                    -- * Hinted Atoms+                    hintedAtom,+                    hint,+                    defaultHint,+                    -- * Character predicates to support encoding                     isTokenChar,isInitialTokenChar,isQuoteableChar                    ) where +import Control.Applicative import Data.Char+import qualified Data.Foldable as F+import Data.Traversable -data Sexpr = Atom String-           | HintedAtom String String-           | List [Sexpr] +data Sexpr s = Atom s+             | HintedAtom String s+             | List [Sexpr s]  -instance Eq Sexpr where+instance Eq s => Eq (Sexpr s) where     (List a) == (List b) = and $ zipWith (==) a b     a == b = unAtom a == unAtom b && hint a == hint b +-- |The 'Functor' instance maps over the underlying atomic contents of+-- the S-expression.  It does not map only over the top-level list,+-- but over the fringe.+instance Functor Sexpr where+    fmap f (Atom s) = Atom (f s)+    fmap f (HintedAtom h s) = HintedAtom h (f s)+    fmap f (List ss) = List $ map (fmap f) ss++instance F.Foldable Sexpr where+    foldMap f (Atom s) = f s+    foldMap f (HintedAtom h s) = f s+    foldMap f (List ss) = F.foldMap (F.foldMap f) ss++instance Traversable Sexpr where+    traverse f (Atom s) = Atom <$> f s+    traverse f (HintedAtom h s) = HintedAtom h <$> f s+    traverse f (List ss) = List <$> traverse (traverse f) ss++-- |@fold f s@ applies f to each sub-S-expression of s, from each leaf+-- to the root.  @f@ need not preserve the shape of @s@, in contrast+-- to the shape-preserving @Traversable@ instance.+fold :: (Sexpr t -> Sexpr t) -> Sexpr t -> Sexpr t+fold f z@(Atom s) = f z+fold f z@(HintedAtom h s) = f z+fold f   (List ss) = f . List $ map (fold f) ss++-- |Any atom whose hint is not specified is assumed to be +-- "text/plain; charset=iso-8859-1".  This is that default value.+defaultHint :: String defaultHint = "text/plain; charset=iso-8859-1" +-- |Construct an atom.+atom :: a -> Sexpr a atom s = Atom s++-- |Construct a list.+list :: [Sexpr a] -> Sexpr a list xs = List xs++-- |Construct an atom with a MIME type hint.+-- @'hintedAtom' 'defaultHint' == 'atom'@+hintedAtom :: String -> a -> Sexpr a hintedAtom h s | h == defaultHint = Atom s hintedAtom h s = HintedAtom h s +-- |A predicate for recognizing lists.+isList :: Sexpr a -> Bool isList (List _) = True isList _ = False +-- |A predicate for identifying atoms, whether or not they have+-- explicit hints.+isAtom :: Sexpr a -> Bool isAtom (List _) = False isAtom _ = True +-- |Extract the hint of an atom.  Lists do not have hints, but all+-- atoms have hints.+hint :: Sexpr a -> Maybe String hint (Atom s) = Just defaultHint hint (HintedAtom h s) = Just h hint _ = Nothing +-- |Extract the content of an atom, discarding any MIME type hint.+unAtom :: Sexpr s -> s unAtom (Atom s) = s unAtom (HintedAtom h s) = s +-- |Extract the sub-S-expressions of a List.  If all you intend to do+-- is traverse or map over that list, the Functor instance of+-- S-expressions may work just fine.+unList :: Sexpr s -> [Sexpr s] unList (List xs) = xs +-- |Tokens may begin with any alphabetic character or the characters+-- in @"-./_:*+="@ ;+isInitialTokenChar :: Char -> Bool isInitialTokenChar x = isAlpha x || x `elem` "-./_:*+=" +-- |Tokens may internally contain any of the characters legitimate to+-- begin tokens, or any numeral.+isTokenChar :: Char -> Bool isTokenChar x = isAlphaNum x || x `elem` "-./_:*+=" +-- |Only token characters and spaces don't need to be escaped when+-- shown in the "quoted" syntax.+isQuoteableChar :: Char -> Bool isQuoteableChar x = isTokenChar x || isSpace x

@@ -1,62 +1,100 @@+-- |All present parsers work on Strings, one character at a time.  The canonical encoding is clearly susceptible to efficient parsing as a Lazy ByteString.+-- +-- This package also includes the Read instance for Sexprs.+-- +-- From Rivest's documentation:+-- +-- > <sexpr>    	:: <string> | <list>+-- > <string>   	:: <display>? <simple-string> ;+-- > <simple-string>	:: <raw> | <token> | <base-64> | <hexadecimal> | +-- > 		           <quoted-string> ;+-- > <display>  	:: "[" <simple-string> "]" ;+-- > <raw>      	:: <decimal> ":" <bytes> ;+-- > <decimal>  	:: <decimal-digit>+ ;+-- > 		-- decimal numbers should have no unnecessary leading zeros+-- > <bytes> 	-- any string of bytes, of the indicated length+-- > <token>    	:: <tokenchar>+ ;+-- > <base-64>  	:: <decimal>? "|" ( <base-64-char> | <whitespace> )* "|" ;+-- > <hexadecimal>      :: "#" ( <hex-digit> | <white-space> )* "#" ;+-- > <quoted-string>    :: <decimal>? <quoted-string-body>  +-- > <quoted-string-body> :: "\"" <bytes> "\""+-- > <list>     	:: "(" ( <sexp> | <whitespace> )* ")" ;+-- > <whitespace> 	:: <whitespace-char>* ;+-- > <token-char>  	:: <alpha> | <decimal-digit> | <simple-punc> ;+-- > <alpha>       	:: <upper-case> | <lower-case> | <digit> ;+-- > <lower-case>  	:: "a" | ... | "z" ;+-- > <upper-case>  	:: "A" | ... | "Z" ;+-- > <decimal-digit>    :: "0" | ... | "9" ;+-- > <hex-digit>        :: <decimal-digit> | "A" | ... | "F" | "a" | ... | "f" ;+-- > <simple-punc> 	:: "-" | "." | "/" | "_" | ":" | "*" | "+" | "=" ;+-- > <whitespace-char>  :: " " | "\t" | "\r" | "\n" ;+-- > <base-64-char> 	:: <alpha> | <decimal-digit> | "+" | "/" | "=" ;+-- > <null>        	:: "" ;+ module Codec.Sexpr.Parser (readSexpr,+                           readSexprString,                            sexpr,                            canonicalSexpr) where  import Codec.Sexpr +-- import Data.Binary.Get+-- import Data.ByteString+ import Data.Char import Text.ParserCombinators.ReadP import qualified Codec.Binary.Base64.String as B64 -{--From Rivest's documentation: -<sexpr>    	:: <string> | <list>-<string>   	:: <display>? <simple-string> ;-<simple-string>	:: <raw> | <token> | <base-64> | <hexadecimal> | -		           <quoted-string> ;-<display>  	:: "[" <simple-string> "]" ;-<raw>      	:: <decimal> ":" <bytes> ;-<decimal>  	:: <decimal-digit>+ ;-		-- decimal numbers should have no unnecessary leading zeros-<bytes> 	-- any string of bytes, of the indicated length-<token>    	:: <tokenchar>+ ;-<base-64>  	:: <decimal>? "|" ( <base-64-char> | <whitespace> )* "|" ;-<hexadecimal>   :: "#" ( <hex-digit> | <white-space> )* "#" ;-<quoted-string> :: <decimal>? <quoted-string-body>  -<quoted-string-body> :: "\"" <bytes> "\""-<list>     	:: "(" ( <sexp> | <whitespace> )* ")" ;-<whitespace> 	:: <whitespace-char>* ;-<token-char>  	:: <alpha> | <decimal-digit> | <simple-punc> ;-<alpha>       	:: <upper-case> | <lower-case> | <digit> ;-<lower-case>  	:: "a" | ... | "z" ;-<upper-case>  	:: "A" | ... | "Z" ;-<decimal-digit> :: "0" | ... | "9" ;-<hex-digit>     :: <decimal-digit> | "A" | ... | "F" | "a" | ... | "f" ;-<simple-punc> 	:: "-" | "." | "/" | "_" | ":" | "*" | "+" | "=" ;-<whitespace-char> :: " " | "\t" | "\r" | "\n" ;-<base-64-char> 	:: <alpha> | <decimal-digit> | "+" | "/" | "=" ;-<null>        	:: "" ;--}+instance Read s => Read (Sexpr s) where+    readsPrec n s = map (\(a,b) -> (fmap read a, b)) s'+        where +          s' = readP_to_S sexpr s :: [(Sexpr String,String)] -instance Read Sexpr where-    readsPrec n = readP_to_S sexpr+-- |Read a @'Sexpr' 'String'@ in any encoding: Canonical, Basic, or Advanced.+readSexprString :: String -> Sexpr String+readSexprString s = fst . head $ readP_to_S sexpr s -readSexpr s = fst . head $ readP_to_S sexpr s+-- |Read a @'Sexpr' a@ using the 'Read' instance for @a@.  The Sexpr+-- may be in any encoding: Canonical, Basic, or Advanced.+readSexpr :: Read a => String -> Sexpr a+readSexpr = fmap read . readSexprString +-- |Parser for @'Sexpr' 'String'@s suitable for embedding in other +-- @ReadP@ parsers.+sexpr :: ReadP (Sexpr String) sexpr = do   skipSpaces   s <- canonicalSexpr   skipSpaces   return s -canonicalSexpr :: ReadP Sexpr+{-+getCanonicalAtom :: Get (Sexpr ByteString)+getCanonicalAtom = do+  l <- getDecimal+  skip 1 -- ':'+  s <- getLazyByteString l -- FIXME doesn't handle hints+  return $ atom s++getCanonicalList :: Get S+getCanonicalList = do+  skip 1 -- '('+  -- FIXME mostly missing+-}++-- |For some applications it is wise to accept only very carefully+-- specified input.  This is useful when you know you are receiving+-- exactly a Canonical S-Expression.  It will read only a Canonical+-- S-expression (and optional terminating NUL), but not the Basic or+-- Advanced encodings.+canonicalSexpr :: ReadP (Sexpr String) canonicalSexpr = do   s <- atomR <++ listR <++ basicTransport   optional $ char '\NUL'   return s -basicTransport :: ReadP Sexpr+basicTransport :: ReadP (Sexpr String) basicTransport = do   b64Octets <- between (char '{') (char '}') $ many1 b64char   let parses = readP_to_S sexpr $ B64.decode b64Octets@@ -68,12 +106,12 @@ hexchar = satisfy isHexDigit hexchar' = skipSpaces >> hexchar -listR :: ReadP Sexpr+listR :: ReadP (Sexpr String) listR = do   l <- between (char '(') (char ')') $ many sexpr   return $ list l -atomR :: ReadP Sexpr+atomR :: ReadP (Sexpr String) atomR = unhinted +++ hinted   where      unhinted = simpleString >>= (return . atom)

@@ -1,23 +1,55 @@-module Codec.Sexpr.Printer (canonical, canonicalString,-                            basic, basicString,-                            advanced, advancedString+{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}++-- | Export S-expressions in any of the three ordinary forms: +-- +-- * Canonical, where a different string implies a different meaning+-- +-- * Basic, suitable for transport over 7-bit and awkward media+-- +-- * Advanced, a human-readable pretty-printed encoding.+-- +-- The @-> 'String'@ functions are probably what you want unless you+-- know you want something else.+-- +-- The 'Show' instance for Sexpr is provided here, using+-- advancedString and the underlying Show instance.  Overlapping+-- instances are used to provide a nice show for @'Sexpr' 'String'@.++module Codec.Sexpr.Printer (-- * String printers+                            canonicalString,+                            basicString,+                            advancedString,+                            -- * ShowS printers+                            canonical,+                            -- * Doc pretty printers+                            basic, +                            advanced, +                            -- * Put binary printers+                            putCanonical, putCanonicalBS                            ) where  import Codec.Sexpr +import Data.Binary.Put+import qualified Data.ByteString.Char8 as B+ import Data.Char import Data.Maybe import Text.PrettyPrint import qualified Codec.Binary.Base64.String as B64 -instance Show Sexpr where+instance Show (Sexpr String) where     show s = advancedString s +instance Show s => Show (Sexpr s) where+    show s = advancedString $ fmap show s+ raw s = shows (length s) . showString ":" . showString s +canonicalString :: Sexpr String -> String canonicalString s = canonical s "" -canonical :: Sexpr -> ShowS+canonical :: Sexpr String -> ShowS canonical s | isAtom s && hint s == Just defaultHint = raw $ unAtom s canonical s | isAtom s = showString "["                           . raw (fromJust $ hint s)@@ -27,13 +59,48 @@                  . showString (foldr (.) id (map canonical $ unList s) $ "")                  . showString ")" +putRaw :: String -> Put+putRaw s = do+  putByteString . B.pack . show $ length s+  putChar' ':'+  putByteString (B.pack s)++putRawBS :: B.ByteString -> Put+putRawBS s = do+  putByteString . B.pack . show $ B.length s+  putChar' ':'+  putByteString s++putChar' = putWord8 . fromIntegral . ord++putCanonical :: Sexpr String -> Put+putCanonical = putCanonicalHelper putRaw++putCanonicalBS :: Sexpr B.ByteString -> Put+putCanonicalBS = putCanonicalHelper putRawBS++putCanonicalHelper :: (a -> Put) -> Sexpr a -> Put+putCanonicalHelper putRaw' s | isAtom s && hint s == +                               Just defaultHint = putRaw' $ unAtom s+putCanonicalHelper putRaw' s | isAtom s = do+  putChar' '['+  putRaw (fromJust $ hint s)+  putChar' ']'+  putRaw' (unAtom s)+putCanonicalHelper putRaw' s | isList s = do+  putChar' '('+  mapM_ (putCanonicalHelper putRaw') $ unList s+  putChar' ')'++basicString :: Sexpr String -> String basicString s = render $ basic s -basic :: Sexpr -> Doc+basic :: Sexpr String -> Doc basic s = braces . hcat $ map char . B64.encode $ canonical s "" -- FIXME should basic add and encode a NUL terminator?--- FIXMIE We parse it out in canonical---should canonical encodings end with a NUL? +-- FIXME We parse it out in canonical---should canonical encodings end with a NUL?  +advancedString :: Sexpr String -> String advancedString s = render $ advanced s  @@ -59,6 +126,7 @@  base64 s = (char '|') <> hcat (map char $ B64.encode s) <> (char '|') +advanced :: Sexpr String -> Doc advanced s | isAtom s && hint s == Just defaultHint = format $ unAtom s advanced s | isAtom s = brackets (format $ fromJust $ hint s)                          <> (format $ unAtom s) 

@@ -1,5 +1,5 @@ Name:                sexpr-Version:             0.1.1+Version:             0.1.2 Cabal-Version:	     >= 1.2 Synopsis:            S-expression printer and parser  Description:         Parser and printer for S-expressions, including Ron @@ -14,6 +14,6 @@ Build-type: 	     Simple  Library-    Build-Depends: base, base64-string, pretty+    Build-Depends: base, base64-string, pretty, bytestring, binary     Exposed-modules: Codec.Sexpr, Codec.Sexpr.Parser, Codec.Sexpr.Printer