diff --git a/Codec/Sexpr.hs b/Codec/Sexpr.hs
--- a/Codec/Sexpr.hs
+++ b/Codec/Sexpr.hs
@@ -5,119 +5,40 @@
 -- atom.  See http://people.csail.mit.edu/rivest/Sexp.txt
 
 module Codec.Sexpr (-- * Basics
-                    Sexpr,
-                    isAtom,
-                    isList,
-                    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 s = Atom s
-             | HintedAtom String s
-             | List [Sexpr s] 
-
-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` "-./_:*+="
+                             Sexpr,
+                             isAtom,
+                             isList,
+                             atom,
+                             list,
+                             unAtom,
+                             unList,
+                             -- * Hinted Atoms
+                             hintedAtom,
+                             hint,
+                             defaultHint,
+                             -- * Character predicates to support encoding
+                             isTokenChar,isInitialTokenChar,isQuoteableChar,
+                             -- * Transformations
+                             fold,
+                             -- * String printers
+                             canonicalString,
+                             basicString,
+                             advancedString,
+                             -- * ShowS printers
+                             canonical,
+                             -- * Doc pretty printers
+                             basic,
+                             advanced,
+                             -- * Put binary printers
+                             putCanonical, putCanonicalBS,
+                             -- * Parsers
+                             readSexpr,
+                             readSexprString,
+                             readCanonicalSexprString,
+                             advancedSexpr,
+                             canonicalSexpr
+                             ) where
 
--- |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
+import Codec.Sexpr.Internal
+import Codec.Sexpr.Parser
+import Codec.Sexpr.Printer
diff --git a/Codec/Sexpr/Internal.hs b/Codec/Sexpr/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Codec/Sexpr/Internal.hs
@@ -0,0 +1,142 @@
+-- |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.Internal (-- * Basics
+                             Sexpr,
+                             isAtom,
+                             isList,
+                             atom,
+                             list,
+                             unAtom,
+                             unList,
+                             -- * Hinted Atoms
+                             hintedAtom,
+                             hint,
+                             defaultHint,
+                             -- * Character predicates to support encoding
+                             isTokenChar,isInitialTokenChar,isQuoteableChar,
+                             -- * Transformations
+                             fold
+                            ) where
+
+import Control.Applicative
+import Data.Char
+import qualified Data.Foldable as F
+import Data.Traversable
+import Test.QuickCheck
+import Data.Monoid()
+
+data Sexpr s = Atom s
+             | HintedAtom String s
+             | List [Sexpr s] 
+
+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 _ 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
+
+instance Arbitrary a => Arbitrary (Sexpr a) where
+    arbitrary = sized arbSexpr
+        where 
+          arbSexpr 0 = oneof [Atom <$> arbitrary,
+                              return $ List []]
+          arbSexpr n = oneof [Atom <$> arbitrary,
+                              List <$> (resize (n `div` 2) arbitrary)]
+    coarbitrary (Atom s) = variant 0 . coarbitrary s
+    coarbitrary (HintedAtom h s) = variant 1 . coarbitrary_h . coarbitrary s
+        where coarbitrary_h = 
+                foldr (\a b -> variant (ord a) . variant 1 . b) (variant 0) h
+    coarbitrary (List ss) = variant 2 . coarbitrary 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 _) = f z
+fold f z@(HintedAtom _ _) = 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 _) = Just defaultHint
+hint (HintedAtom h _) = 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 _ s) = s
+unAtom _ = error "unAtom called on a non-atom"
+
+-- |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
+unList _ = error "unList called on a non-list"
+
+-- |Tokens may begin with any alphabetic character or the characters
+-- in @"-./_:*+="@ ;
+isInitialTokenChar :: Char -> Bool
+isInitialTokenChar x = (isAlpha x || x `elem` "-./_:*+=") && (128 > ord x)
+
+-- |Tokens may internally contain any of the characters legitimate to
+-- begin tokens, or any numeral.
+isTokenChar :: Char -> Bool
+isTokenChar x = (isAlphaNum x || x `elem` "-./_:*+=") && (128 > ord x)
+
+-- |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
diff --git a/Codec/Sexpr/Parser.hs b/Codec/Sexpr/Parser.hs
--- a/Codec/Sexpr/Parser.hs
+++ b/Codec/Sexpr/Parser.hs
@@ -31,12 +31,10 @@
 -- > <base-64-char> 	:: <alpha> | <decimal-digit> | "+" | "/" | "=" ;
 -- > <null>        	:: "" ;
 
-module Codec.Sexpr.Parser (readSexpr,
-                           readSexprString,
-                           sexpr,
-                           canonicalSexpr) where
+module Codec.Sexpr.Parser where
 
-import Codec.Sexpr
+import Codec.Sexpr.Internal
+import Control.Monad
 
 -- import Data.Binary.Get
 -- import Data.ByteString
@@ -47,14 +45,24 @@
 
 
 instance Read s => Read (Sexpr s) where
-    readsPrec n s = map (\(a,b) -> (fmap read a, b)) s'
+    readsPrec _ s = map (\(a,b) -> (fmap read a, b)) s'
         where 
-          s' = readP_to_S sexpr s :: [(Sexpr String,String)]
+          s' = readP_to_S advancedSexpr s :: [(Sexpr String,String)]
 
 -- |Read a @'Sexpr' 'String'@ in any encoding: Canonical, Basic, or Advanced.
 readSexprString :: String -> Sexpr String
-readSexprString s = fst . head $ readP_to_S sexpr s
+readSexprString s = case readP_to_S advancedSexpr s of
+                      [] -> error $ "Cannot parse sexpr from: " ++ s ++ "."
+                      s' -> fst $ head s'
 
+-- |Read a @'Sexpr' 'String'@ in canonical encoding.
+readCanonicalSexprString :: String -> Sexpr String
+readCanonicalSexprString s = case readP_to_S canonicalSexpr s of
+                      [] -> error 
+                            $ "Cannot parse canonical sexpr from: " ++ s ++ "."
+                      s' -> fst $ head 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
@@ -62,11 +70,10 @@
 
 -- |Parser for @'Sexpr' 'String'@s suitable for embedding in other 
 -- @ReadP@ parsers.
-sexpr :: ReadP (Sexpr String)
-sexpr = do
-  skipSpaces
-  s <- canonicalSexpr
-  skipSpaces
+sexpr :: Bool -> ReadP (Sexpr String)
+sexpr b = do
+  s <- (internalSexpr b)
+  when b skipSpaces
   return s
 
 {-
@@ -89,55 +96,77 @@
 -- S-expression (and optional terminating NUL), but not the Basic or
 -- Advanced encodings.
 canonicalSexpr :: ReadP (Sexpr String)
-canonicalSexpr = do
-  s <- atomR <++ listR <++ basicTransport
+canonicalSexpr = sexpr False
+
+advancedSexpr :: ReadP (Sexpr String)
+advancedSexpr = sexpr True
+
+internalSexpr :: Bool -> ReadP (Sexpr String)
+internalSexpr b = do
+  s <- atomR b <++ listR b <++ basicTransport b
   optional $ char '\NUL'
   return s
 
-basicTransport :: ReadP (Sexpr String)
-basicTransport = do
-  b64Octets <- between (char '{') (char '}') $ many1 b64char
-  let parses = readP_to_S sexpr $ B64.decode b64Octets
+basicTransport :: Bool -> ReadP (Sexpr String)
+basicTransport b = do
+  when b skipSpaces
+  b64Octets <- between (char '{') (char '}') $ many b64char
+  let parses = readP_to_S (sexpr b) $ B64.decode b64Octets
   choice $ map (return.fst) $ filter ((=="") . snd) parses
 
+b64char :: ReadP Char
 b64char = satisfy (\x -> isAlphaNum x || x `elem` "+/=")
+
+b64char' :: ReadP Char
 b64char' = skipSpaces >> b64char
 
+hexchar :: ReadP Char
 hexchar = satisfy isHexDigit
+
+hexchar' :: ReadP Char
 hexchar' = skipSpaces >> hexchar
 
-listR :: ReadP (Sexpr String)
-listR = do
-  l <- between (char '(') (char ')') $ many sexpr
+listR :: Bool -> ReadP (Sexpr String)
+listR b = do
+  when b skipSpaces
+  l <- between (char '(') ((when b skipSpaces) >> char ')') $ many (sexpr b)
   return $ list l
 
-atomR :: ReadP (Sexpr String)
-atomR = unhinted +++ hinted
+atomR :: Bool -> ReadP (Sexpr String)
+atomR b = unhinted +++ hinted
   where 
-    unhinted = simpleString >>= (return . atom)
+    unhinted = simpleString b >>= (return . atom)
     hinted = do
-      hint <- between (char '[' >> skipSpaces) 
-                      (skipSpaces >> char ']') 
-                      simpleString
-      value <- simpleString
-      return $ hintedAtom hint value
+      when b skipSpaces
+      h <- between (char '[' >> skipSpaces) 
+                   (skipSpaces >> char ']') 
+                   (simpleString b)
+      v <- simpleString b
+      return $ hintedAtom h v
       
-simpleString :: ReadP String
-simpleString = raw +++ token +++ b64Atom +++ hexAtom +++ quotedString
+simpleString :: Bool -> ReadP String
+simpleString False = raw
+simpleString True =
+  skipSpaces >> (raw +++ token +++ b64Atom +++ hexAtom +++ quotedString)
 
+quotedString :: ReadP String
 quotedString = withLength +++ withoutLength
   where
     withLength = do
       l <- decimal
       c <- between (char '"') (char '"') (many get)
-      let s = read ('"':c ++ "\"")
-      if (l == length s)
-       then return s
-       else fail "length error"              
+      readString c (\s -> if (l == length s)
+                             then return s
+                             else fail "length error")
     withoutLength = do
                  c <- between (char '"') (char '"') (many get)
-                 return $ read ('"':c ++ "\"")
+                 readString c (\s -> return s)
+    readString c f = case filter (\x -> "" == snd x) $ reads ('"':c ++ "\"") of
+        (s,""):_ -> f s
+        _ -> pfail
 
+
+hexAtom :: ReadP String
 hexAtom = do
   s <- withLength +++ withoutLength
   return $ hexDecode s
@@ -147,9 +176,12 @@
             between (char '#') (char '#') (count (2*l) hexchar')
       withoutLength = between (char '#') (char '#') (many1 hexchar')
 
+hexDecode :: String -> String
 hexDecode [] = ""
+hexDecode [o] = [chr $ digitToInt o]
 hexDecode (h:o:cs) = chr (16*digitToInt h + digitToInt o) : (hexDecode cs)
 
+b64Atom :: ReadP String
 b64Atom = do
   s <- withLength +++ withoutLength
   return $ B64.decode s
@@ -158,9 +190,11 @@
       l <- decimal
       between (char '|') (char '|') (count (b64length l) b64char')
     withoutLength = 
-      between (char '|') (char '|') (many1 b64char')
-    b64length l = 4 * (ceiling (fromIntegral l / 3))
+      between (char '|') (char '|') (many b64char')
+    b64length l = -4 * (l `div` (-3))
+                  -- === 4 * (ceiling (fromIntegral l / 3)), without Double
 
+token :: ReadP String
 token = do
   c <- satisfy isInitialTokenChar
   cs <- munch isTokenChar
@@ -168,9 +202,9 @@
 
 raw :: ReadP String
 raw = do
-  length <- decimal
+  len <- decimal
   char ':'
-  count length get
+  count len get
 
 decimal :: ReadP Int
 decimal = do
diff --git a/Codec/Sexpr/Printer.hs b/Codec/Sexpr/Printer.hs
--- a/Codec/Sexpr/Printer.hs
+++ b/Codec/Sexpr/Printer.hs
@@ -15,20 +15,9 @@
 -- 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
+module Codec.Sexpr.Printer where
 
-import Codec.Sexpr
+import Codec.Sexpr.Internal
 
 import Data.Binary.Put
 import qualified Data.ByteString.Char8 as B
@@ -44,6 +33,7 @@
 instance Show s => Show (Sexpr s) where
     show s = advancedString $ fmap show s
 
+raw :: String -> String -> String
 raw s = shows (length s) . showString ":" . showString s
 
 canonicalString :: Sexpr String -> String
@@ -55,7 +45,7 @@
                          . raw (fromJust $ hint s)
                          . showString "]"
                          . raw (unAtom s)
-canonical s | isList s = showString "("
+canonical s | otherwise = showString "("
                  . showString (foldr (.) id (map canonical $ unList s) $ "")
                  . showString ")"
 
@@ -71,6 +61,7 @@
   putChar' ':'
   putByteString s
 
+putChar' :: Char -> Put
 putChar' = putWord8 . fromIntegral . ord
 
 putCanonical :: Sexpr String -> Put
@@ -87,7 +78,7 @@
   putRaw (fromJust $ hint s)
   putChar' ']'
   putRaw' (unAtom s)
-putCanonicalHelper putRaw' s | isList s = do
+putCanonicalHelper putRaw' s | otherwise = do
   putChar' '('
   mapM_ (putCanonicalHelper putRaw') $ unList s
   putChar' ')'
@@ -103,31 +94,39 @@
 advancedString :: Sexpr String -> String
 advancedString s = render $ advanced s
 
-
+format :: String -> Doc
 format s | canToken s = text s
          | canQuote s = quote s
          | canHex s = hex s
          | otherwise = base64 s
 
+canToken :: String -> Bool
 canToken (x:xs) = isInitialTokenChar x && all isTokenChar xs
+canToken [] = False
 
+canQuote :: String -> Bool
 canQuote s = all isQuoteableChar s
-             || fromIntegral (length (show s)) <= 1.1 * fromIntegral (length s)
+             || fromIntegral (length (show s)) * 10 <= (length s) * 11
 
+canHex :: String -> Bool
 canHex s = length s `elem` [1,2,3,4,8,16,20]
 
+hex :: String -> Doc
 hex s = text (show $ length s) <> (char '#') <> hcat (map (text . hexEncode) s) <> (char '#')
 
+hexEncode :: Char -> String
 hexEncode x = (intToDigit h) : (intToDigit o) : []
     where 
       (h,o) = quotRem (ord x) 16
 
+quote :: Show a => a -> Doc
 quote s = text $ show s
 
+base64 :: String -> Doc
 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) 
-advanced s | isList s = parens $ sep (map advanced $ unList s)
+advanced s | otherwise = parens $ sep (map advanced $ unList s)
diff --git a/Codec/Sexpr/Tests.hs b/Codec/Sexpr/Tests.hs
new file mode 100644
--- /dev/null
+++ b/Codec/Sexpr/Tests.hs
@@ -0,0 +1,170 @@
+module Main where
+
+import Codec.Sexpr
+import Codec.Sexpr.Parser
+import Codec.Sexpr.Printer
+import Test.QuickCheck
+import Data.Monoid()
+import Text.Show.Functions()
+import qualified Data.Traversable as T
+import qualified Data.Foldable as F
+import Data.Char
+import Data.Binary.Put
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy.Char8 as L
+import Text.PrettyPrint (render)
+
+import Text.Printf
+import Control.Monad
+import System.Environment
+import System.Random
+import System.IO
+import Data.List
+
+prop_atoms :: Int -> Bool
+prop_atoms n = n == (unAtom $ atom n)
+
+prop_foldMap :: (Int -> [Int]) -> Sexpr Int -> Bool
+prop_foldMap f s = T.foldMapDefault f s == F.foldMap f s
+
+prop_fmap :: (Int -> Int) -> Sexpr Int -> Bool
+prop_fmap f s = T.fmapDefault f s == fmap f s
+
+prop_readshow :: Sexpr Int -> Bool
+prop_readshow s = (read . show $ s) == s
+
+prop_readshowStr :: Sexpr String -> Bool
+prop_readshowStr s = (readSexprString $ advancedString s) == s
+
+prop_canonical_out :: Sexpr String -> Bool
+prop_canonical_out s = (readSexprString $ canonicalString s) == s
+
+prop_canonical_in :: Sexpr String -> Bool
+prop_canonical_in s = (readCanonicalSexprString $ canonicalString s) == s
+
+prop_put_canonical :: Sexpr String -> Bool
+prop_put_canonical s = 
+    (L.unpack . runPut $ putCanonical s) == canonicalString s
+
+prop_put_canonicalBS :: Sexpr B.ByteString -> Bool
+prop_put_canonicalBS s = 
+    (L.unpack . runPut $ putCanonicalBS s) == (canonicalString $ fmap B.unpack s)
+
+prop_atom_raw :: String -> Bool
+prop_atom_raw s = (readSexprString $ Codec.Sexpr.Printer.raw s "") == atom s
+
+prop_atom_token :: String -> Property
+prop_atom_token s = canToken s ==> ((readSexprString s) == atom s)
+
+prop_atom_hex :: String -> Property
+prop_atom_hex s = canHex s ==> ((readSexprString $ render $ hex s) == atom s)
+
+prop_atom_quote :: String -> Property
+prop_atom_quote s = canQuote s ==> ((readSexprString $ render $ quote s) == atom s)
+
+prop_atom_base64 :: String -> Bool
+prop_atom_base64 s = (readSexprString $ render $ base64 s) == atom s 
+
+instance Arbitrary B.ByteString where
+    arbitrary = B.pack `fmap` arbitrary
+    coarbitrary = undefined
+
+instance Arbitrary Char where
+  arbitrary     = choose (32,255) >>= \n -> return (chr n)
+  coarbitrary n = variant (ord n)
+
+
+main :: IO ()
+main = do
+  args <- fmap (drop 1) getArgs
+  let n = if null args then 100 else read (head args)
+  (results, passed) <- 
+       liftM unzip $ mapM (\(s,a) -> printf "%-40s: " s >> a n) tests
+  printf "Passed %d tests!\n" (sum passed)
+  when (not . and $ results) $ fail "Not all tests passed!"
+
+tests :: [(String, Int -> IO (Bool, Int))]
+tests = [("Atom dis/assembly", mytest prop_atoms)
+        ,("foldMap behaves as default", mytest prop_foldMap)
+        ,("fmap behaves as default", mytest prop_fmap)
+        ,("(read.show)==id | Int", mytest prop_readshow)
+        ,("(read.show)==id | String", mytest prop_readshowStr)
+        ,("canonical output", mytest prop_canonical_out)
+        ,("canonical input", mytest prop_canonical_in)
+        ,("efficient bytestring canonical", mytest prop_put_canonical)
+        ,("efficient bytestring canonicalBS", mytest prop_put_canonicalBS)
+        ,("token atom", mytest prop_atom_token)
+        ,("hex atom", mytest prop_atom_hex)
+        ,("quoted atom", mytest prop_atom_quote)
+        ,("raw atom", mytest prop_atom_raw)
+        ,("base64 atom", mytest prop_atom_base64)
+        ]
+
+------------------------------------------------------------------------
+--
+-- QC driver
+-- copied from xmonad 0.8.1
+
+debug :: Bool
+debug = False
+
+mytest :: Testable a => a -> Int -> IO (Bool, Int)
+mytest a n = mycheck defaultConfig
+    { configMaxTest=n
+    , configEvery   = \nu _ -> let s = show nu in s ++ [ '\b' | _ <- s ] } a
+ -- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
+
+mycheck :: Testable a => Config -> a -> IO (Bool, Int)
+mycheck config a = do
+    rnd <- newStdGen
+    mytests config (evaluate a) rnd 0 0 []
+
+mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int)
+mytests config gen rnd0 ntest nfail stamps
+    | ntest == configMaxTest config = done "OK," ntest stamps >> return (True, ntest)
+    | nfail == configMaxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest)
+    | otherwise               =
+      do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
+         case ok result of
+           Nothing    ->
+             mytests config gen rnd1 ntest (nfail+1) stamps
+           Just True  ->
+             mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
+           Just False ->
+             putStr ( "Falsifiable after "
+                   ++ show ntest
+                   ++ " tests:\n"
+                   ++ unlines (arguments result)
+                    ) >> hFlush stdout >> return (False, ntest)
+     where
+      result      = generate (configSize config ntest) rnd2 gen
+      (rnd1,rnd2) = split rnd0
+
+done :: String -> Int -> [[String]] -> IO ()
+done mesg ntest stamps = putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
+  where
+    table = display
+            . map entry
+            . reverse
+            . sort
+            . map pairLength
+            . group
+            . sort
+            . filter (not . null)
+            $ stamps
+
+    display []  = ".\n"
+    display [x] = " (" ++ x ++ ").\n"
+    display xs  = ".\n" ++ unlines (map (++ ".") xs)
+
+    pairLength xss@(xs:_) = (length xss, xs)
+    pairLength [] = (0,undefined)
+    entry (n, xs)         = percentage n ntest
+                       ++ " "
+                       ++ concat (intersperse ", " xs)
+
+    percentage n m        = show ((100 * n) `div` m) ++ "%"
+
+------------------------------------------------------------------------
+
+
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,22 +1,31 @@
-Copyright (c) 2009 Brian Sniffen <bts@evenmere.org>
+(c) 2009 Brian Sniffen
 
-Permission is hereby granted, free of charge, to any person
-obtaining a copy of this software and associated documentation
-files (the "Software"), to deal in the Software without
-restriction, including without limitation the rights to use,
-copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the
-Software is furnished to do so, subject to the following
-conditions:
+All rights reserved.
 
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
 
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
-HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
-WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
-OTHER DEALINGS IN THE SOFTWARE.
+1. Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the author nor the names of his contributors
+may be used to endorse or promote products derived from this software
+without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.
+~                          
diff --git a/sexpr.cabal b/sexpr.cabal
--- a/sexpr.cabal
+++ b/sexpr.cabal
@@ -1,19 +1,35 @@
-Name:                sexpr
-Version:             0.1.2
-Cabal-Version:	     >= 1.2
-Synopsis:            S-expression printer and parser 
-Description:         Parser and printer for S-expressions, including Ron 
+name:                sexpr
+version:             0.2.0
+cabal-version:	     >= 1.2
+synopsis:            S-expression printer and parser 
+description:         Parser and printer for S-expressions, including Ron 
 		     Rivest's Canonical S-expressions.  These are used in 
 		     SDSI and SPKI, and are generally useful for 
 		     cryptographic operations over structured data.
-Category:            Codec
-License:             BSD3
-License-file:        LICENSE
-Author:              Brian Sniffen
-Maintainer:          bts@evenmere.org
-Build-type: 	     Simple
+category:            Codec
+license:             BSD3
+license-file:        LICENSE
+author:              Brian Sniffen
+maintainer:          bts@evenmere.org
+build-type: 	     Simple
 
-Library
+flag testing
+    description: build test executable
+    default: False
+
+library
+    if flag(testing)
+       ghc-options: -Wall
     Build-Depends: base, base64-string, pretty, bytestring, binary
-    Exposed-modules: Codec.Sexpr, Codec.Sexpr.Parser, Codec.Sexpr.Printer
+    Exposed-modules: Codec.Sexpr
 
+executable sexpr-test
+    if !flag(testing)
+        buildable: False
+        ghc-options: -Wall
+    main-is: Codec/Sexpr/Tests.hs
+    other-modules:  Codec.Sexpr
+                    Codec.Sexpr.Parser
+                    Codec.Sexpr.Printer
+                    Codec.Sexpr.Internal
+    build-depends: QuickCheck, random
