summaryrefslogtreecommitdiff
path: root/source/Felix/Test/Golden.hs
blob: 905ff73f7f16846fef99806e7534cc5d9faf8a3b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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))