Basic lexer testing

This commit is contained in:
Igor Ranieri 2025-09-21 09:54:10 +02:00
parent 4410e67590
commit 68f9b88c83
2 changed files with 28 additions and 13 deletions

View file

@ -46,6 +46,7 @@ test-suite haddock2-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Spec.hs main-is: Spec.hs
build-depends: build-depends:
parsec ^>=3.1.18.0,
base >=4.20.1.0, base >=4.20.1.0,
haddock2:{haddock2-lib}, haddock2:{haddock2-lib},
hspec ^>=2.11.0, hspec ^>=2.11.0,

View file

@ -5,23 +5,14 @@ import Test.Hspec
import Data.String (IsString (..)) import Data.String (IsString (..))
import Data.Text (Text) import Data.Text (Text)
import Text.Parsec.Pos
import Control.Monad (zipWithM_)
import Identifier (Identifier) import Identifier (Identifier)
import Lexer import Lexer
import Parser import Parser
import Types 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 :: Text -> DocMarkup mod Identifier -> Expectation
shouldParseTo input ast = parseText input `shouldBe` ast shouldParseTo input ast = parseText input `shouldBe` ast
@ -30,5 +21,28 @@ type Doc id = DocMarkup () id
instance IsString (Doc String) where instance IsString (Doc String) where
fromString = DocString fromString = DocString
file :: IO String main :: IO ()
file = readFile "test/markup.md" 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