Basic lexer testing

test/Spec.hs

@@ -5,23 +5,14 @@ import Test.Hspec
 
 import Data.String (IsString (..))
 import Data.Text (Text)
+import Text.Parsec.Pos
 
+import Control.Monad (zipWithM_)
 import Identifier (Identifier)
 import Lexer
 import Parser
 import Types
 
-main :: IO ()
-main = hspec $ do
-  describe "Lexer" do
-    it "lexes" do
-      lexer "This is string" `shouldBe` undefined
-  describe "Parser" do
-    it "Bold" do
-      "__bold__" `shouldParseTo` (DocBold (DocString "bold"))
-    it "Emphasis" do
-      "/emphasis/" `shouldParseTo` (DocEmphasis (DocString "emphasis"))
-
 shouldParseTo :: Text -> DocMarkup mod Identifier -> Expectation
 shouldParseTo input ast = parseText input `shouldBe` ast
 
@@ -30,5 +21,28 @@ type Doc id = DocMarkup () id
 instance IsString (Doc String) where
   fromString = DocString
 
-file :: IO String
-file = readFile "test/markup.md"
+main :: IO ()
+main = hspec $ do
+  describe "Lexer" do
+    it "bare string" do
+      "some string" `shouldLexTo` [(1, 1, Token "some"), (1, 5, Space), (1, 6, Token "string")]
+    it "emphasis" do
+      "has /emphatic/ content" `shouldLexTo` replicate 7 (0, 0, Space)
+  describe "Parser" do
+    it "Bold" do
+      "__bold__" `shouldParseTo` (DocBold (DocString "bold"))
+    it "Emphasis" do
+      "/emphasis/" `shouldParseTo` (DocEmphasis (DocString "emphasis"))
+
+shouldLexTo :: String -> [(Int, Int, Token)] -> Expectation
+shouldLexTo input expected =
+  case lexer input of
+    Right tokens -> do
+      length tokens `shouldBe` length expected
+      zipWithM_ checkToken tokens expected
+    Left err -> expectationFailure $ "Parse error: " <> show err
+ where
+  checkToken (pos, tok) (line, col, expectedTok) = do
+    tok `shouldBe` expectedTok
+    sourceLine pos `shouldBe` line
+    sourceColumn pos `shouldBe` col