Skip to content
Browse files

Merge pull request #2 from kowey/bugfix

Add test suite and support for comments.
  • Loading branch information...
2 parents 30b4374 + 992a277 commit 5f930abb8d72dae25004928c6f31a0379ad34c64 @nominolo committed Aug 16, 2011
Showing with 66 additions and 34 deletions.
  1. +11 −34 Data/AttoLisp.hs
  2. +55 −0 Data/AttoLisp/Test.hs
View
45 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
View
55 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])
+ ]

0 comments on commit 5f930ab

Please sign in to comment.
Something went wrong with that request. Please try again.