diff --git a/haddock2.cabal b/haddock2.cabal index 9ba514f..7fe124c 100644 --- a/haddock2.cabal +++ b/haddock2.cabal @@ -46,6 +46,7 @@ test-suite haddock2-test type: exitcode-stdio-1.0 main-is: Spec.hs build-depends: + parsec ^>=3.1.18.0, base >=4.20.1.0, haddock2:{haddock2-lib}, hspec ^>=2.11.0, diff --git a/test/Spec.hs b/test/Spec.hs index 21ff624..dfd0d6b 100644 --- a/test/Spec.hs +++ b/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