{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} module Felix.Test.Golden where import Base import Felix.Workspace qualified as Workspace import Data.Text.Lazy.IO qualified as LazyTextIO import System.Directory import System.FilePath import Test.Tasty import Test.Tasty.Golden (goldenVsFile, findByExtension) import Text.Pretty.Simple (pShowNoColor) import UnliftIO goldenTests :: IO TestTree goldenTests = goldenTestGroup goldenTestGroup :: MonadUnliftIO io => io TestTree goldenTestGroup = testGroup "golden tests" <$> sequence [ tokenizing , scanning , parsing ] -- | A testing triple consists of a an 'input' file, which is proccesed, resulting -- in 'output' file, which is then compared to a 'golden' file. data Triple = Triple { input :: FilePath , output :: FilePath , golden :: FilePath } deriving (Show, Eq) -- | Gathers all the files for the test. We test all examples and everything in @test/pass/@. -- The golden files for all tests are stored in @test/pass/@, so we need to adjust the filepath -- of the files from @examples/@. gatherTriples :: MonadIO io => String -> io [Triple] gatherTriples stage = do inputs <- liftIO (findByExtension [".tex"] "test/examples") pure $ [ Triple{..} | input <- inputs , let input' = "test" "golden" takeBaseName input stage , let golden = input' <.> "golden" , let output = input' <.> "out" ] createTripleDirectoriesIfMissing :: MonadIO io => Triple -> io () createTripleDirectoriesIfMissing Triple{..} = liftIO $ createDirectoryIfMissing True (takeDirectory output) makeGoldenTest :: MonadUnliftIO io => String -> (Triple -> io ()) -> io TestTree makeGoldenTest stage action = do triples <- gatherTriples stage for triples createTripleDirectoriesIfMissing runInIO <- askRunInIO pure $ testGroup stage [ goldenVsFile (takeBaseName input) -- test name golden output (runInIO (action triple)) | triple@Triple{..} <- triples ] tokenizing :: MonadUnliftIO io => io TestTree tokenizing = makeGoldenTest "tokenizing" $ \Triple{..} -> do tokenStream <- liftIO (Workspace.tokenize input) liftIO (LazyTextIO.writeFile output (pShowNoColor (Workspace.simpleStream tokenStream))) scanning :: MonadUnliftIO io => io TestTree scanning = makeGoldenTest "scanning" $ \Triple{..} -> do lexicalItems <- liftIO (Workspace.scan input) liftIO (LazyTextIO.writeFile output (pShowNoColor lexicalItems)) parsing :: MonadUnliftIO io => io TestTree parsing = makeGoldenTest "parsing" $ \Triple{..} -> do parseResult <- liftIO (Workspace.parse input) liftIO (LazyTextIO.writeFile output (pShowNoColor parseResult))