Add basic tests related to comment parsing.

2 files changed, 37 insertions, 2 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index bab5ba0a..019075a1 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -38,7 +38,7 @@ data TokenType
     | TkCpp
     | TkPragma
     | TkUnknown
-    deriving (Eq)
+    deriving (Show, Eq)
 
 -- | Turn source code string into a stream of more descriptive tokens.
 --
diff --git a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
index c85fa47e..d5964224 100644
--- a/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
+++ b/haddock-api/test/Haddock/Backends/Hyperlinker/ParserSpec.hs
@@ -9,9 +9,44 @@ import Haddock.Backends.Hyperlinker.Parser
 main :: IO ()
 main = hspec spec
 
+
 spec :: Spec
 spec = do
     describe "parse" parseSpec
 
+
 parseSpec :: Spec
-parseSpec = return ()
+parseSpec = do
+
+    context "when parsing single-line comments" $ do
+
+        it "should ignore content until the end of line" $
+            "-- some very simple comment\nidentifier"
+            `shouldParseTo`
+            [TkComment, TkSpace, TkIdentifier]
+
+        it "should allow endline escaping" $
+            "-- first line\\\nsecond line\\\nand another one"
+            `shouldParseTo`
+            [TkComment]
+
+    context "when parsing multi-line comments" $ do
+
+        it "should support nested comments" $
+            "{- comment {- nested -} still comment -} {- next comment -}"
+            `shouldParseTo`
+            [TkComment, TkSpace, TkComment]
+
+        it "should distinguish compiler pragma" $
+            "{- comment -}{-# LANGUAGE GADTs #-}{- comment -}"
+            `shouldParseTo`
+            [TkComment, TkPragma, TkComment]
+
+    it "should recognize preprocessor directives" $ do
+        "\n#define foo bar" `shouldParseTo` [TkSpace, TkCpp]
+        "x # y" `shouldParseTo`
+            [TkIdentifier, TkSpace, TkCpp, TkSpace,TkIdentifier]
+
+
+shouldParseTo :: String -> [TokenType] -> Expectation
+str `shouldParseTo` tokens = map tkType (parse str) `shouldBe` tokens