Migrate to `Felix` namespaceHEADhotg

1 files changed, 86 insertions, 0 deletions

diff --git a/source/Felix/Test/Golden.hs b/source/Felix/Test/Golden.hs
new file mode 100644
index 0000000..905ff73
--- /dev/null
+++ b/source/Felix/Test/Golden.hs
@@ -0,0 +1,86 @@
+{-# 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))