Overview
| Comment: | PackageLoader now successfully generates Qualified AST for a multi-module project. Skips validation, for now. |
|---|---|
| Timelines: | family | ancestors | descendants | both | modules |
| Files: | files | file ages | folders |
| SHA3-256: |
6eb1210a517bf4adde2b8556c630c826 |
| User & Date: | robin.hansen on 2021-03-28 11:18:12 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-03-30
| ||
| 08:57 | Merge basic module and package support. check-in: 97ad30bba8 user: robin.hansen tags: trunk | |
|
2021-03-28
| ||
| 11:18 | PackageLoader now successfully generates Qualified AST for a multi-module project. Skips validation,... Closed-Leaf check-in: 6eb1210a51 user: robin.hansen tags: modules | |
| 09:45 | PackageLoader now provides Qualifier with information about available external modules. check-in: c20bd81f06 user: robin.hansen tags: modules | |
Changes
Modified src/Play/PackageLoader.elm from [4a1bef494c] to [fe3c68a4e4].
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 .. 56 57 58 59 60 61 62 63 64 65 66 67 68 69 ... 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 ... 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 ... 390 391 392 393 394 395 396 397 398 399 400 401 402 403 |
import Play.Data.PackageMetadata as PackageMetadata exposing (PackageMetadata)
import Play.Data.PackageName as PackageName exposing (PackageName)
import Play.Data.PackagePath as PackagePath exposing (PackagePath)
import Play.Data.SemanticVersion as SemanticVersion exposing (SemanticVersion)
import Play.Parser as Parser
import Play.Qualifier as Qualifier
import Result.Extra as Result
type Problem
= InvalidPackageMetadata String String
| UnknownMessageForState String
| NoExposedModulesInRootProject
| ModuleNotFound String
................................................................................
| InternalError String
type Model
= Initializing SideEffect
| LoadingMetadata State (List PackagePath) SideEffect
| ResolvingModulePaths State (List PackageInfo) SideEffect
| Compiling State (List ModuleName) SideEffect
| Done Qualifier.ExposedAST
| Failed Problem
type alias State =
{ rootPackage : PackageInfo
, dependencies : Dict String SemanticVersion
, dependentPackages : Dict String PackageInfo
, filePathToModule : Dict String ( PackageName, ModuleName )
, moduleNameToPackageName : Dict String String
}
type alias PackageInfo =
{ path : String
, metadata : PackageMetadata
, modules : List ModuleName
................................................................................
emptyState : PackageInfo -> State
emptyState rootPackage =
{ rootPackage = rootPackage
, dependencies = rootPackage.metadata.dependencies
, dependentPackages = Dict.empty
, filePathToModule = Dict.empty
, moduleNameToPackageName = Dict.empty
}
type Msg
= FileContents String String String
| ResolvedDirectories String (List PackagePath)
| ResolvedPackageModules String (List String)
................................................................................
state.rootPackage :: Dict.values state.dependentPackages
pathsToModuleNames =
List.foldl pathsOfModules Dict.empty allPackages
moduleNameToPackageName =
List.foldl absolutePathsOfModules Dict.empty allPackages
in
Compiling
{ state
| filePathToModule = pathsToModuleNames
, moduleNameToPackageName = moduleNameToPackageName
}
remModules
(ReadFile path fileName)
else
Failed (ModuleNotFound (ModuleName.toString firstExposedModule))
readModuleFromDisk : String -> ModuleName -> ( String, String )
................................................................................
)
package.modules
|> Dict.fromList
in
Dict.union acc absolutePathsForModule
compilingUpdate : Msg -> State -> List ModuleName -> Model
compilingUpdate msg state remainingModules =
case Debug.log "msg" msg of
FileContents path fileName content ->
let
fullPath =
path ++ "/" ++ fileName
possibleModuleInfo =
Debug.log fullPath (Dict.get fullPath state.filePathToModule)
in
case ( possibleModuleInfo, Parser.run content ) of
( _, Err parserError ) ->
Failed <| InternalError <| "Parser error: " ++ Debug.toString parserError
( Just ( packageName, moduleName ), Ok parserAst ) ->
let
................................................................................
Qualifier.run
{ packageName = PackageName.toString packageName
, modulePath = ModuleName.toString moduleName
, ast = parserAst
, externalModules = state.moduleNameToPackageName
}
in
Failed <| InternalError <| "U" ++ Debug.toString qualifierResult
( Nothing, _ ) ->
Failed <| InternalError <| "Don't know why we read file: " ++ fullPath
_ ->
Failed <| InternalError <| "Unknown message for compile stage: " ++ Debug.toString msg
|
> | > > > > > > > > > > > > > < > | | | > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
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 .. 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 ... 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 ... 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 ... 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 |
import Play.Data.PackageMetadata as PackageMetadata exposing (PackageMetadata) import Play.Data.PackageName as PackageName exposing (PackageName) import Play.Data.PackagePath as PackagePath exposing (PackagePath) import Play.Data.SemanticVersion as SemanticVersion exposing (SemanticVersion) import Play.Parser as Parser import Play.Qualifier as Qualifier import Result.Extra as Result import Set exposing (Set) type Problem = InvalidPackageMetadata String String | UnknownMessageForState String | NoExposedModulesInRootProject | ModuleNotFound String ................................................................................ | InternalError String type Model = Initializing SideEffect | LoadingMetadata State (List PackagePath) SideEffect | ResolvingModulePaths State (List PackageInfo) SideEffect | Compiling State (List ( PackageInfo, ModuleName )) SideEffect | Done Qualifier.ExposedAST | Failed Problem type alias State = { rootPackage : PackageInfo , dependencies : Dict String SemanticVersion , dependentPackages : Dict String PackageInfo , filePathToModule : Dict String ( PackageName, ModuleName ) , moduleNameToPackageName : Dict String String , absoluteModuleNameToDetails : Dict String ( PackageInfo, ModuleName ) , inProgressAst : Maybe Qualifier.AST , parsedModules : Set String } type alias PackageInfo = { path : String , metadata : PackageMetadata , modules : List ModuleName ................................................................................ emptyState : PackageInfo -> State emptyState rootPackage = { rootPackage = rootPackage , dependencies = rootPackage.metadata.dependencies , dependentPackages = Dict.empty , filePathToModule = Dict.empty , moduleNameToPackageName = Dict.empty , absoluteModuleNameToDetails = Dict.empty , inProgressAst = Nothing , parsedModules = Set.empty } type Msg = FileContents String String String | ResolvedDirectories String (List PackagePath) | ResolvedPackageModules String (List String) ................................................................................ state.rootPackage :: Dict.values state.dependentPackages pathsToModuleNames = List.foldl pathsOfModules Dict.empty allPackages moduleNameToPackageName = List.foldl absolutePathsOfModules Dict.empty allPackages absoluteNameToDetails = allPackages |> List.concatMap (\pInfo -> List.map (\m -> ( pInfo, m )) pInfo.modules) |> List.map (\( pInfo, mName ) -> ( absoluteModuleName pInfo.metadata.name mName, ( pInfo, mName ) )) |> Dict.fromList in Compiling { state | filePathToModule = pathsToModuleNames , moduleNameToPackageName = moduleNameToPackageName , absoluteModuleNameToDetails = absoluteNameToDetails } (List.map (\m -> ( state.rootPackage, m )) remModules) (ReadFile path fileName) else Failed (ModuleNotFound (ModuleName.toString firstExposedModule)) readModuleFromDisk : String -> ModuleName -> ( String, String ) ................................................................................ ) package.modules |> Dict.fromList in Dict.union acc absolutePathsForModule compilingUpdate : Msg -> State -> List ( PackageInfo, ModuleName ) -> Model compilingUpdate msg state remainingModules = case msg of FileContents path fileName content -> let fullPath = path ++ "/" ++ fileName possibleModuleInfo = Dict.get fullPath state.filePathToModule in case ( possibleModuleInfo, Parser.run content ) of ( _, Err parserError ) -> Failed <| InternalError <| "Parser error: " ++ Debug.toString parserError ( Just ( packageName, moduleName ), Ok parserAst ) -> let ................................................................................ Qualifier.run { packageName = PackageName.toString packageName , modulePath = ModuleName.toString moduleName , ast = parserAst , externalModules = state.moduleNameToPackageName } in case qualifierResult of Err qualifierError -> Failed <| InternalError <| "Qualifier error: " ++ Debug.toString qualifierError Ok qualifiedAST -> let fullModuleName = absoluteModuleName packageName moduleName mergedQualifiedAst = state.inProgressAst |> Maybe.map (\ipa -> { additionalModulesRequired = Set.union ipa.additionalModulesRequired qualifiedAST.additionalModulesRequired , checkForExistingTypes = Set.union ipa.checkForExistingTypes qualifiedAST.checkForExistingTypes , checkForExistingWords = Set.union ipa.checkForExistingWords qualifiedAST.checkForExistingWords , types = Dict.union ipa.types qualifiedAST.types , words = Dict.union ipa.words qualifiedAST.words } ) |> Maybe.withDefault qualifiedAST updatedParsedModules = Set.insert fullModuleName state.parsedModules modulesQueuedForOrAlreadyParsed = remainingModules |> List.map (\( pInfo, mName ) -> absoluteModuleName pInfo.metadata.name mName) |> Set.fromList |> Set.union updatedParsedModules missingModulesInParseQueue = Set.diff mergedQualifiedAst.additionalModulesRequired modulesQueuedForOrAlreadyParsed |> Set.toList |> List.filterMap (\absName -> Dict.get absName state.absoluteModuleNameToDetails) updatedRemainingModules = missingModulesInParseQueue ++ remainingModules in nextCompileStep updatedParsedModules mergedQualifiedAst updatedRemainingModules state ( Nothing, _ ) -> Failed <| InternalError <| "Don't know why we read file: " ++ fullPath _ -> Failed <| InternalError <| "Unknown message for compile stage: " ++ Debug.toString msg absoluteModuleName : PackageName -> ModuleName -> String absoluteModuleName packageName moduleName = "/" ++ PackageName.toString packageName ++ "/" ++ ModuleName.toString moduleName nextCompileStep : Set String -> Qualifier.AST -> List ( PackageInfo, ModuleName ) -> State -> Model nextCompileStep parsedModules inProgressAst remainingModules state = case remainingModules of [] -> Done { types = inProgressAst.types , words = inProgressAst.words } ( packageInfo, moduleName ) :: otherModules -> let ( path, fileName ) = readModuleFromDisk packageInfo.path moduleName in Compiling { state | parsedModules = parsedModules , inProgressAst = Just inProgressAst } otherModules (ReadFile path fileName) |
Modified tests/Test/PackageLoader.elm from [11ea0f2ff1] to [a50f684204].
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
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
|
import Play.Data.Builtin as Builtin
import Play.Data.Metadata as Metadata
import Play.Data.PackagePath as PackagePath
import Play.Data.SourceLocation exposing (emptyRange)
import Play.PackageLoader as PackageLoader
import Play.Qualifier as Qualifier
import Test exposing (Test, describe, test)
suite : Test
suite =
describe "PackageLoader"
[ test "Passes the load package metadata step" <|
\_ ->
................................................................................
case loaderResult of
Err msg ->
Expect.fail msg
Ok ast ->
Expect.equal
{ types =
Dict.fromListBy Qualifier.typeDefinitionName
[]
, words =
Dict.fromListBy .name
[ { name = "/robheghan/fnv/mod1/inc"
, metadata = Metadata.default
, implementation =
Qualifier.SoloImpl
[ Qualifier.Word emptyRange "/play/version/version/data/version"
, Qualifier.Integer emptyRange 1
, Qualifier.Builtin emptyRange Builtin.Plus
]
}
, { name = "/play/version/version/data/number"
, metadata = Metadata.default
, implementation =
Qualifier.SoloImpl
[ Qualifier.Integer emptyRange 2
]
}
]
}
ast
]
expectSideEffects : Dict String String -> List PackageLoader.SideEffect -> PackageLoader.Model -> Expectation
expectSideEffects fileSystem expectedSFs model =
case resolveSideEffects fileSystem [] model of
Err msg ->
|
>
|
<
|
|
|
|
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
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
|
import Play.Data.Builtin as Builtin import Play.Data.Metadata as Metadata import Play.Data.PackagePath as PackagePath import Play.Data.SourceLocation exposing (emptyRange) import Play.PackageLoader as PackageLoader import Play.Qualifier as Qualifier import Test exposing (Test, describe, test) import Test.Qualifier.Util as Util suite : Test suite = describe "PackageLoader" [ test "Passes the load package metadata step" <| \_ -> ................................................................................ case loaderResult of Err msg -> Expect.fail msg Ok ast -> Expect.equal { types = Dict.fromListBy Qualifier.typeDefinitionName [] , words = Dict.fromListBy .name [ { name = "/robheghan/fnv/mod1/next-version" , metadata = Metadata.default , implementation = Qualifier.SoloImpl [ Qualifier.Word emptyRange "/play/version/version/data/number" , Qualifier.Integer emptyRange 1 , Qualifier.Builtin emptyRange Builtin.Plus ] } , { name = "/play/version/version/data/number" , metadata = Metadata.default , implementation = Qualifier.SoloImpl [ Qualifier.Integer emptyRange 2 ] } ] } (Util.stripLocations ast) ] expectSideEffects : Dict String String -> List PackageLoader.SideEffect -> PackageLoader.Model -> Expectation expectSideEffects fileSystem expectedSFs model = case resolveSideEffects fileSystem [] model of Err msg -> |
Modified tests/Test/Qualifier/Util.elm from [347c700b83] to [f85a91ec9e].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
132
133
134
135
136
137
138
|
module Test.Qualifier.Util exposing
( addFunctionsForStructs
, expectModuleOutput
, expectOutput
)
import Dict exposing (Dict)
import Dict.Extra as Dict
import Expect exposing (Expectation)
import Play.Data.Metadata as Metadata
import Play.Data.Type as Type exposing (Type)
import Play.Parser as Parser
import Play.Qualifier as AST exposing (AST, TypeDefinition, WordDefinition)
import Play.Qualifier.Problem exposing (Problem)
import Set
type alias FullyLoadedAST =
{ types : Dict String TypeDefinition
, words : Dict String WordDefinition
}
................................................................................
allFuncs =
(ctor :: setters)
++ getters
|> Dict.fromListBy .name
in
{ ast | words = Dict.union ast.words allFuncs }
|
>
>
<
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
...
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
module Test.Qualifier.Util exposing
( addFunctionsForStructs
, expectModuleOutput
, expectOutput
, stripLocations
)
import Dict exposing (Dict)
import Dict.Extra as Dict
import Expect exposing (Expectation)
import Play.Data.Metadata as Metadata
import Play.Data.SourceLocation exposing (emptyRange)
import Play.Data.Type as Type exposing (Type)
import Play.Parser as Parser
import Play.Qualifier as AST
exposing
( ExposedAST
, Node(..)
, TypeDefinition
, TypeMatch(..)
, TypeMatchValue(..)
, WordDefinition
, WordImplementation(..)
)
type alias FullyLoadedAST =
{ types : Dict String TypeDefinition
, words : Dict String WordDefinition
}
................................................................................
allFuncs =
(ctor :: setters)
++ getters
|> Dict.fromListBy .name
in
{ ast | words = Dict.union ast.words allFuncs }
stripLocations : ExposedAST -> ExposedAST
stripLocations ast =
{ types = Dict.map (\_ t -> stripTypeLocation t) ast.types
, words = Dict.map (\_ d -> stripWordLocation d) ast.words
}
stripTypeLocation : TypeDefinition -> TypeDefinition
stripTypeLocation typeDef =
case typeDef of
AST.CustomTypeDef name _ generics members ->
AST.CustomTypeDef name emptyRange generics members
AST.UnionTypeDef name _ generics members ->
AST.UnionTypeDef name emptyRange generics members
stripWordLocation : WordDefinition -> WordDefinition
stripWordLocation word =
{ word
| implementation = stripImplementationLocation word.implementation
, metadata = Metadata.clearSourceLocationRange word.metadata
}
stripImplementationLocation : WordImplementation -> WordImplementation
stripImplementationLocation impl =
case impl of
SoloImpl nodes ->
SoloImpl (List.map stripNodeLocation nodes)
MultiImpl conds default ->
MultiImpl
(List.map stripMultiWordBranchLocation conds)
(List.map stripNodeLocation default)
stripNodeLocation : Node -> Node
stripNodeLocation node =
case node of
AST.Integer _ val ->
AST.Integer emptyRange val
AST.Word _ val ->
AST.Word emptyRange val
AST.WordRef _ val ->
AST.WordRef emptyRange val
AST.Builtin _ val ->
AST.Builtin emptyRange val
_ ->
node
stripMultiWordBranchLocation : ( TypeMatch, List Node ) -> ( TypeMatch, List Node )
stripMultiWordBranchLocation ( typeMatch, nodes ) =
( stripTypeMatchLocation typeMatch
, List.map stripNodeLocation nodes
)
stripTypeMatchLocation : TypeMatch -> TypeMatch
stripTypeMatchLocation (TypeMatch _ type_ otherConds) =
TypeMatch emptyRange type_ <|
List.map (Tuple.mapSecond stripRecursiveTypeMatchLocation) otherConds
stripRecursiveTypeMatchLocation : TypeMatchValue -> TypeMatchValue
stripRecursiveTypeMatchLocation typeMatchValue =
case typeMatchValue of
RecursiveMatch typeMatch ->
RecursiveMatch (stripTypeMatchLocation typeMatch)
_ ->
typeMatchValue
|