Merge pull request #2 from kowey/bugfix

Add test suite and support for comments.

Data/AttoLisp.hs

@@ -579,37 +579,6 @@ instance (FromLisp a, FromLisp b, FromLisp c) => FromLisp (a, b, c) where
   parseLisp e = typeMismatch "3-tuple" e
   {-# INLINE parseLisp #-}
 
-{- --- TESTS ----------------------------------------------------
-data Msg = Msg T.Text Integer
-  deriving (Eq, Show)
-
-instance ToLisp Msg where
-  toLisp (Msg t n) = mkStruct "msg" [toLisp t, toLisp n]
-
-instance FromLisp Msg where
-  parseLisp e = struct "msg" Msg e
-
-
-test_sexp1 = 
-  show (List [Number 42.2, Symbol "foo", "blah"]) == "(42.2 foo \"blah\")"
-
-test_msg1 = toLisp (Msg "foo" 42)
-test_msg2 = List [Symbol "msg"]
-test_msg3 = List [Symbol "msg", "bar", "baz"]
-
-test_parse :: IO ()
-test_parse = do
-  mapM_ (\inp ->
-           putStrLn $ show inp ++ " => " ++ show (A.parseOnly (lisp <* A.endOfInput) inp))
-    inputs
- where
-  inputs = ["()", "42", "(4 5 6)", "(3 (4))", "(3(4))",
-            "\"foo\"", "foo", "(foo \"bar\" 23)"]
-
-
-
--- -}
-
 {-
 
 We are using the standard Common Lisp read table.
@@ -629,7 +598,7 @@ like an number then it is one.  Otherwise it's just a symbol.
 
 -- | Parse an arbitrary lisp expression.
 lisp :: A.Parser Lisp
-lisp = skipSpace *>
+lisp = skipLispSpace *>
   (char '(' *> list_ <|>
    String <$> (char '"' *> lstring_) <|>
    atom)
@@ -657,8 +626,8 @@ terminatingChar c =
 
 list_ :: A.Parser Lisp
 list_ = do
-  skipSpace
-  elems <- (lisp `sepBy` skipSpace) <* skipSpace <* char ')'
+  skipLispSpace
+  elems <- (lisp `sepBy` skipLispSpace) <* skipLispSpace <* char ')'
   return (List elems)
 
 doubleQuote :: Word8
@@ -669,6 +638,14 @@ backslash :: Word8
 backslash = 92
 {-# INLINE backslash #-}
 
+skipLispSpace :: A.Parser ()
+skipLispSpace = skipSpace >> optional comment >> skipSpace
+
+comment :: A.Parser ()
+comment = do
+  _ <- char ';' >> A.many (notChar '\n')
+  end <- atEnd
+  if end then char '\n' >> return () else return ()
 
 -- | Parse a string without a leading quote.
 lstring_ :: A.Parser T.Text

Data/AttoLisp/Test.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings, Rank2Types, DeriveDataTypeable, BangPatterns,
+             MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,
+             UndecidableInstances #-}
+
+module Data.AttoLisp.Test where
+
+import Control.Applicative
+import Data.AttoLisp
+import qualified Data.Attoparsec as A
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.ByteString as B
+import Test.HUnit
+import Test.Framework.Providers.HUnit
+import Test.Framework
+
+data Msg = Msg T.Text Integer
+  deriving (Eq, Show)
+
+instance ToLisp Msg where
+  toLisp (Msg t n) = mkStruct "msg" [toLisp t, toLisp n]
+
+instance FromLisp Msg where
+  parseLisp e = struct "msg" Msg e
+
+
+test_sexp1 = 
+  show (List [Number 42.2, Symbol "foo", "blah"]) == "(42.2 foo \"blah\")"
+
+test_msg1 = toLisp (Msg "foo" 42)
+test_msg2 = List [Symbol "msg"]
+test_msg3 = List [Symbol "msg", "bar", "baz"]
+
+data T = T { tin  :: B.ByteString
+           , tout :: Either String Lisp
+           }
+
+main :: IO ()
+main = defaultMain (map tcase tests)
+
+tcase :: T -> Test.Framework.Test
+tcase (T inp out) = testCase (show inp) $ assertEqual (show inp) out out2
+ where
+  out2 = A.parseOnly (lisp <* A.endOfInput) inp
+
+tests = [ T "()" (Right $ List [])
+        , T "42" (Right $ Number 42)
+        , T "(4 5 6)" (Right $ List [Number 4, Number 5, Number 6])
+        , T "(4 5 6 )" (Right $ List [Number 4, Number 5, Number 6])
+        , T "(3 (4))" (Right $ List [Number 3, List [Number 4]])
+        , T "\"a; however, b\"" (Right $ String "a; however, b")
+        , T "(x ;comment\ny)" (Right $ List [Symbol "x", Symbol "y"])        , T "\"foo\"" (Right (String "foo"))
+        , T "foo"     (Right (Symbol "foo"))
+        , T "(foo \"bar\" 23)" (Right $ List [Symbol "foo", String "bar", Number 23])
+        ]