{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} import Commonmark import Control.Monad (when) import Data.Functor.Identity import Data.List (groupBy) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import System.IO (hSetEncoding, utf8, openFile, IOMode(..)) import qualified Data.Text.Lazy as TL import Data.Text.Normalize (normalize, NormalizationMode(NFC)) import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Text.Parsec import Text.Parsec.Pos readTextFile :: FilePath -> IO Text readTextFile fp = do h <- openFile fp ReadMode hSetEncoding h utf8 T.hGetContents h main :: IO () main = do let defaultParser = runIdentity . parseCommonmarkWith defaultSyntaxSpec tests <- mapM (uncurry getSpecTestTree) [ ("test/spec.txt", mempty) , ("test/regression.md", mempty) ] defaultMain $ testGroup "Tests" (testProperty "tokenize/untokenize roundtrip" tokenize_roundtrip : toSpecTest defaultParser SpecTest { section = "Issue #24 (eof after HTML block)" , example = 1 , markdown = " a ?>" , end_line = 1 , start_line = 1 , html = " a ?>" } : toSpecTest defaultParser SpecTest { section = "Issue #24 (eof after HTML block)" , example = 2 , markdown = "" , end_line = 2 , start_line = 2 , html = "" } : tests) getSpecTestTree :: FilePath -> SyntaxSpec Identity (Html ()) (Html ()) -> IO TestTree getSpecTestTree fp syntaxspec = do spectests <- getSpecTests fp let spectestgroups = groupBy (\t1 t2 -> section t1 == section t2) spectests let spectestsecs = [(section (head xs), xs) | xs <- spectestgroups] let parser = runIdentity . parseCommonmarkWith (syntaxspec <> defaultSyntaxSpec) return $ testGroup fp $ map (\(secname, tests) -> testGroup (T.unpack secname) $ map (toSpecTest parser) tests) spectestsecs getSpecTests :: FilePath -> IO [SpecTest] getSpecTests fp = do speclines <- zip [1..] . T.lines . T.replace "→" "\t" <$> readTextFile fp return $ either (error . show) id $ runParser (many (try (skipMany normalLine *> parseSpecTest)) <* skipMany normalLine <* eof) ("",1) fp speclines data SpecTest = SpecTest { section :: Text , example :: Int , markdown :: Text , end_line :: Int , start_line :: Int , html :: Text } deriving (Show) toSpecTest :: ([Tok] -> Either ParseError (Html ())) -> SpecTest -> TestTree toSpecTest parser st = testCase name (actual @?= expected) where name = T.unpack (section st) ++ " example " ++ show (example st) ++ " (" ++ show (start_line st) ++ "-" ++ show (end_line st) ++ ")" expected = normalizeHtml $ html st actual = normalizeHtml . TL.toStrict . renderHtml . fromRight mempty $ (parser (tokenize "" (markdown st)) :: Either ParseError (Html ())) normalizeHtml :: Text -> Text normalizeHtml = T.replace "\n" "" . T.replace "