diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,46 +1,24 @@
 # Changelog for S-expresso
 
-Version 1.0.0.2
----------------
-
-* Update Resolver
-* Update synopsis
-
-Version 1.0.0.1
----------------
-
-* Add version bounds to the dependencies
-
-Version 1.0.0.0
----------------
-
-* Change type of SExprParser from `SExpParser m c b a` to `SExprParser m
-  b a`. The `c` parameter is now an existential. 
-
-* `SExprParser` is not a record anymore. So `pAtom`, `pSpace` and
-  `pSpacingRule` are now functions and cannot be used in record
-  syntax. The have been rename to `getAtom`, `getSpace` and
-  `getSpacingRule`.
-
-* The `pSTag` and `pETag` functions have been removed since `SExprParser`
-  is defined using an existential.
-  
-* Documentation improvements.
-
-Version 0.1.1.1
+Version 1.1.0.0
 ---------------
 
-* Fix documentation error for the pattern :::
+* Add startPosPretty and endPosPretty function
+* Add Bifunctor, Bifoldable and Bitraversable instances for SExpr
+* Add Base SExpr, Recursive, Corecursive instances (see package recursion-schemes)
+* Add Functor instance for Located
+* Fix SExprPrinter constructor name (SExprParser -> SExprPrinter)
+* Improve documentation
+* Merge [pull request \#6](https://github.com/archambaultv/sexpresso/pull/6) to prepare for MonadFail
+* Fix bug with R5RS negative number (issue \#7 on [github](https://github.com/archambaultv/sexpresso/issues/7))
+* Tested with stack version 14.27 and 15.3
 
-Version 0.1.1.0
+Version 1.0.0.2
 ---------------
 
-* Add Scheme R5RS language
-
-Version 0.1.0.0
---------------- 
-
-* SExpr datatype
+* Initial Hackage Release
+* SExpr datatype for representing S-expression
 * Generic SExpr parser
-* SExpr parser for character
+* Specialized SExpr parser for character
 * SExpr flat printer
+* Scheme R5RS parser implementation
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,3 +1,6 @@
+[![License OBSD](https://img.shields.io/badge/license-0BSD-brightgreen.svg)](https://opensource.org/licenses/0BSD)
+[![Hackage](https://img.shields.io/hackage/v/sexpresso.svg)](http://hackage.haskell.org/package/sexpresso)
+
 # S-expresso
 
 S-expresso is a Haskell library designed to help you parse and print
diff --git a/sexpresso.cabal b/sexpresso.cabal
--- a/sexpresso.cabal
+++ b/sexpresso.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d10313f25fa0bc844633d9e84210f3959d3915bbee2d0c767e121aa3ddd2bd5f
+-- hash: cd4a5d89acd75970af22375142f81c7b7320e72ae7403de680177c6ad12e1116
 
 name:           sexpresso
-version:        1.0.0.2
+version:        1.1.0.0
 synopsis:       A flexible library for parsing and printing S-expression
 description:    Please see the README on GitHub at <https://github.com/archambaultv/sexpresso#readme>
 category:       Data
@@ -44,8 +44,10 @@
   ghc-options: -Wall
   build-depends:
       base >=4.7 && <5
+    , bifunctors >=5.5 && <5.6
     , containers >=0.5 && <0.7
-    , megaparsec >=7.0 && <8.0
+    , megaparsec >=7.0 && <=8.0.0
+    , recursion-schemes >=5.1 && <5.2
     , text >=0.2 && <1.3
   default-language: Haskell2010
 
@@ -63,8 +65,10 @@
   ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , bifunctors >=5.5 && <5.6
     , containers >=0.5 && <0.7
-    , megaparsec >=7.0 && <8.0
+    , megaparsec >=7.0 && <=8.0.0
+    , recursion-schemes >=5.1 && <5.2
     , sexpresso
     , smallcheck >=1.0
     , tasty >=0.8
diff --git a/src/Data/SExpresso/Language/SchemeR5RS.hs b/src/Data/SExpresso/Language/SchemeR5RS.hs
--- a/src/Data/SExpresso/Language/SchemeR5RS.hs
+++ b/src/Data/SExpresso/Language/SchemeR5RS.hs
@@ -1,5 +1,5 @@
 -- |
--- Module      :  Data.SExpresso.SExpr
+-- Module      :  Data.SExpresso.Language.SchemeR5RS
 -- Copyright   :  © 2019 Vincent Archambault
 -- License     :  0BSD
 --
@@ -21,7 +21,7 @@
 -- as defined in section 7 of the report
 -- The library does parse tab and \r\n and whitespace
 module Data.SExpresso.Language.SchemeR5RS (
-  -- * SchemeToken and Datum related data types and functions 
+  -- * SchemeToken and Datum related data types and functions
   SExprType(..),
   SchemeToken(..),
   tokenParser,
@@ -74,6 +74,7 @@
 
   ) where
 
+import Control.Monad (mzero)
 import Data.Maybe
 import Data.Proxy
 import Data.List
@@ -81,6 +82,7 @@
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as L
 import qualified Data.Text.Lazy.Builder as B
+import Data.Foldable
 import Text.Megaparsec
 import Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer as ML
@@ -121,16 +123,17 @@
               -- character must come before number
               (character >>= return . TChar) <|>
               (stringParser >>= return . TString) <|>
+              -- We must try number because it can conflict with
+              -- the dot ex : .2 and (a . b)
+              -- and identifier ex : - and -1
+              (try number >>= return . TNumber) <|>
               (identifier >>= return . TIdentifier) <|>
               (quote >> return TQuote) <|>
               (quasiquote >> return TQuasiquote) <|>
               -- commaAt must come before comma
-              (commaAt >> return TCommaAt) <|> 
+              (commaAt >> return TCommaAt) <|>
               (comma >> return TComma) <|>
-              -- We must try number because it can conflict with the dot ex : .2 and (a . b)
-              (try number >>= return . TNumber) <|>
               (dot >> return TDot)
-              
 
 
 spacingRule :: SchemeToken -> SpacingRule
@@ -191,51 +194,37 @@
 -- 'TComma', 'TCommaAt' and 'TDot' tokens must be followed by another
 -- token.
 sexpr2Datum :: [SExpr SExprType SchemeToken] -> Either String [Datum]
-sexpr2Datum [] = Right []
-sexpr2Datum ((A (TBoolean x)) : xs) = (:) <$> pure (DBoolean x) <*> sexpr2Datum xs
-sexpr2Datum ((A (TNumber x)) : xs) = (:) <$> pure (DNumber x) <*> sexpr2Datum xs
-sexpr2Datum ((A (TChar x)) : xs) = (:) <$> pure (DChar x) <*> sexpr2Datum xs
-sexpr2Datum ((A (TString x)) : xs) = (:) <$> pure (DString x) <*> sexpr2Datum xs
-sexpr2Datum ((A (TIdentifier x)) : xs) = (:) <$> pure (DIdentifier x) <*> sexpr2Datum xs
-sexpr2Datum ((A TQuote) : xs) = do
-  xs' <- sexpr2Datum xs
-  if null xs'
-  then Left "Expecting a datum after the quote."
-  else return $ DQuote (head xs') : tail xs'
-sexpr2Datum ((A TQuasiquote) : xs) = do
-  xs' <- sexpr2Datum xs
-  if null xs'
-  then Left "Expecting a datum after the quasiquote."
-  else return $ DQuasiquote (head xs') : tail xs'
-sexpr2Datum ((A TComma) : xs) = do
-  xs' <- sexpr2Datum xs
-  if null xs'
-  then Left "Expecting a datum after the comma."
-  else return $ DComma (head xs') : tail xs'
-sexpr2Datum ((A TCommaAt) : xs) = do
-  xs' <- sexpr2Datum xs
-  if null xs'
-  then Left "Expecting a datum after the quote."
-  else return $ DCommaAt (head xs') : tail xs'
-sexpr2Datum ((A TDot) : _) = Left "Unexpected dot"
-sexpr2Datum ((SList STVector vs) : xs) = (:) <$> (sexpr2Datum vs >>= return . DVector) <*> sexpr2Datum xs
-sexpr2Datum ((SList STList ls) : xs) = (:) <$> (listToken2Datum ls) <*> sexpr2Datum xs
-  where listToken2Datum ys =
-          let l = length ys
-          in if l < 3
-             then sexpr2Datum ys >>= return . DList
-             else let penultimate = head $ drop (l - 2) ys
-                  in case penultimate of
-                       (A TDot) ->
-                         let last' = head $ drop (l - 1) ys
-                             tokens' = take (l - 2) ys
-                         in do
-                           lastD <- sexpr2Datum [last']
-                           tokensD <- sexpr2Datum tokens'
-                           return $ DDotList tokensD (head lastD) 
-                       _ -> sexpr2Datum ys >>= return . DList
+sexpr2Datum = foldrM vectorFold []
+  where vectorFold :: SExpr SExprType SchemeToken -> [Datum] -> Either String [Datum]
+        vectorFold (SAtom TQuote) [] = Left $ "Expecting a datum after a quote"
+        vectorFold (SAtom TQuote) (x : xs) = pure $ DQuote x : xs
+        vectorFold (SAtom TQuasiquote) [] = Left $ "Expecting a datum after a quasiquote"
+        vectorFold (SAtom TQuasiquote) (x : xs) = pure $ DQuasiquote x : xs
+        vectorFold (SAtom TComma) [] = Left $ "Expecting a datum after a comma"
+        vectorFold (SAtom TComma) (x : xs) = pure $ DComma x : xs
+        vectorFold (SAtom TCommaAt) [] = Left $ "Expecting a datum after a commaAt"
+        vectorFold (SAtom TCommaAt) (x : xs) = pure $ DCommaAt x : xs
+        vectorFold (SAtom TDot) _ = Left "Unexpected dot"
+        vectorFold (SList STVector xs) acc = ((:) . DVector) <$> sexpr2Datum xs <*> pure acc
+        vectorFold (SList STList xs) acc =
+          let chooseConstructor (isDotList, ls) = (:) (if isDotList
+                                                       then DDotList (init ls) (last ls)
+                                                       else DList ls)
+          in chooseConstructor <$> (foldrM listFold (False, []) xs) <*> pure acc
+        vectorFold (SAtom x) acc = pure $ simpleToken x : acc
 
+        simpleToken :: SchemeToken -> Datum
+        simpleToken (TBoolean x) = DBoolean x
+        simpleToken (TNumber x) = DNumber x
+        simpleToken (TChar x) = DChar x
+        simpleToken (TString x) = DString x
+        simpleToken (TIdentifier x) = DIdentifier x
+        simpleToken _ = error "simpleToken only handles a subset of SchemeToken constructors"
 
+        listFold :: SExpr SExprType SchemeToken -> (Bool, [Datum]) -> Either String (Bool, [Datum])
+        listFold (SAtom TDot) (_, [x]) = pure (True, [x])
+        listFold x (d, acc) = (,) d <$> vectorFold x acc
+
 ------------------------- Whitespace and comments -------------------------
 -- | The 'whitespace' parser  parses one space, tab or end of line (\\n and \\r\\n).
 whitespace :: (MonadParsec e s m, Token s ~ Char) => m ()
@@ -435,7 +424,7 @@
   c <- complex (fromMaybe R10 r)
   let e' = fromMaybe (if isInexact c then Inexact else Exact) e
   return $ SchemeNumber e'  c
- 
+
 complex :: forall e s m . (MonadParsec e s m, Token s ~ Char) => Radix -> m Complex
 complex r = do
   ms <- optional sign
@@ -465,7 +454,7 @@
           -- Real +/- Imaginary number
           Just '+' -> imaginaryPart n1 Plus
           Just _ -> imaginaryPart n1 Minus
-  
+
     imaginaryPart realN si = do
       u <- optional (ureal r si)
       _ <- char 'i'
@@ -484,7 +473,7 @@
   where dotN =  do
           _ <- char '.'
           if r /= R10
-          then fail "Numbers containing decimal point must be in decimal radix"
+          then label "Numbers containing decimal point must be in decimal radix" mzero
           else do
              n <- uinteger R10
              sf <- optional suffix
@@ -508,14 +497,14 @@
             case sf of
               Just _ -> return $ SDecimal s u1 (UInteger 0) sf
               Nothing -> return $ SInteger s u1
-        
+
         rational u1 = do
           u2 <- uinteger r
           return $ SRational s u1 u2
 
         decimal u1 = do
           if r /= R10
-          then fail "Numbers containing decimal point must be in decimal radix"
+          then label "Numbers containing decimal point must be in decimal radix" mzero
           else do
              -- If u1 has # character, only other # are
              -- allowed. Otherwise a number may be present
@@ -539,8 +528,8 @@
   if nbPounds <= 0
   then return $ UInteger n
   else return $ UIntPounds n nbPounds
-  
 
+
 prefix :: (MonadParsec e s m, Token s ~ Char) => m (Maybe Radix, Maybe Exactness)
 prefix = do
   x <- optional $ char '#'
@@ -560,14 +549,14 @@
 exactness :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m Exactness
 exactness = (chunk (tokensToChunk (Proxy :: Proxy s) "#e") >> return Exact) <|>
             (chunk (tokensToChunk (Proxy :: Proxy s) "#i") >> return Inexact)
-  
+
 radix :: forall e s m . (MonadParsec e s m, Token s ~ Char) => m  Radix
 radix =
   (chunk (tokensToChunk (Proxy :: Proxy s) "#b") >> return R2) <|>
   (chunk (tokensToChunk (Proxy :: Proxy s) "#o") >> return R8) <|>
   (chunk (tokensToChunk (Proxy :: Proxy s) "#d") >> return R10) <|>
   (chunk (tokensToChunk (Proxy :: Proxy s) "#x") >> return R16)
-  
+
 udigit :: forall e s m a . (MonadParsec e s m, Token s ~ Char, Integral a) => Radix -> m a
 udigit r = do
   case r of
@@ -578,7 +567,7 @@
   where hexadecimal = mkNum
                       <$> takeWhile1P Nothing (\c -> c `elem` ("0123456789abcdef" :: String))
                       <?> "hexadecimal integer"
-                      
+
         mkNum    = foldl' step 0 . chunkToTokens (Proxy :: Proxy s)
         step a c = a * 16 + fromIntegral (C.digitToInt c)
 
diff --git a/src/Data/SExpresso/Parse/Generic.hs b/src/Data/SExpresso/Parse/Generic.hs
--- a/src/Data/SExpresso/Parse/Generic.hs
+++ b/src/Data/SExpresso/Parse/Generic.hs
@@ -61,6 +61,7 @@
 import Data.Maybe
 import qualified Data.Map as M
 import Control.Applicative
+import Control.Monad (mzero)
 import Text.Megaparsec
 import Data.SExpresso.SExpr
 import Data.SExpresso.Parse.Location
@@ -270,8 +271,8 @@
               then do
                 xs <- parseContent a2
                 return $ a2 : xs
-              else fail ("The previous two atoms are not separated by space.\n" ++
-                         "A space was expected at " ++ sourcePosPretty (fromJust mpos))
+              else label ("The previous two atoms are not separated by space.\n" <>
+                         "A space was expected at " <> sourcePosPretty (fromJust mpos)) mzero
 
 -- | The 'parseSExprList' function return a parser for parsing S-expression of the form @'SList' _ _@.
 parseSExprList :: (MonadParsec e s m) =>
diff --git a/src/Data/SExpresso/Parse/Location.hs b/src/Data/SExpresso/Parse/Location.hs
--- a/src/Data/SExpresso/Parse/Location.hs
+++ b/src/Data/SExpresso/Parse/Location.hs
@@ -9,11 +9,15 @@
 -- The module "Data.SExpresso.Parse" re-exports the functions and
 -- datatypes of this module.
 
+{-# LANGUAGE DeriveFunctor #-}
+
 module Data.SExpresso.Parse.Location
   (
     Location(..),
     Located(..),
-    located
+    located,
+    startPosPretty,
+    endPosPretty
    )
   where
 
@@ -25,9 +29,17 @@
 data Location = Span SourcePos SourcePos
               deriving (Eq, Ord, Show)
 
+-- | Pretty prints @S1@ of a @'Span' S1 _@ object with 'sourcePosPretty'
+startPosPretty :: Location -> String
+startPosPretty (Span s _) = sourcePosPretty s
+
+-- | Pretty prints @S2@ of a @'Span' _ S2@ object with 'sourcePosPretty'
+endPosPretty :: Location -> String
+endPosPretty (Span _ s) = sourcePosPretty s
+
 -- | The 'Located' datatype adds a source span to the type @a@
 data Located a = At Location a
-               deriving (Eq, Ord, Show)
+               deriving (Eq, Ord, Show, Functor)
 
 -- | The 'located' function adds a source span to a parser.
 located :: (MonadParsec e s m) => m a -> m (Located a)
diff --git a/src/Data/SExpresso/Print/Lazy.hs b/src/Data/SExpresso/Print/Lazy.hs
--- a/src/Data/SExpresso/Print/Lazy.hs
+++ b/src/Data/SExpresso/Print/Lazy.hs
@@ -23,8 +23,8 @@
 import qualified Data.Text.Lazy.Builder as B
 import Data.SExpresso.SExpr
 
--- | The 'SExprPrinter' defines how to print an 'SExpr'. 
-data SExprPrinter b a = SExprParser {
+-- | The 'SExprPrinter' defines how to print an 'SExpr'.
+data SExprPrinter b a = SExprPrinter {
   -- | The opening and closing tags based on the content of the 'SList'
   printTags :: b -> [SExpr b a] -> (T.Text, T.Text),
   -- | How to print an atom
@@ -34,7 +34,7 @@
 -- | An 'SExprPrinter' with the opening tag defined as '(' and the
 -- closing tag defined as ')'
 mkPrinter :: (a -> T.Text) -> SExprPrinter b a
-mkPrinter p = SExprParser (\_ _ -> ("(", ")")) p
+mkPrinter p = SExprPrinter (\_ _ -> ("(", ")")) p
 
 -- | Prints an 'SExpr' on a single line. Returns a 'B.Builder' instead of a lazy text 'L.Text'
 flatPrintBuilder :: SExprPrinter b a -> SExpr b a -> B.Builder
diff --git a/src/Data/SExpresso/SExpr.hs b/src/Data/SExpresso/SExpr.hs
--- a/src/Data/SExpresso/SExpr.hs
+++ b/src/Data/SExpresso/SExpr.hs
@@ -10,6 +10,9 @@
 
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 
 
@@ -29,6 +32,9 @@
   )
   where
 
+import Data.Bifunctor.TH
+import Data.Functor.Foldable.TH
+
 -- | The datatype 'SExpr' is the definition of an S-expression for the
 -- library S-expresso.
 --
@@ -38,6 +44,11 @@
 data SExpr b a = SList b [SExpr b a]
                | SAtom a
                deriving (Eq, Show, Functor, Traversable, Foldable)
+
+$(deriveBifunctor ''SExpr)
+$(deriveBifoldable ''SExpr)
+$(deriveBitraversable ''SExpr)
+$(makeBaseFunctor ''SExpr)
 
 -- | The type synonym 'Sexp' is a variant of the more general 'SExpr'
 -- datatype with no data for the 'SList' constructor.
diff --git a/test/SchemeR5RS_Unittests.hs b/test/SchemeR5RS_Unittests.hs
--- a/test/SchemeR5RS_Unittests.hs
+++ b/test/SchemeR5RS_Unittests.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 module SchemeR5RS_Unittests (
   r5rsTestTree
@@ -24,311 +25,294 @@
 -- tparse parses the whole input
 tparse :: Parser a -> T.Text -> Either String a
 tparse p s = first errorBundlePretty $ parse (p <* eof) "" s
-  
-r5rsTestTree :: TestTree
-r5rsTestTree = testGroup "Language/R5RS.hs" $ [
-  testGroup "whitespace" $ [
-      let s = " " in testCase (show s) $ tparse R5.whitespace s @?= Right (),
-      let s = "\t" in testCase (show s) $ tparse R5.whitespace s @?= Right (),
-      let s = "\n" in testCase (show s) $ tparse R5.whitespace s @?= Right (),
-      let s = "\r\n" in testCase (show s) $ tparse R5.whitespace s @?= Right (),
-      let s = "" in testCase (show s) $ (isLeft $ tparse R5.whitespace s) @? "Parsing must fail on empty input",
-      let s = "a" in testCase (show s) $ (isLeft $ tparse R5.whitespace s) @? "Parsing must fail on a",
-      let s = ";" in testCase (show s) $ (isLeft $ tparse R5.whitespace s) @? "Parsing must fail on ;"
-      ],
-  testGroup "comment" $ [
-      let s = ";" in testCase (show s) $ tparse R5.comment s @?= Right (),
-      let s = ";hello world" in testCase (show s) $ tparse R5.comment s @?= Right (),
-      let s = ";hello\n" in testCase (show s) $ tparse R5.comment s @?= Right (),
-      let s = ";abcdef\r\n" in testCase (show s) $ tparse R5.comment s @?= Right (),
-      let s = "" in testCase (show s) $ (isLeft $ tparse R5.comment s) @? "Parsing must fail on empty input",
-      let s = "a" in testCase (show s) $ (isLeft $ tparse R5.comment s) @? "Parsing must fail on a",
-      let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.comment s) @? "Parsing must fail on #t"
-      ],
-  testGroup "interTokenSpace" $ [
-      let s = ";" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = ";hello world" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = ";hello\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = ";abcdef\r\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = " " in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = "\t" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = "\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = "\r\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = " ;comment\n    " in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = "\t\n;comment   \n   " in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = "\n\n\n\n\n" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = "\r\n;Hello World" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right (),
-      let s = "" in testCase (show s) $ tparse R5.interTokenSpace s @?= Right ()
-      ],
-  testGroup "interTokenSpace1" $ [
-      let s = ";" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = ";hello world" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = ";hello\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = ";abcdef\r\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = " " in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = "\t" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = "\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = "\r\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = " ;comment\n    " in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = "\t\n;comment   \n   " in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = "\n\n\n\n\n" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = "\r\n;Hello World" in testCase (show s) $ tparse R5.interTokenSpace1 s @?= Right (),
-      let s = "" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on empty input",
-      let s = "1234" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on 1234",
-      let s = "a" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on a",
-      let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.interTokenSpace1 s) @? "Parsing must fail on #t"
-      ],
-  testGroup "character" $ [
-      let s = "#\\t" in testCase (show s) $ tparse R5.character s @?= Right 't',
-      let s = "#\\a" in testCase (show s) $ tparse R5.character s @?= Right 'a',
-      let s = "#\\space" in testCase (show s) $ tparse R5.character s @?= Right ' ',
-      let s = "#\\newline" in testCase (show s) $ tparse R5.character s @?= Right '\n',
-      let s = "#\\\n" in testCase (show s) $ tparse R5.character s @?= Right '\n',
-      let s = "#\\ " in testCase (show s) $ tparse R5.character s @?= Right ' ',
-      let s = "#\\\t" in testCase (show s) $ tparse R5.character s @?= Right '\t',
-      let s = "" in testCase (show s) $ (isLeft $ tparse R5.character s) @? "Parsing must fail on empty input",
-      let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.character s) @? "Parsing must fail on #t",
-      let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.character s) @? "Parsing must fail on #f"
-      ],
-  testGroup "boolean" $ [
-      let s = "#t" in testCase (show s) $ tparse R5.boolean s @?= Right True,
-      let s = "#f" in testCase (show s) $ tparse R5.boolean s @?= Right False,
-      let s = "" in testCase (show s) $ (isLeft $ tparse R5.boolean s) @? "Parsing must fail on empty input",
-      let s = "t" in testCase (show s) $ (isLeft $ tparse R5.boolean s) @? "Parsing must fail on t",
-      let s = "f" in testCase (show s) $ (isLeft $ tparse R5.boolean s) @? "Parsing must fail on f"
-      ],
-  testGroup "identifier" $ [
-      let s = "foo" in testCase (show s) $ tparse R5.identifier s @?= Right s,
-      let s = "x2" in testCase (show s) $ tparse R5.identifier s @?= Right s,
-      let s = "!hot!" in testCase (show s) $ tparse R5.identifier s @?= Right s,
-      let s = "+" in testCase (show s) $ tparse R5.identifier s @?= Right s,
-      let s = "-" in testCase (show s) $ tparse R5.identifier s @?= Right s,
-      let s = "..." in testCase (show s) $ tparse R5.identifier s @?= Right s,
-      let s = "helloWorld" in testCase (show s) $ tparse R5.identifier s @?= Right s,
-      let s = "" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on empty input",
-      let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on #t",
-      let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on #f",
-      let s = "123" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on 123",
-      let s = "+123" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on +123",
-      let s = "-123" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on -123",
-      let s = "+i" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on +i",
-      let s = "-i" in testCase (show s) $ (isLeft $ tparse R5.identifier s) @? "Parsing must fail on -i"
-      ],
-    testGroup "string" $ [
-      let s = "\"abc def ghi\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "abc def ghi",
-      let s = "\"\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "",
-      let s = "\"\n\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "\n",
-      let s = "\" \"" in testCase (show s) $ tparse R5.stringParser s @?= Right " ",
-      let s = "\"\t\"" in testCase (show s) $ tparse R5.stringParser s @?= Right "\t",
-      let s = T.pack ['"','\\','\\','"'] in testCase (show s) $ tparse R5.stringParser s @?= Right "\\",
-      let s = T.pack ['"','\\','"','"'] in testCase (show s) $ tparse R5.stringParser s @?= Right "\"",
-      let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.stringParser s) @? "Parsing must fail on #t",
-      let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.stringParser s) @? "Parsing must fail on #f"
-      ],
-    testGroup "number" $ [
-      let s = "-1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Minus (UInteger 1))),
-      let s = "-0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Minus (UInteger 0 ))),
-      let s = "0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 0))),
-      let s = "1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 1))),
 
-      
-      let s = "#e1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 1))),
-        
-      let s = "#i1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Plus (UInteger 1))),
-        
-      let s = "#b1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 1))),
-      let s = "#o1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 1))),
-      let s = "#d1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 1))),
-      let s = "#x1" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 1))),
-      let s = "#xa" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                                                                   CReal (SInteger Plus (UInteger 10))),
-      let s = "#xb" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 11))),
-      let s = "#xc" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 12))),
-      let s = "#xd" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 13))),
-      let s = "#xe" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 14))),
-      let s = "#xf" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 15))),
-      let s = "-0001" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Minus (UInteger 1))),
-      let s = "-0000" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Minus (UInteger 0))),
-      let s = "0000" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 0))),
-      let s = "0001" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 1))),
+-- Runs a test that must succeed. Accepts the parser and
+-- the string to parse and the expected value as tuple
+okTest :: (Eq a, Show a) => Parser a -> (T.Text, a) -> TestTree
+okTest p (str, expected) = testCase ("Should parse " ++ show str)
+                         $ tparse p str @?= Right expected
 
-      let s = "-1#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Minus (UIntPounds 1 1))),
-      let s = "-0#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Minus (UIntPounds 0 1))),
-      let s = "0#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Plus (UIntPounds 0 1))),
-      let s = "1#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Plus (UIntPounds 1 1))),
+okDatum :: (T.Text, [Datum]) -> TestTree
+okDatum (t, d) = okTest (sexpr2Datum <$> pSExpr) (t, Right d)
 
-      let s = "-1###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Minus (UIntPounds 1 3))),
-      let s = "-0###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Minus (UIntPounds 0 3))),
-      let s = "0###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Plus (UIntPounds 0 3))),
-      let s = "1###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SInteger Plus (UIntPounds 1 3))),
+-- Runs a test that must fail. Accepts the parser
+-- and the string to parse
+koTest :: Parser a -> T.Text -> TestTree
+koTest p str = testCase ("Should not parse " ++ show str)
+             $ (isLeft $ tparse p str) @?
+               ("Parsing must fail on " ++ show str)
 
-      let s = "-12345" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Minus (UInteger 12345))),
-      let s = "12345" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SInteger Plus (UInteger 12345))),
+koDatum :: T.Text -> TestTree
+koDatum str = testCase ("Should not parse " ++ show str)
+             $ (isLeft $ (tparse pSExpr str >>= sexpr2Datum)) @?
+               ("Parsing must fail on " ++ show str)
 
-      let s = "-12345/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SRational Minus (UInteger 12345) (UInteger 5))),
-      let s = "12345/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SRational Plus (UInteger 12345) (UInteger 5))),
-      let s = "-12345#/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SRational Minus (UIntPounds 12345 1) (UInteger 5))),
-      let s = "12345/5##" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SRational Plus (UInteger 12345) (UIntPounds 5 2))),
-      let s = "-12345##/5" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SRational Minus (UIntPounds 12345 2) (UInteger 5))),
-      let s = "12345####/5#" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SRational Plus (UIntPounds 12345 4) (UIntPounds 5 1))),
+-- Tests about whitespace that must succeed (see okTest)
+okWhitespace :: [(T.Text, ())]
+okWhitespace = map (,()) [" ", "\t", "\n", "\r\n"]
 
+-- Tests about comment that must succeed (see okTest)
+okComment :: [(T.Text, ())]
+okComment = map (,()) [";", ";hello world", ";hello\n", ";abcdef\r\n"]
 
-      let s = "-12345.0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Minus (UInteger 12345) (UInteger 0) Nothing)),
-      let s = ".0" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 0) (UInteger 0) Nothing)),
-      let s = "0." in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 0) (UInteger 0) Nothing)),
-        
-      let s = "0.###" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 0) (UPounds 3) Nothing)),
-      let s = "-.569" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Minus (UInteger 0) (UInteger 569) Nothing)),
-      let s = "-245#." in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Minus (UIntPounds 245 1) (UPounds 0) Nothing)),
-      let s = "#e-.569" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CReal (SDecimal Minus (UInteger 0) (UInteger 569) Nothing)),
-      let s = "1e10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 1)
-                                                         (UInteger 0)
-                                                         (Just $ Suffix PDefault Plus 10))),
-      let s = "1e-10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 1)
-                                                         (UInteger 0)
-                                                         (Just $ Suffix PDefault Minus 10))),
-      let s = "1s10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 1)
-                                                         (UInteger 0)
-                                                         (Just $ Suffix PShort Plus 10))),
-      let s = "1f10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 1)
-                                                         (UInteger 0)
-                                                         (Just $ Suffix PSingle Plus 10))),
-      let s = "1d10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 1)
-                                                         (UInteger 0)
-                                                         (Just $ Suffix PDouble Plus 10))),
-      let s = "1l10" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CReal (SDecimal Plus (UInteger 1)
-                                                         (UInteger 0)
-                                                         (Just $ Suffix PLong Plus 10))),
-        
-      let s = "1+i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CAbsolute (SInteger Plus (UInteger 1)) (SInteger Plus (UInteger 1))),
-        
-      let s = "1-i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CAbsolute (SInteger Plus (UInteger 1)) (SInteger Minus (UInteger 1))),
+okInterTokenSpace1 :: [(T.Text, ())]
+okInterTokenSpace1 = okWhitespace
+                  ++ okComment
+                  ++ map (,()) [" ;comment\n    ",
+                     "\t\n;comment   \n   ",
+                     "\n\n\n\n\n",
+                     "\r\n;Hello World",
+                     "  ;comment\n   ;comment"]
 
-      let s = "0.5+i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CAbsolute (SDecimal Plus (UInteger 0)
-                                                    (UInteger 5)
-                                                    Nothing) (SInteger Plus (UInteger 1))),
-                                                                     
-      let s = "-8i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CAbsolute (SInteger Plus (UInteger 0)) (SInteger Minus (UInteger 8))),
+okInterTokenSpace :: [(T.Text, ())]
+okInterTokenSpace = okInterTokenSpace1 ++ map (,()) [""]
 
-      
-      let s = "-8.25i" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CAbsolute (SInteger Plus (UInteger 0)) (SDecimal Minus (UInteger 8)
-                                                                                      (UInteger 25)
-                                                                                      Nothing)),
-      let s = "0@25" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CAngle (SInteger Plus (UInteger 0)) (SInteger Plus (UInteger 25))),
+okChar :: [(T.Text, Char)]
+okChar = [("#\\t", 't'),
+          ("#\\a", 'a'),
+          ("#\\space", ' '),
+          ("#\\newline", '\n'),
+          ("#\\\n", '\n'),
+          ("#\\ ", ' '),
+          ("#\\\t", '\t')]
 
-      let s = "1/4@-25" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Exact $
-                      CAngle (SRational Plus (UInteger 1) (UInteger 4)) (SInteger Minus (UInteger 25))),
+okBool :: [(T.Text, Bool)]
+okBool = [("#t", True),
+          ("#f", False)]
 
-      let s = "1#/4@-25##" in testCase (show s) $ tparse R5.number s @?= (Right $ SchemeNumber Inexact $
-                      CAngle (SRational Plus (UIntPounds 1 1) (UInteger 4)) (SInteger Minus (UIntPounds 25 2))),
+okIdentifier :: [(T.Text, T.Text)]
+okIdentifier = map (\x -> (x,x)) ["foo", "x2", "!hot!", "+", "-", "...",
+                                  "helloWorld"]
 
-      let s = "#b3" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #b3",
-      let s = "#o9" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #o9",
-      let s = "#da" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #da",
-      let s = "#xA" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #xA",
-      
-      let s = "#b1.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #b1.1",
-      let s = "#o1.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #o1.1",
-      let s = "#x1.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #x1.1",
-      let s = "#b.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #b.1",
-      let s = "#o.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #o.1",
-      let s = "#x.1" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #x.1",
-      
-      let s = "123##.12" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on 123##.12",
-      let s = "#" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #",
-      let s = "#t" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #t",
-      let s = "#f" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on #f"
-      ],
-    testGroup "datum" $ [
-      let s = "1" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DNumber (SchemeNumber Exact (CReal (SInteger Plus (UInteger 1))))]),
-        
-      let s = "foo" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DIdentifier "foo"]),
-      let s = "(foo #\\a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DList [DIdentifier "foo", DChar 'a']]),
-      let s = "(foo #\\a) \"hello\"" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DList [DIdentifier "foo", DChar 'a'], DString "hello"]),
-        
-      let s = "'foo" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuote (DIdentifier "foo")]),
-      let s = "`foo" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuasiquote (DIdentifier "foo")]),
-      let s = "`(foo ,a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
-      let s = "`(foo , a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
-      let s = "`(foo, a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
-      let s = "`(foo ,@a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
-      let s = "`(foo ,@ a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
-      let s = "`(foo,@ a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
-      let s = "(foo . a)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DDotList [DIdentifier "foo"] (DIdentifier "a")]),
-      let s = "(foo a b c . d)" in testCase (show s) $ (tparse pSExpr s >>= sexpr2Datum) @?=
-                     (Right $ [DDotList [DIdentifier "foo", DIdentifier "a", DIdentifier "b", DIdentifier "c"] (DIdentifier "d")]),
-      let s = "(foo .)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo .)",
-      let s = "(foo ')" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo ')",
-      let s = "(foo `)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo `)",
-      let s = "(foo ,)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo ,)",
-      let s = "(foo ,@)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo ,@)",
-      let s = "(foo a b . c d)" in testCase (show s) $ (isLeft $ tparse R5.number s) @? "Parsing must fail on (foo a b . c d)"
-      ]
+okString :: [(T.Text, T.Text)]
+okString = [("\"abc def ghi\"", "abc def ghi"),
+            ("\"\"", ""),
+            ("\"\n\"", "\n"),
+            ("\" \"", " "),
+            ("\"\t\"", "\t"),
+            (T.pack ['"','\\','\\','"'], "\\"),
+            (T.pack ['"','\\','"','"'], "\"")]
+
+okNumber :: [(T.Text, SchemeNumber)]
+okNumber =  [("-1", SchemeNumber Exact $
+                    CReal (SInteger Minus (UInteger 1))),
+    ("-0", SchemeNumber Exact $
+                    CReal (SInteger Minus (UInteger 0 ))),
+    ("0", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 0))),
+    ("1", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 1))),
+
+
+    ("#e1", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 1))),
+
+    ("#i1", SchemeNumber Inexact $
+                    CReal (SInteger Plus (UInteger 1))),
+
+    ("#b1", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 1))),
+    ("#o1", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 1))),
+    ("#d1", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 1))),
+    ("#x1", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 1))),
+    ("#xa", SchemeNumber Exact $ CReal (SInteger Plus (UInteger 10))),
+    ("#xb", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 11))),
+    ("#xc", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 12))),
+    ("#xd", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 13))),
+    ("#xe", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 14))),
+    ("#xf", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 15))),
+    ("-0001", SchemeNumber Exact $
+                    CReal (SInteger Minus (UInteger 1))),
+    ("-0000", SchemeNumber Exact $
+                    CReal (SInteger Minus (UInteger 0))),
+    ("0000", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 0))),
+    ("0001", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 1))),
+
+    ("-1#", SchemeNumber Inexact $
+                    CReal (SInteger Minus (UIntPounds 1 1))),
+    ("-0#", SchemeNumber Inexact $
+                    CReal (SInteger Minus (UIntPounds 0 1))),
+    ("0#", SchemeNumber Inexact $
+                    CReal (SInteger Plus (UIntPounds 0 1))),
+    ("1#", SchemeNumber Inexact $
+                    CReal (SInteger Plus (UIntPounds 1 1))),
+
+    ("-1###", SchemeNumber Inexact $
+                    CReal (SInteger Minus (UIntPounds 1 3))),
+    ("-0###", SchemeNumber Inexact $
+                    CReal (SInteger Minus (UIntPounds 0 3))),
+    ("0###", SchemeNumber Inexact $
+                    CReal (SInteger Plus (UIntPounds 0 3))),
+    ("1###", SchemeNumber Inexact $
+                    CReal (SInteger Plus (UIntPounds 1 3))),
+
+    ("-12345", SchemeNumber Exact $
+                    CReal (SInteger Minus (UInteger 12345))),
+    ("12345", SchemeNumber Exact $
+                    CReal (SInteger Plus (UInteger 12345))),
+
+    ("-12345/5", SchemeNumber Exact $
+                    CReal (SRational Minus (UInteger 12345) (UInteger 5))),
+    ("12345/5", SchemeNumber Exact $
+                    CReal (SRational Plus (UInteger 12345) (UInteger 5))),
+    ("-12345#/5", SchemeNumber Inexact $
+                    CReal (SRational Minus (UIntPounds 12345 1) (UInteger 5))),
+    ("12345/5##", SchemeNumber Inexact $
+                    CReal (SRational Plus (UInteger 12345) (UIntPounds 5 2))),
+    ("-12345##/5", SchemeNumber Inexact $
+                    CReal (SRational Minus (UIntPounds 12345 2) (UInteger 5))),
+    ("12345####/5#", SchemeNumber Inexact $
+                    CReal (SRational Plus (UIntPounds 12345 4) (UIntPounds 5 1))),
+
+
+    ("-12345.0", SchemeNumber Inexact $
+                    CReal (SDecimal Minus (UInteger 12345) (UInteger 0) Nothing)),
+    (".0", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 0) (UInteger 0) Nothing)),
+    ("0.", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 0) (UInteger 0) Nothing)),
+
+    ("0.###", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 0) (UPounds 3) Nothing)),
+    ("-.569", SchemeNumber Inexact $
+                    CReal (SDecimal Minus (UInteger 0) (UInteger 569) Nothing)),
+    ("-245#.", SchemeNumber Inexact $
+                    CReal (SDecimal Minus (UIntPounds 245 1) (UPounds 0) Nothing)),
+    ("#e-.569", SchemeNumber Exact $
+                    CReal (SDecimal Minus (UInteger 0) (UInteger 569) Nothing)),
+    ("1e10", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 1)
+                                                       (UInteger 0)
+                                                       (Just $ Suffix PDefault Plus 10))),
+    ("1e-10", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 1)
+                                                       (UInteger 0)
+                                                       (Just $ Suffix PDefault Minus 10))),
+    ("1s10", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 1)
+                                                       (UInteger 0)
+                                                       (Just $ Suffix PShort Plus 10))),
+    ("1f10", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 1)
+                                                       (UInteger 0)
+                                                       (Just $ Suffix PSingle Plus 10))),
+    ("1d10", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 1)
+                                                       (UInteger 0)
+                                                       (Just $ Suffix PDouble Plus 10))),
+    ("1l10", SchemeNumber Inexact $
+                    CReal (SDecimal Plus (UInteger 1)
+                                                       (UInteger 0)
+                                                       (Just $ Suffix PLong Plus 10))),
+
+    ("1+i", SchemeNumber Exact $
+                    CAbsolute (SInteger Plus (UInteger 1)) (SInteger Plus (UInteger 1))),
+
+    ("1-i", SchemeNumber Exact $
+                    CAbsolute (SInteger Plus (UInteger 1)) (SInteger Minus (UInteger 1))),
+
+    ("0.5+i", SchemeNumber Inexact $
+                    CAbsolute (SDecimal Plus (UInteger 0)
+                                                  (UInteger 5)
+                                                  Nothing) (SInteger Plus (UInteger 1))),
+
+    ("-8i", SchemeNumber Exact $
+                    CAbsolute (SInteger Plus (UInteger 0)) (SInteger Minus (UInteger 8))),
+
+
+    ("-8.25i", SchemeNumber Inexact $
+                    CAbsolute (SInteger Plus (UInteger 0)) (SDecimal Minus (UInteger 8)
+                                                                                    (UInteger 25)
+                                                                                    Nothing)),
+    ("0@25", SchemeNumber Exact $
+                    CAngle (SInteger Plus (UInteger 0)) (SInteger Plus (UInteger 25))),
+
+    ("1/4@-25", SchemeNumber Exact $
+                    CAngle (SRational Plus (UInteger 1) (UInteger 4)) (SInteger Minus (UInteger 25))),
+
+    ("1#/4@-25##", SchemeNumber Inexact $
+                    CAngle (SRational Plus (UIntPounds 1 1) (UInteger 4)) (SInteger Minus (UIntPounds 25 2)))]
+
+-- Returns all the "ok..." series of tests except the one provided
+-- as input. Since R5RS grammar is non ambiguous, a token parser should not be able
+-- to parse the valid input of other token parser.
+mkKoTest :: [T.Text] -> [T.Text]
+mkKoTest goodStr =
+  let allTests = map fst okInterTokenSpace ++
+                 map fst okChar ++
+                 map fst okBool ++
+                 map fst okIdentifier ++
+                 map fst okString ++
+                 map fst okNumber
+  in filter (not . (`elem` goodStr)) (alwaysBad ++ allTests)
+
+-- Always bad string input
+alwaysBad :: [T.Text]
+alwaysBad = ["#", "#T", "#F", "#true", "#false"] ++
+          -- Ill formated number
+            ["#b3", "#o9", "#da", "#xA", "#b1.1", "#o1.1", "#x1.1", "#b.1",
+             "#o.1", "#x.1", "123##.12"]
+
+r5rsTestTree :: TestTree
+r5rsTestTree = testGroup "Language/R5RS.hs" $ [
+  testGroup "whitespace" $
+      map (okTest R5.whitespace) okWhitespace ++
+      map (koTest R5.whitespace) (mkKoTest $ map fst okWhitespace),
+  testGroup "comment" $
+      map (okTest R5.comment) okComment ++
+      map (koTest R5.comment) (mkKoTest $ map fst okComment),
+  testGroup "interTokenSpace" $
+      map (okTest R5.interTokenSpace) okInterTokenSpace ++
+      map (koTest R5.interTokenSpace) (mkKoTest $ map fst okInterTokenSpace),
+  testGroup "interTokenSpace1" $
+      map (okTest R5.interTokenSpace1) okInterTokenSpace1 ++
+      map (koTest R5.interTokenSpace1) (mkKoTest $ map fst okInterTokenSpace1),
+  testGroup "character" $
+      map (okTest R5.character) okChar ++
+      map (koTest R5.character) (mkKoTest $ map fst okChar),
+  testGroup "boolean" $
+      map (okTest R5.boolean) okBool ++
+      map (koTest R5.boolean) (mkKoTest $ map fst okBool),
+  testGroup "identifier" $
+        map (okTest R5.identifier) okIdentifier ++
+        map (koTest R5.identifier) (mkKoTest $ map fst okIdentifier),
+  testGroup "string" $
+        map (okTest R5.stringParser) okString ++
+        map (koTest R5.stringParser) (mkKoTest $ map fst okString),
+  testGroup "number" $
+        map (okTest R5.number) okNumber ++
+        map (koTest R5.number) (mkKoTest $ map fst okNumber),
+
+    testGroup "datum" $
+      map okDatum (map (fmap ( (:[]) . DChar)) okChar) ++
+      map okDatum (map (fmap ( (:[]) . DBoolean)) okBool) ++
+      map okDatum (map (fmap ( (:[]) . DIdentifier)) okIdentifier) ++
+      map okDatum (map (fmap ( (:[]) . DString)) okString) ++
+      map okDatum (map (fmap ( (:[]) . DNumber)) okNumber) ++
+      map okDatum
+      [("(foo #\\a)", [DList [DIdentifier "foo", DChar 'a']]),
+       ("(foo #\\a) \"hello\"", [DList [DIdentifier "foo", DChar 'a'], DString "hello"]),
+       ("'foo", [DQuote (DIdentifier "foo")]),
+       ("`foo", [DQuasiquote (DIdentifier "foo")]),
+       ("`(foo ,a)", [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
+       ("`(foo , a)", [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
+       ("`(foo, a)", [DQuasiquote (DList [DIdentifier "foo", DComma (DIdentifier "a")])]),
+       ("`(foo ,@a)", [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
+       ("`(foo ,@ a)", [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
+       ("`(foo,@ a)", [DQuasiquote (DList [DIdentifier "foo", DCommaAt (DIdentifier "a")])]),
+       ("(foo . a)", [DDotList [DIdentifier "foo"] (DIdentifier "a")]),
+       ("(foo a b c . d)",
+        [DDotList [DIdentifier "foo", DIdentifier "a", DIdentifier "b", DIdentifier "c"] (DIdentifier "d")])]
+      ++
+      map koDatum ["(foo .)", "(foo ')", "(foo `)", "(foo ,)", "(foo ,@)", "(foo a b . c d)"]
   ]