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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
{-# LANGUAGE NoImplicitPrelude #-}
module Test.Unit.Migration (unitTests) where
import Base
import Felix.Migration
import Felix.Parse qualified as Parse
import Felix.Prelude qualified as Prelude
import Felix.Source
import Syntax.Interface qualified as Syntax
import System.Directory (getCurrentDirectory)
import System.FilePath.Posix qualified as Posix
import Test.Tasty
import Test.Tasty.HUnit
unitTests :: TestTree
unitTests =
testGroup "Migration manifest"
[ testCase "resolves references from prepared mount roots"
resolvesManifestReferences
, testCase "selects one driver for the complete graph"
selectsCompleteGraphDriver
]
resolvesManifestReferences :: Assertion
resolvesManifestReferences = do
mounts <-
expectRight
=<< prepareSourceMounts
[ (sourceMountId "project", "/tmp/felix-project")
, (sourceMountId "library", "/tmp/felix-library")
, (sourceMountId "debug", "/tmp/felix-debug")
]
forM_
(toList activeMigrationRoots
<> toList protectedMigrationModules)
\reference -> do
assertEqual
"manifest role"
MigrationLibrary
(migrationModuleRefRole reference)
candidate <-
expectRight
(migrationModuleCandidatePath mounts reference)
assertEqual
"mount-relative candidate"
("/tmp/felix-library"
Posix.</> safeRelativePathFilePath
(migrationModuleRefPath reference))
candidate
forM_ (toList typedMigrationModules) \reference ->
assertEqual
"typed fixture mount role"
MigrationProject
(migrationModuleRefRole reference)
selectsCompleteGraphDriver :: Assertion
selectsCompleteGraphDriver = do
root <- getCurrentDirectory
mounts <-
expectRight
=<< prepareSourceMounts
[ (sourceMountId "project", root)
, (sourceMountId "library", root Posix.</> "library")
, (sourceMountId "debug", root Posix.</> "debug")
]
selection <-
expectRight
(resolveMigrationSelection mounts typedMigrationModules)
reserved <-
expectRight
=<< Prelude.parseReservedPreludeSource
Prelude.emptyBootstrapSourceInput
let bootstrapSyntax =
Parse.freshParsedModuleSyntaxInterface
(Prelude.reservedParsedPreludeModule reserved)
syntaxInputs source
| migrationSelectionContains selection source =
[bootstrapSyntax]
| otherwise = []
parseRoot path = do
request <- expectRight (searchedRoot path)
Parse.parseSourceWorkspaceMeasuredWithSyntaxInputs
mounts request syntaxInputs
(producer, _producerMeasurements) <-
expectRight
=<< parseRoot "test/phase3/typed-producer.tex"
assertEqual "selected root uses typed driver"
TypedMigrationGraph
(classifyMigrationGraph selection producer)
assertEqual "selected parse receives the bootstrap syntax input"
[Syntax.moduleSyntaxAssertedId bootstrapSyntax]
(Syntax.moduleSyntaxDirectInputs
(Parse.parsedModuleSyntaxInterface
(Parse.parsedWorkspaceRootModule producer)))
(importer, _importerMeasurements) <-
expectRight
=<< parseRoot "test/phase3/legacy-importer.tex"
assertEqual "unselected importer keeps the complete graph legacy"
LegacyMigrationGraph
(classifyMigrationGraph selection importer)
expectRight :: Show err => Either err value -> IO value
expectRight = \case
Left err ->
assertFailure (show err) >> fail "unreachable"
Right value ->
pure value
|
