Stabel

Check-in [6183b67e1c]
Login
Overview
Comment:Include source code for type errors in CLI.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 6183b67e1cba0904457195021b492ac2a8757823a596d55f3a54c6c27b8f37bc
User & Date: robin.hansen on 2021-08-03 11:28:13
Other Links: manifest | tags
Context
2021-08-04
10:12
Include source code reference (usually a file path) when printing error messages. check-in: 7cf56f4d4f user: robin.hansen tags: trunk
2021-08-03
11:28
Include source code for type errors in CLI. check-in: 6183b67e1c user: robin.hansen tags: trunk
2021-08-02
10:25
Include types of bound union members in named unions. check-in: 1810037cab user: robin.hansen tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified bin/cli.js from [15abce7081] to [e95f7f5623].

99
100
101
102
103
104
105











106
107
108
109
110
111
112
                const subFolders = packageDirs(msg.path);

                compiler.ports.incomingPort.send({
                    type: "resolvedDirectories",
                    parentDir: msg.path,
                    paths: subFolders
                });











                break;
            case "compilationDone":
                if (typeof entryPoint === "undefined") {
                    console.log("Compiled successfully");
                } else {
                    executeWat(msg.wast, entryPoint);
                }







>
>
>
>
>
>
>
>
>
>
>







99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
                const subFolders = packageDirs(msg.path);

                compiler.ports.incomingPort.send({
                    type: "resolvedDirectories",
                    parentDir: msg.path,
                    paths: subFolders
                });
                break;
            case "readFilesToReportError":
                const files = msg.paths.reduce((acc, path) => { 
                    acc[path] = fs.readFileSync(path, { encoding: "utf-8" });
                    return acc;
                }, {});

                compiler.ports.incomingPort.send({
                    type: "filesForErrorReporting",
                    files: files
                });
                break;
            case "compilationDone":
                if (typeof entryPoint === "undefined") {
                    console.log("Compiled successfully");
                } else {
                    executeWat(msg.wast, entryPoint);
                }

Modified src/CLI.elm from [da81dfd523] to [90c0f27e7c].

1
2

3
4
5
6
7
8
9
..
16
17
18
19
20
21
22


23


24
25
26
27
28





29
30
31
32
33
34
35
..
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
..
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
111
112


















113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
...
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
port module CLI exposing (main)


import Json.Decode as Json
import Json.Encode as Encode
import Platform exposing (Program)
import Set
import Stabel.Codegen as Codegen
import Stabel.Data.PackagePath as PackagePath
import Stabel.PackageLoader as PackageLoader
................................................................................
    { projectDir : String
    , entryPoint : Maybe String
    , stdLibPath : String
    }


type alias Model =


    ( Maybe String, PackageLoader.Model )




type Msg
    = Incomming Json.Value







main : Program Flags Model Msg
main =
    Platform.worker
        { init = init
        , update = update
        , subscriptions = subscriptions
................................................................................
    let
        initialModel =
            PackageLoader.init
                { projectDirPath = projectDir
                , stdLibPath = stdLibPath
                }
    in
    ( ( entryPoint, initialModel )
    , sendSideEffectFromModel initialModel
    )


sendSideEffectFromModel : PackageLoader.Model -> Cmd Msg
sendSideEffectFromModel model =
    PackageLoader.getSideEffect model
        |> Maybe.map encodeSideEffectAsJson
        |> Maybe.map outgoingPort
        |> Maybe.withDefault Cmd.none


update : Msg -> Model -> ( Model, Cmd Msg )
update msg (( entryPoint, packageLoaderModel ) as model) =
    case msg of
        Incomming packageLoaderMsgJson ->
            case Json.decodeValue decodePackageLoaderMsg packageLoaderMsgJson of
                Ok packageLoaderMsg ->
                    let
                        updatedModel =
                            PackageLoader.update packageLoaderMsg packageLoaderModel
                    in
                    case updatedModel of
                        PackageLoader.Done qualifiedAst ->
                            let
                                compilationResult =
                                    case TypeChecker.run qualifiedAst of
                                        Err typeErrors ->



                                            formatErrors (TypeCheckerProblem.toString "") typeErrors





                                        Ok typedAst ->
                                            let
                                                exportedFunctions =
                                                    entryPoint
                                                        |> Maybe.map Set.singleton
                                                        |> Maybe.withDefault Set.empty
................................................................................
                                            typedAst
                                                |> Codegen.run exportedFunctions
                                                |> Wasm.toString
                                                |> Ok
                            in
                            case compilationResult of
                                Ok wast ->
                                    ( model
                                    , outgoingPort <| encodeCompilationDone wast
                                    )

                                Err error ->
                                    ( model
                                    , outgoingPort <| encodeCompilationFailure error
                                    )

                        PackageLoader.Failed error ->
                            ( model
                            , outgoingPort <|
                                encodeCompilationFailure <|
                                    PackageLoader.problemToString error
                            )

                        _ ->
                            ( ( entryPoint, updatedModel )
                            , sendSideEffectFromModel updatedModel
                            )



















                Err decodeError ->
                    ( model
                    , outgoingPort <|
                        encodeCompilationFailure <|
                            Json.errorToString decodeError
                    )


formatErrors : (a -> String) -> List a -> Result String b
formatErrors fn problems =
    problems
        |> List.map fn
        |> String.join "\n\n"
        |> Err



-- Json Encoding/Decoding


encodeSideEffectAsJson : PackageLoader.SideEffect -> Json.Value
encodeSideEffectAsJson sf =
................................................................................
encodeCompilationFailure errorMsg =
    Encode.object
        [ ( "type", Encode.string "compilationFailure" )
        , ( "error", Encode.string errorMsg )
        ]










decodePackageLoaderMsg : Json.Decoder PackageLoader.Msg
decodePackageLoaderMsg =
    let
        helper typeStr =
            case typeStr of
                "fileContents" ->

                    Json.map3 PackageLoader.FileContents
                        (Json.field "path" Json.string)
                        (Json.field "fileName" Json.string)
                        (Json.field "content" Json.string)

                "resolvedPackageModules" ->

                    Json.map2 PackageLoader.ResolvedPackageModules
                        (Json.field "package" Json.string)
                        (Json.field "modules" (Json.list Json.string))

                "resolvedDirectories" ->

                    Json.map2 PackageLoader.ResolvedDirectories
                        (Json.field "parentDir" Json.string)
                        (Json.field "paths" (Json.list packagePathDecoder))





                _ ->
                    Json.fail <| "Unknown msg type: " ++ typeStr

        packagePathDecoder =
            Json.map PackagePath.fromString Json.string
    in


>







 







>
>
|
>
>





>
>
>
>
>







 







|













|



|










>
>
>
|
>
>
>
>







 







|



|
|
|



|






|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
|





>
|
|
|
|


>
|
|
|


>
|
|
|
>
>
>
>







1
2
3
4
5
6
7
8
9
10
..
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
..
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
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155








156
157
158
159
160
161
162
...
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
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
port module CLI exposing (main)

import Dict exposing (Dict)
import Json.Decode as Json
import Json.Encode as Encode
import Platform exposing (Program)
import Set
import Stabel.Codegen as Codegen
import Stabel.Data.PackagePath as PackagePath
import Stabel.PackageLoader as PackageLoader
................................................................................
    { projectDir : String
    , entryPoint : Maybe String
    , stdLibPath : String
    }


type alias Model =
    -- TODO: Do better
    ( Maybe String
    , PackageLoader.Model
    , List TypeCheckerProblem.Problem
    )


type Msg
    = Incomming Json.Value


type CliMsg
    = FilesForErrorReporting (Dict String String)
    | PackageLoaderMsg PackageLoader.Msg


main : Program Flags Model Msg
main =
    Platform.worker
        { init = init
        , update = update
        , subscriptions = subscriptions
................................................................................
    let
        initialModel =
            PackageLoader.init
                { projectDirPath = projectDir
                , stdLibPath = stdLibPath
                }
    in
    ( ( entryPoint, initialModel, [] )
    , sendSideEffectFromModel initialModel
    )


sendSideEffectFromModel : PackageLoader.Model -> Cmd Msg
sendSideEffectFromModel model =
    PackageLoader.getSideEffect model
        |> Maybe.map encodeSideEffectAsJson
        |> Maybe.map outgoingPort
        |> Maybe.withDefault Cmd.none


update : Msg -> Model -> ( Model, Cmd Msg )
update msg (( entryPoint, packageLoaderModel, typeErrors_ ) as model) =
    case msg of
        Incomming packageLoaderMsgJson ->
            case Json.decodeValue decodePackageLoaderMsg packageLoaderMsgJson of
                Ok (PackageLoaderMsg packageLoaderMsg) ->
                    let
                        updatedModel =
                            PackageLoader.update packageLoaderMsg packageLoaderModel
                    in
                    case updatedModel of
                        PackageLoader.Done qualifiedAst ->
                            let
                                compilationResult =
                                    case TypeChecker.run qualifiedAst of
                                        Err typeErrors ->
                                            let
                                                sourceFiles =
                                                    typeErrors
                                                        |> List.map TypeCheckerProblem.sourceLocationRef
                                                        |> Set.fromList
                                                        |> Set.toList
                                            in
                                            Err ( sourceFiles, typeErrors )

                                        Ok typedAst ->
                                            let
                                                exportedFunctions =
                                                    entryPoint
                                                        |> Maybe.map Set.singleton
                                                        |> Maybe.withDefault Set.empty
................................................................................
                                            typedAst
                                                |> Codegen.run exportedFunctions
                                                |> Wasm.toString
                                                |> Ok
                            in
                            case compilationResult of
                                Ok wast ->
                                    ( ( entryPoint, updatedModel, typeErrors_ )
                                    , outgoingPort <| encodeCompilationDone wast
                                    )

                                Err ( sourceFilesRequired, errors ) ->
                                    ( ( entryPoint, updatedModel, errors )
                                    , outgoingPort <| encodeReadFilesToReportError sourceFilesRequired
                                    )

                        PackageLoader.Failed error ->
                            ( ( entryPoint, updatedModel, typeErrors_ )
                            , outgoingPort <|
                                encodeCompilationFailure <|
                                    PackageLoader.problemToString error
                            )

                        _ ->
                            ( ( entryPoint, updatedModel, typeErrors_ )
                            , sendSideEffectFromModel updatedModel
                            )

                Ok (FilesForErrorReporting files) ->
                    let
                        errorMessages =
                            typeErrors_
                                |> List.map
                                    (\problem ->
                                        files
                                            |> Dict.get (TypeCheckerProblem.sourceLocationRef problem)
                                            |> Maybe.withDefault ""
                                            |> (\source -> TypeCheckerProblem.toString source problem)
                                    )
                                |> String.join "\n\n"
                    in
                    ( model
                    , outgoingPort <|
                        encodeCompilationFailure (errorMessages ++ "\n\n")
                    )

                Err decodeError ->
                    ( model
                    , outgoingPort <|
                        encodeCompilationFailure <|
                            Json.errorToString decodeError
                    )











-- Json Encoding/Decoding


encodeSideEffectAsJson : PackageLoader.SideEffect -> Json.Value
encodeSideEffectAsJson sf =
................................................................................
encodeCompilationFailure errorMsg =
    Encode.object
        [ ( "type", Encode.string "compilationFailure" )
        , ( "error", Encode.string errorMsg )
        ]


encodeReadFilesToReportError : List String -> Json.Value
encodeReadFilesToReportError files =
    Encode.object
        [ ( "type", Encode.string "readFilesToReportError" )
        , ( "paths", Encode.list Encode.string files )
        ]


decodePackageLoaderMsg : Json.Decoder CliMsg
decodePackageLoaderMsg =
    let
        helper typeStr =
            case typeStr of
                "fileContents" ->
                    Json.map PackageLoaderMsg <|
                        Json.map3 PackageLoader.FileContents
                            (Json.field "path" Json.string)
                            (Json.field "fileName" Json.string)
                            (Json.field "content" Json.string)

                "resolvedPackageModules" ->
                    Json.map PackageLoaderMsg <|
                        Json.map2 PackageLoader.ResolvedPackageModules
                            (Json.field "package" Json.string)
                            (Json.field "modules" (Json.list Json.string))

                "resolvedDirectories" ->
                    Json.map PackageLoaderMsg <|
                        Json.map2 PackageLoader.ResolvedDirectories
                            (Json.field "parentDir" Json.string)
                            (Json.field "paths" (Json.list packagePathDecoder))

                "filesForErrorReporting" ->
                    Json.map FilesForErrorReporting
                        (Json.field "files" (Json.dict Json.string))

                _ ->
                    Json.fail <| "Unknown msg type: " ++ typeStr

        packagePathDecoder =
            Json.map PackagePath.fromString Json.string
    in

Modified src/Stabel/PackageLoader.elm from [b46871d478] to [3547ab065a].

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
                                    LoadingMetadata state pathsToLoad <|
                                        ResolveDirectories nextPathDir

                        Err err ->
                            Failed <| InvalidPackageMetadata path <| Json.errorToString err

                _ ->
                    Failed (InvalidPackageMetadata "todo: path" "Wrong message on initialization")

        LoadingMetadata state remainingPaths _ ->
            loadingMetadataUpdate msg state remainingPaths

        ResolvingModulePaths state remainingPackages _ ->
            resolvingModulePathsUpdate msg state remainingPackages








|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
                                    LoadingMetadata state pathsToLoad <|
                                        ResolveDirectories nextPathDir

                        Err err ->
                            Failed <| InvalidPackageMetadata path <| Json.errorToString err

                _ ->
                    Failed (InvalidPackageMetadata initOpts.projectDirPath "Wrong message on initialization")

        LoadingMetadata state remainingPaths _ ->
            loadingMetadataUpdate msg state remainingPaths

        ResolvingModulePaths state remainingPackages _ ->
            resolvingModulePathsUpdate msg state remainingPackages

Modified stdlib/src/core.stbl from [13ee2f2464] to [72fbb4caf8].

2
3
4
5
6
7
8

9
10
11
12
13
14
15
exposing:
  Bool
  True
  False
  not
  select
  if

  over
  drop2
  split
  zero?
  int=
  negate
  square







>







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
exposing:
  Bool
  True
  False
  not
  select
  if
  dip
  over
  drop2
  split
  zero?
  int=
  negate
  square