on 1f4709f help sign in
.github/CONTRIBUTING.md+20−18
since splitsnapshots
unifiedsplit
@@ -4,15 +4,10 @@ Thanks helping with the development of Elm! This document describes the basic
4standards for opening pull requests and making the review process as smooth as
4standards for opening pull requests and making the review process as smooth as
5possible.
5possible.
6
6
7+## Licensing
7
8
8−## Expectations
9+You need to sign the [contributor agreement](ContributorAgreement.pdf)
9−
10+and send it to <info@elm-lang.org> before opening your pull request.
10−- Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.
11−- Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md).
12−- Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc.
13−
14−Finally, please be patient with the core team. They are trying their best with limited resources!
15−
16
11
17## Style Guide
12## Style Guide
18
13
@@ -22,20 +17,27 @@ Finally, please be patient with the core team. They are trying their best with l
22[haskell]: https://gist.github.com/evancz/0a1f3717c92fe71702be
17[haskell]: https://gist.github.com/evancz/0a1f3717c92fe71702be
23[js]: https://google.github.io/styleguide/javascriptguide.xml
18[js]: https://google.github.io/styleguide/javascriptguide.xml
24
19
25−
26## Branches
20## Branches
27
21
28−[The master branch][master] is the home of the next release of the compiler
22+ * [The master branch][master] is the home of the next release of the compiler
29−so new features and improvements get merged there. Most pull requests
23+ so new features and improvements get merged there. Most pull requests
30−should target this branch!
24+ should target this branch!
31−
32−[master]: http://github.com/elm-lang/elm/tree/master
33
25
26+ * [The stable branch][stable] is for tagging releases and critical bug fixes.
27+ This branch is handy for folks who want to build the most recent public
28+ release from source.
34
29
35−## Licensing
30+[master]: http://github.com/elm-lang/elm/tree/master
36−
31+[stable]: http://github.com/elm-lang/elm/tree/stable
37−Nothing extra to do for this. The default on GitHub described [here](https://docs.github.com/en/github/site-policy/github-terms-of-service#6-contributions-under-repository-license) is that:
38
32
39−> Whenever you add Content to a repository containing notice of a license, you license that Content under the same terms, and you agree that you have the right to license that Content under those terms. If you have a separate agreement to license that Content under different terms, such as a contributor license agreement, that agreement will supersede.
33+If you are working on a fairly large feature, we will probably want to merge it
34+in as its own branch and do some testing before bringing it into the master
35+branch. This way we can keep releases of the master branch independent of new
36+features.
40
37
38+Note that the master branch of the compiler should always be in sync with the
39+master branch of the [website][], and the stable branch of the compiler should
40+always be in sync with the stable branch of the [website][]. Make sure that
41+your changes maintain this compatibility.
41
42
43+[website]: https://github.com/elm-lang/elm-lang.org
.github/PULL_REQUEST_TEMPLATE.mddeleted−18
@@ -1,18 +0,0 @@
1−
2−**Quick Summary:** ???
3−
4−
5−## SSCCE
6−
7−```elm
8−
9−```
10−
11−- **Elm:** ???
12−- **Browser:** ???
13−- **Operating System:** ???
14−
15−
16−## Additional Details
17−
18−???
.github/workflows/set-issue-expectations.ymldeleted−21
@@ -1,21 +0,0 @@
1−name: Set Issue Expectations
2−on:
3− issues:
4− types: [opened]
5−jobs:
6− comment-on-issue:
7− name: Comment On Issue
8− runs-on: ubuntu-latest
9− steps:
10− - uses: actions/github@v1.0.0
11− env:
12− GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
13− with:
14− args: |
15− comment "Thanks for reporting this! To set expectations:
16−
17− - Issues are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.
18− - Ask questions in a [community forum](https://elm-lang.org/community). You will get an answer quicker that way!
19− - If you experience something similar, open a new issue. [We like duplicates](https://github.com/elm/expectations/blob/master/duplicates.md).
20−
21− Finally, please be patient with the core team. They are trying their best with limited resources."
.github/workflows/set-pull-expectations.ymldeleted−19
@@ -1,19 +0,0 @@
1−on:
2− pull_request_target:
3− types: [opened]
4−
5−jobs:
6− comment-on-pull:
7− name: Comment On Pull
8− runs-on: ubuntu-latest
9− steps:
10− - uses: actions/github-script@v3
11− with:
12− github-token: ${{secrets.GITHUB_TOKEN}}
13− script: |
14− github.issues.createComment({
15− issue_number: context.issue.number,
16− owner: context.repo.owner,
17− repo: context.repo.repo,
18− body: "Thanks for suggesting these code changes. To set expectations:\n\n- Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.\n- Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md).\n- Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc.\n\nFinally, please be patient with the core team. They are trying their best with limited resources."
19− })
.gitignore−1
@@ -5,4 +5,3 @@ cabal-dev
5cabal.sandbox.config
5cabal.sandbox.config
6.DS_Store
6.DS_Store
7*~
7*~
8−travis.log
.travis.ymldeleted−28
@@ -1,28 +0,0 @@
1−language: minimal
2−services: docker
3−
4−env:
5− global:
6− - LINUX_ARCHIVE=binary-for-linux-64-bit.gz
7−
8−before_install:
9− - docker build -t elm -f installers/linux/Dockerfile .
10− - docker cp $(docker create elm):/usr/local/bin/elm .
11− - gzip -9 -c elm > $LINUX_ARCHIVE
12−
13−deploy:
14− provider: releases
15− api_key:
16− secure: Yz2Lo4u9rZQ7Ee7ohAsrZpkqsYDUerCSMdSQIH8ryrf7phHhiloPEkTKsM+NupHqU/LEAVsunxbau4QrCEjA2vPavAPVk8cKomRUWK/YjbXHKa24hPkal2c+A2bnMQ6w3qYk/PjL9rW+Goq++/SNLcYZwHBV0Chl2blivMwWCSA=
17− file: $LINUX_ARCHIVE
18− skip_cleanup: true
19− on:
20− branch: master
21− tags: true
22−
23−notifications:
24− email:
25− recipients:
26− - rlefevre@dmy.fr
27− on_success: change
28− on_failure: change
ContributorAgreement.pdfnew file

Binary file not shown.

LICENSE+25−6
@@ -1,11 +1,30 @@
1−Copyright 2012-present Evan Czaplicki
1+Copyright (c) 2012-present, Evan Czaplicki
2
2
3−Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
3+All rights reserved.
4
4
5−1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
6
7
8+ * Redistributions of source code must retain the above copyright
7−2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
9+ notice, this list of conditions and the following disclaimer.
8
10
9−3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
10
15
11−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
16+ * Neither the name of Evan Czaplicki nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md+5−10
@@ -1,22 +1,17 @@
1−# Elm
1+# The Elm Compiler
2
2
3−A delightful language for reliable webapps.
3+Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/).
4
4
5−Check out the [Home Page](http://elm-lang.org/), [Try Online](http://elm-lang.org/try), or [The Official Guide](http://guide.elm-lang.org/)
6−
7−
8−<br>
9
5
10## Install
6## Install
11
7
12−✨ [Install](https://guide.elm-lang.org/install/elm.html) ✨
8+Follow [these instructions][installer]!
13
9
14−For multiple versions, previous versions, and uninstallation, see the instructions [here](https://github.com/elm/compiler/blob/master/installers/README.md).
10+ [installer]: https://guide.elm-lang.org/install.html
15
11
16−<br>
17
12
18## Help
13## Help
19
14
20If you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!
15If you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!
21
16
22−[slack]: http://elmlang.herokuapp.com/
17+[slack]: http://elmlang.herokuapp.com/
builder/src/Build.hs+195−230
@@ -2,15 +2,15 @@
2{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}
2{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}
3module Build
3module Build
4 ( fromExposed
4 ( fromExposed
5− , fromPaths
5+ , fromMains
6 , fromRepl
6 , fromRepl
7 , Artifacts(..)
7 , Artifacts(..)
8− , Root(..)
8+ , Main(..)
9 , Module(..)
9 , Module(..)
10 , CachedInterface(..)
10 , CachedInterface(..)
11 , ReplArtifacts(..)
11 , ReplArtifacts(..)
12 , DocsGoal(..)
12 , DocsGoal(..)
13− , getRootNames
13+ , getMainNames
14 )
14 )
15 where
15 where
16
16
@@ -42,7 +42,6 @@ import qualified Elm.Details as Details
42import qualified Elm.Docs as Docs
42import qualified Elm.Docs as Docs
43import qualified Elm.Interface as I
43import qualified Elm.Interface as I
44import qualified Elm.ModuleName as ModuleName
44import qualified Elm.ModuleName as ModuleName
45−import qualified Elm.Outline as Outline
46import qualified Elm.Package as Pkg
45import qualified Elm.Package as Pkg
47import qualified File
46import qualified File
48import qualified Json.Encode as E
47import qualified Json.Encode as E
@@ -50,7 +49,6 @@ import qualified Parse.Module as Parse
50import qualified Reporting
49import qualified Reporting
51import qualified Reporting.Annotation as A
50import qualified Reporting.Annotation as A
52import qualified Reporting.Error as Error
51import qualified Reporting.Error as Error
53−import qualified Reporting.Error.Docs as EDocs
54import qualified Reporting.Error.Syntax as Syntax
52import qualified Reporting.Error.Syntax as Syntax
55import qualified Reporting.Error.Import as Import
53import qualified Reporting.Error.Import as Import
56import qualified Reporting.Exit as Exit
54import qualified Reporting.Exit as Exit
@@ -66,47 +64,22 @@ data Env =
66 Env
64 Env
67 { _key :: Reporting.BKey
65 { _key :: Reporting.BKey
68 , _root :: FilePath
66 , _root :: FilePath
69− , _project :: Parse.ProjectType
67+ , _pkg :: Pkg.Name
70− , _srcDirs :: [AbsoluteSrcDir]
68+ , _srcDirs :: [FilePath]
71 , _buildID :: Details.BuildID
69 , _buildID :: Details.BuildID
72 , _locals :: Map.Map ModuleName.Raw Details.Local
70 , _locals :: Map.Map ModuleName.Raw Details.Local
73 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign
71 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign
74 }
72 }
75
73
76
74
77−makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env
75+makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env
78makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =
76makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =
79 case validOutline of
77 case validOutline of
80− Details.ValidApp givenSrcDirs ->
78+ Details.ValidApp srcDirs ->
81− do srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)
82− return $ Env key root Parse.Application srcDirs buildID locals foreigns
79+ Env key root Pkg.dummyName (NE.toList srcDirs) buildID locals foreigns
83
80
84 Details.ValidPkg pkg _ _ ->
81 Details.ValidPkg pkg _ _ ->
85− do srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")
86− return $ Env key root (Parse.Package pkg) [srcDir] buildID locals foreigns
82+ Env key root pkg ["src"] buildID locals foreigns
87−
88−
89−
90−-- SOURCE DIRECTORY
91−
92−
93−newtype AbsoluteSrcDir =
94− AbsoluteSrcDir FilePath
95−
96−
97−toAbsoluteSrcDir :: FilePath -> Outline.SrcDir -> IO AbsoluteSrcDir
98−toAbsoluteSrcDir root srcDir =
99− AbsoluteSrcDir <$> Dir.canonicalizePath
100− (
101− case srcDir of
102− Outline.AbsoluteSrcDir dir -> dir
103− Outline.RelativeSrcDir dir -> root </> dir
104− )
105−
106−
107−addRelative :: AbsoluteSrcDir -> FilePath -> FilePath
108−addRelative (AbsoluteSrcDir srcDir) path =
109− srcDir </> path
110
83
111
84
112
85
@@ -137,7 +110,7 @@ forkWithKey func dict =
137fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)
110fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)
138fromExposed style root details docsGoal exposed@(NE.List e es) =
111fromExposed style root details docsGoal exposed@(NE.List e es) =
139 Reporting.trackBuild style $ \key ->
112 Reporting.trackBuild style $ \key ->
140− do env <- makeEnv key root details
113+ do let env = makeEnv key root details
141 dmvar <- Details.loadInterfaces root details
114 dmvar <- Details.loadInterfaces root details
142
115
143 -- crawl
116 -- crawl
@@ -160,18 +133,18 @@ fromExposed style root details docsGoal exposed@(NE.List e es) =
160 putMVar rmvar resultMVars
133 putMVar rmvar resultMVars
161 results <- traverse readMVar resultMVars
134 results <- traverse readMVar resultMVars
162 writeDetails root details results
135 writeDetails root details results
163− finalizeExposed root docsGoal exposed results
136+ finalizeExposed docsGoal exposed results
164
137
165
138
166
139
167−-- FROM PATHS
140+-- FROM MAINS
168
141
169
142
170data Artifacts =
143data Artifacts =
171 Artifacts
144 Artifacts
172 { _name :: Pkg.Name
145 { _name :: Pkg.Name
173 , _deps :: Dependencies
146 , _deps :: Dependencies
174− , _roots :: NE.List Root
147+ , _mains :: NE.List Main
175 , _modules :: [Module]
148 , _modules :: [Module]
176 }
149 }
177
150
@@ -185,25 +158,25 @@ type Dependencies =
185 Map.Map ModuleName.Canonical I.DependencyInterface
158 Map.Map ModuleName.Canonical I.DependencyInterface
186
159
187
160
188−fromPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
161+fromMains :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
189−fromPaths style root details paths =
162+fromMains style root details paths =
190 Reporting.trackBuild style $ \key ->
163 Reporting.trackBuild style $ \key ->
191− do env <- makeEnv key root details
164+ do let env = makeEnv key root details
192
165
193− elroots <- findRoots env paths
166+ elmains <- findMains env paths
194− case elroots of
167+ case elmains of
195 Left problem ->
168 Left problem ->
196 return (Left (Exit.BuildProjectProblem problem))
169 return (Left (Exit.BuildProjectProblem problem))
197
170
198− Right lroots ->
171+ Right lmains ->
199 do -- crawl
172 do -- crawl
200 dmvar <- Details.loadInterfaces root details
173 dmvar <- Details.loadInterfaces root details
201 smvar <- newMVar Map.empty
174 smvar <- newMVar Map.empty
202− srootMVars <- traverse (fork . crawlRoot env smvar) lroots
175+ smainMVars <- traverse (fork . crawlMain env smvar) lmains
203− sroots <- traverse readMVar srootMVars
176+ smains <- traverse readMVar smainMVars
204 statuses <- traverse readMVar =<< readMVar smvar
177 statuses <- traverse readMVar =<< readMVar smvar
205
178
206− midpoint <- checkMidpointAndRoots dmvar statuses sroots
179+ midpoint <- checkMainsMidpoint dmvar statuses smains
207 case midpoint of
180 case midpoint of
208 Left problem ->
181 Left problem ->
209 return (Left (Exit.BuildProjectProblem problem))
182 return (Left (Exit.BuildProjectProblem problem))
@@ -213,24 +186,24 @@ fromPaths style root details paths =
213 rmvar <- newEmptyMVar
186 rmvar <- newEmptyMVar
214 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
187 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
215 putMVar rmvar resultsMVars
188 putMVar rmvar resultsMVars
216− rrootMVars <- traverse (fork . checkRoot env resultsMVars) sroots
189+ rmainMVars <- traverse (fork . checkMain env resultsMVars) smains
217 results <- traverse readMVar resultsMVars
190 results <- traverse readMVar resultsMVars
218 writeDetails root details results
191 writeDetails root details results
219− toArtifacts env foreigns results <$> traverse readMVar rrootMVars
192+ toArtifacts env foreigns results <$> traverse readMVar rmainMVars
220
193
221
194
222
195
223−-- GET ROOT NAMES
196+-- GET MAIN NAMES
224
197
225
198
226−getRootNames :: Artifacts -> NE.List ModuleName.Raw
199+getMainNames :: Artifacts -> NE.List ModuleName.Raw
227−getRootNames (Artifacts _ _ roots _) =
200+getMainNames (Artifacts _ _ mains _) =
228− fmap getRootName roots
201+ fmap getMainName mains
229
202
230
203
231−getRootName :: Root -> ModuleName.Raw
204+getMainName :: Main -> ModuleName.Raw
232−getRootName root =
205+getMainName main =
233− case root of
206+ case main of
234 Inside name -> name
207 Inside name -> name
235 Outside name _ _ -> name
208 Outside name _ _ -> name
236
209
@@ -266,10 +239,11 @@ crawlDeps env mvar deps blockedValue =
266
239
267
240
268crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status
241crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status
269−crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name =
242+crawlModule env@(Env _ root pkg srcDirs buildID locals foreigns) mvar docsNeed name =
270 do let fileName = ModuleName.toFilePath name <.> "elm"
243 do let fileName = ModuleName.toFilePath name <.> "elm"
244+ let inRoot path = File.exists (root </> path)
271
245
272− paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)
246+ paths <- filterM inRoot (map (</> fileName) srcDirs)
273
247
274 case paths of
248 case paths of
275 [path] ->
249 [path] ->
@@ -289,7 +263,7 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do
289 else crawlDeps env mvar deps (SCached local)
263 else crawlDeps env mvar deps (SCached local)
290
264
291 p1:p2:ps ->
265 p1:p2:ps ->
292− return $ SBadImport $ Import.AmbiguousLocal (FP.makeRelative root p1) (FP.makeRelative root p2) (map (FP.makeRelative root) ps)
266+ return $ SBadImport $ Import.AmbiguousLocal p1 p2 ps
293
267
294 [] ->
268 [] ->
295 case Map.lookup name foreigns of
269 case Map.lookup name foreigns of
@@ -302,7 +276,7 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do
302 return $ SBadImport $ Import.AmbiguousForeign dep d ds
276 return $ SBadImport $ Import.AmbiguousForeign dep d ds
303
277
304 Nothing ->
278 Nothing ->
305− if Name.isKernel name && Parse.isKernel projectType then
279+ if Name.isKernel name && Pkg.isKernel pkg then
306 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
280 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
307 return $ if exists then SKernel else SBadImport Import.NotFound
281 return $ if exists then SKernel else SBadImport Import.NotFound
308 else
282 else
@@ -310,10 +284,10 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do
310
284
311
285
312crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> File.Time -> Details.BuildID -> IO Status
286crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> File.Time -> Details.BuildID -> IO Status
313−crawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName path time lastChange =
287+crawlFile env@(Env _ root pkg _ buildID _ _) mvar docsNeed expectedName path time lastChange =
314 do source <- File.readUtf8 (root </> path)
288 do source <- File.readUtf8 (root </> path)
315
289
316− case Parse.fromByteString projectType source of
290+ case Parse.fromByteString pkg source of
317 Left err ->
291 Left err ->
318 return $ SBadSyntax path time source err
292 return $ SBadSyntax path time source err
319
293
@@ -364,7 +338,7 @@ data CachedInterface
364
338
365
339
366checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result
340checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result
367−checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name status =
341+checkModule env@(Env _ root pkg _ _ _ _) foreigns resultsMVar name status =
368 case status of
342 case status of
369 SCached local@(Details.Local path time deps hasMain lastChange lastCompile) ->
343 SCached local@(Details.Local path time deps hasMain lastChange lastCompile) ->
370 do results <- readMVar resultsMVar
344 do results <- readMVar resultsMVar
@@ -372,7 +346,7 @@ checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name statu
372 case depsStatus of
346 case depsStatus of
373 DepsChange ifaces ->
347 DepsChange ifaces ->
374 do source <- File.readUtf8 path
348 do source <- File.readUtf8 path
375− case Parse.fromByteString projectType source of
349+ case Parse.fromByteString pkg source of
376 Right modul -> compile env (DocsNeed False) local source ifaces modul
350 Right modul -> compile env (DocsNeed False) local source ifaces modul
377 Left err ->
351 Left err ->
378 return $ RProblem $
352 return $ RProblem $
@@ -388,7 +362,7 @@ checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name statu
388 DepsNotFound problems ->
362 DepsNotFound problems ->
389 do source <- File.readUtf8 path
363 do source <- File.readUtf8 path
390 return $ RProblem $ Error.Module name path time source $
364 return $ RProblem $ Error.Module name path time source $
391− case Parse.fromByteString projectType source of
365+ case Parse.fromByteString pkg source of
392 Right (Src.Module _ _ _ imports _ _ _ _ _) ->
366 Right (Src.Module _ _ _ imports _ _ _ _ _) ->
393 Error.BadImports (toImportErrors env results imports problems)
367 Error.BadImports (toImportErrors env results imports problems)
394
368
@@ -585,11 +559,11 @@ checkMidpoint dmvar statuses =
585 return (Left (Exit.BP_Cycle name names))
559 return (Left (Exit.BP_Cycle name names))
586
560
587
561
588−checkMidpointAndRoots :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List RootStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
562+checkMainsMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List MainStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
589−checkMidpointAndRoots dmvar statuses sroots =
563+checkMainsMidpoint dmvar statuses smains =
590 case checkForCycles statuses of
564 case checkForCycles statuses of
591 Nothing ->
565 Nothing ->
592− case checkUniqueRoots statuses sroots of
566+ case checkUniqueMains statuses smains of
593 Nothing ->
567 Nothing ->
594 do maybeForeigns <- readMVar dmvar
568 do maybeForeigns <- readMVar dmvar
595 case maybeForeigns of
569 case maybeForeigns of
@@ -651,14 +625,14 @@ addToGraph name status graph =
651
625
652
626
653
627
654−-- CHECK UNIQUE ROOTS
628+-- CHECK UNIQUE MAINS
655
629
656
630
657−checkUniqueRoots :: Map.Map ModuleName.Raw Status -> NE.List RootStatus -> Maybe Exit.BuildProjectProblem
631+checkUniqueMains :: Map.Map ModuleName.Raw Status -> NE.List MainStatus -> Maybe Exit.BuildProjectProblem
658−checkUniqueRoots insides sroots =
632+checkUniqueMains insides smains =
659 let
633 let
660 outsidesDict =
634 outsidesDict =
661− Map.fromListWith OneOrMore.more (Maybe.mapMaybe rootStatusToNamePathPair (NE.toList sroots))
635+ Map.fromListWith OneOrMore.more (Maybe.mapMaybe mainStatusToNamePathPair (NE.toList smains))
662 in
636 in
663 case Map.traverseWithKey checkOutside outsidesDict of
637 case Map.traverseWithKey checkOutside outsidesDict of
664 Left problem ->
638 Left problem ->
@@ -670,9 +644,9 @@ checkUniqueRoots insides sroots =
670 Left problem -> Just problem
644 Left problem -> Just problem
671
645
672
646
673−rootStatusToNamePathPair :: RootStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
647+mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
674−rootStatusToNamePathPair sroot =
648+mainStatusToNamePathPair smain =
675− case sroot of
649+ case smain of
676 SInside _ -> Nothing
650 SInside _ -> Nothing
677 SOutsideOk (Details.Local path _ _ _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
651 SOutsideOk (Details.Local path _ _ _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
678 SOutsideErr _ -> Nothing
652 SOutsideErr _ -> Nothing
@@ -682,14 +656,14 @@ checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.Bu
682checkOutside name paths =
656checkOutside name paths =
683 case OneOrMore.destruct NE.List paths of
657 case OneOrMore.destruct NE.List paths of
684 NE.List p [] -> Right p
658 NE.List p [] -> Right p
685− NE.List p1 (p2:_) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
659+ NE.List p1 (p2:_) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
686
660
687
661
688checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
662checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
689checkInside name p1 status =
663checkInside name p1 status =
690 case status of
664 case status of
691− SCached (Details.Local p2 _ _ _ _ _) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
665+ SCached (Details.Local p2 _ _ _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
692− SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_RootNameDuplicate name p1 p2)
666+ SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
693 SBadImport _ -> Right ()
667 SBadImport _ -> Right ()
694 SBadSyntax _ _ _ _ -> Right ()
668 SBadSyntax _ _ _ _ -> Right ()
695 SForeign _ -> Right ()
669 SForeign _ -> Right ()
@@ -701,49 +675,34 @@ checkInside name p1 status =
701
675
702
676
703compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
677compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
704−compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =
678+compile (Env key root pkg _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =
705− let
706− pkg = projectTypeToPkg projectType
707− in
708 case Compile.compile pkg ifaces modul of
679 case Compile.compile pkg ifaces modul of
709 Right (Compile.Artifacts canonical annotations objects) ->
680 Right (Compile.Artifacts canonical annotations objects) ->
710− case makeDocs docsNeed canonical of
711− Left err ->
712− return $ RProblem $
713− Error.Module (Src.getName modul) path time source (Error.BadDocs err)
714−
715− Right docs ->
716− do let name = Src.getName modul
681+ do let name = Src.getName modul
717− let iface = I.fromModule pkg canonical annotations
682+ let iface = I.fromModule pkg canonical annotations
683+ let docs = makeDocs docsNeed canonical
718− let elmi = Stuff.elmi root name
684+ let elmi = Stuff.elmi root name
719− File.writeBinary (Stuff.elmo root name) objects
685+ File.writeBinary (Stuff.elmo root name) objects
720− maybeOldi <- File.readBinary elmi
686+ maybeOldi <- File.readBinary elmi
721− case maybeOldi of
687+ case maybeOldi of
722− Just oldi | oldi == iface ->
688+ Just oldi | oldi == iface ->
723− do -- iface should be fully forced by equality check
689+ do -- iface should be fully forced by equality check
724− Reporting.report key Reporting.BDone
690+ Reporting.report key Reporting.BDone
725− let local = Details.Local path time deps main lastChange buildID
691+ let local = Details.Local path time deps main lastChange buildID
726− return (RSame local iface objects docs)
692+ return (RSame local iface objects docs)
727−
693+
728− _ ->
694+ _ ->
729− do -- iface may be lazy still
695+ do -- iface may be lazy still
730− File.writeBinary elmi iface
696+ File.writeBinary elmi iface
731− Reporting.report key Reporting.BDone
697+ Reporting.report key Reporting.BDone
732− let local = Details.Local path time deps main buildID buildID
698+ let local = Details.Local path time deps main buildID buildID
733− return (RNew local iface objects docs)
699+ return (RNew local iface objects docs)
734
700
735 Left err ->
701 Left err ->
736 return $ RProblem $
702 return $ RProblem $
737 Error.Module (Src.getName modul) path time source err
703 Error.Module (Src.getName modul) path time source err
738
704
739
705
740−projectTypeToPkg :: Parse.ProjectType -> Pkg.Name
741−projectTypeToPkg projectType =
742− case projectType of
743− Parse.Package pkg -> pkg
744− Parse.Application -> Pkg.dummyName
745−
746−
747
706
748-- WRITE DETAILS
707-- WRITE DETAILS
749
708
@@ -771,8 +730,8 @@ addNewLocal name result locals =
771-- FINALIZE EXPOSED
730-- FINALIZE EXPOSED
772
731
773
732
774−finalizeExposed :: FilePath -> DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
733+finalizeExposed :: DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
775−finalizeExposed root docsGoal exposed results =
734+finalizeExposed docsGoal exposed results =
776 case foldr (addImportProblems results) [] (NE.toList exposed) of
735 case foldr (addImportProblems results) [] (NE.toList exposed) of
777 p:ps ->
736 p:ps ->
778 return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))
737 return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))
@@ -780,7 +739,7 @@ finalizeExposed root docsGoal exposed results =
780 [] ->
739 [] ->
781 case Map.foldr addErrors [] results of
740 case Map.foldr addErrors [] results of
782 [] -> Right <$> finalizeDocs docsGoal results
741 [] -> Right <$> finalizeDocs docsGoal results
783− e:es -> return $ Left $ Exit.BuildBadModules root e es
742+ e:es -> return $ Left $ Exit.BuildBadModules e es
784
743
785
744
786addErrors :: Result -> [Error.Module] -> [Error.Module]
745addErrors :: Result -> [Error.Module] -> [Error.Module]
@@ -831,14 +790,14 @@ toDocsNeed goal =
831 KeepDocs -> DocsNeed True
790 KeepDocs -> DocsNeed True
832
791
833
792
834−makeDocs :: DocsNeed -> Can.Module -> Either EDocs.Error (Maybe Docs.Module)
793+makeDocs :: DocsNeed -> Can.Module -> Maybe Docs.Module
835makeDocs (DocsNeed isNeeded) modul =
794makeDocs (DocsNeed isNeeded) modul =
836 if isNeeded then
795 if isNeeded then
837 case Docs.fromModule modul of
796 case Docs.fromModule modul of
838− Right docs -> Right (Just docs)
797+ Right docs -> Just docs
839− Left err -> Left err
798+ Left _ -> Nothing
840 else
799 else
841− Right Nothing
800+ Nothing
842
801
843
802
844finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs
803finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs
@@ -887,41 +846,40 @@ data ReplArtifacts =
887
846
888fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
847fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
889fromRepl root details source =
848fromRepl root details source =
849+ let
890− do env@(Env _ _ projectType _ _ _ _) <- makeEnv Reporting.ignorer root details
850+ env@(Env _ _ pkg _ _ _ _) = makeEnv Reporting.ignorer root details
851+ in
891− case Parse.fromByteString projectType source of
852+ case Parse.fromByteString pkg source of
892− Left syntaxError ->
853+ Left syntaxError ->
893− return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
854+ return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
894
855
895− Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
856+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
896− do dmvar <- Details.loadInterfaces root details
857+ do dmvar <- Details.loadInterfaces root details
897
858
898− let deps = map Src.getImportName imports
859+ let deps = map Src.getImportName imports
899− mvar <- newMVar Map.empty
860+ mvar <- newMVar Map.empty
900− crawlDeps env mvar deps ()
861+ crawlDeps env mvar deps ()
901
862
902− statuses <- traverse readMVar =<< readMVar mvar
863+ statuses <- traverse readMVar =<< readMVar mvar
903− midpoint <- checkMidpoint dmvar statuses
864+ midpoint <- checkMidpoint dmvar statuses
904
865
905− case midpoint of
866+ case midpoint of
906− Left problem ->
867+ Left problem ->
907− return $ Left $ Exit.ReplProjectProblem problem
868+ return $ Left $ Exit.ReplProjectProblem problem
908
869
909− Right foreigns ->
870+ Right foreigns ->
910− do rmvar <- newEmptyMVar
871+ do rmvar <- newEmptyMVar
911− resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
872+ resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
912− putMVar rmvar resultMVars
873+ putMVar rmvar resultMVars
913− results <- traverse readMVar resultMVars
874+ results <- traverse readMVar resultMVars
914− writeDetails root details results
875+ writeDetails root details results
915− depsStatus <- checkDeps root resultMVars deps 0
876+ depsStatus <- checkDeps root resultMVars deps 0
916− finalizeReplArtifacts env source modul depsStatus resultMVars results
877+ finalizeReplArtifacts env source modul depsStatus resultMVars results
917
878
918
879
919finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
880finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
920−finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
881+finalizeReplArtifacts env@(Env _ root pkg _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
921 let
882 let
922− pkg =
923− projectTypeToPkg projectType
924−
925 compileInput ifaces =
883 compileInput ifaces =
926 case Compile.compile pkg ifaces modul of
884 case Compile.compile pkg ifaces modul of
927 Right (Compile.Artifacts canonical annotations objects) ->
885 Right (Compile.Artifacts canonical annotations objects) ->
@@ -948,7 +906,7 @@ finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Mod
948 DepsBlock ->
906 DepsBlock ->
949 case Map.foldr addErrors [] results of
907 case Map.foldr addErrors [] results of
950 [] -> return $ Left $ Exit.ReplBlocked
908 [] -> return $ Left $ Exit.ReplBlocked
951− e:es -> return $ Left $ Exit.ReplBadLocalDeps root e es
909+ e:es -> return $ Left $ Exit.ReplBadLocalDeps e es
952
910
953 DepsNotFound problems ->
911 DepsNotFound problems ->
954 return $ Left $ Exit.ReplBadInput source $ Error.BadImports $
912 return $ Left $ Exit.ReplBadInput source $ Error.BadImports $
@@ -964,25 +922,25 @@ finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Mod
964
922
965
923
966
924
967−-- FIND ROOT
925+-- FIND MAIN
968
926
969
927
970−data RootLocation
928+data MainLocation
971 = LInside ModuleName.Raw
929 = LInside ModuleName.Raw
972 | LOutside FilePath
930 | LOutside FilePath
973
931
974
932
975−findRoots :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List RootLocation))
933+findMains :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List MainLocation))
976−findRoots env paths =
934+findMains env paths =
977− do mvars <- traverse (fork . getRootInfo env) paths
935+ do mvars <- traverse (fork . findLocation env) paths
978− einfos <- traverse readMVar mvars
936+ elocs <- traverse readMVar mvars
979− return $ checkRoots =<< sequence einfos
937+ return $ checkLocations =<< sequence elocs
980
938
981
939
982−checkRoots :: NE.List RootInfo -> Either Exit.BuildProjectProblem (NE.List RootLocation)
940+checkLocations :: NE.List Location -> Either Exit.BuildProjectProblem (NE.List MainLocation)
983−checkRoots infos =
941+checkLocations locations =
984 let
942 let
985− toOneOrMore loc@(RootInfo absolute _ _) =
943+ toOneOrMore loc@(Location absolute _ _) =
986 (absolute, OneOrMore.one loc)
944 (absolute, OneOrMore.one loc)
987
945
988 fromOneOrMore loc locs =
946 fromOneOrMore loc locs =
@@ -990,33 +948,33 @@ checkRoots infos =
990 [] -> Right ()
948 [] -> Right ()
991 loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))
949 loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))
992 in
950 in
993− fmap (\_ -> fmap _location infos) $
951+ fmap (\_ -> fmap _location locations) $
994 traverse (OneOrMore.destruct fromOneOrMore) $
952 traverse (OneOrMore.destruct fromOneOrMore) $
995− Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList infos)
953+ Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList locations)
996
954
997
955
998
956
999−-- ROOT INFO
957+-- LOCATIONS
1000
958
1001
959
1002−data RootInfo =
960+data Location =
1003− RootInfo
961+ Location
1004 { _absolute :: FilePath
962 { _absolute :: FilePath
1005 , _relative :: FilePath
963 , _relative :: FilePath
1006− , _location :: RootLocation
964+ , _location :: MainLocation
1007 }
965 }
1008
966
1009
967
1010−getRootInfo :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
968+findLocation :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem Location)
1011−getRootInfo env path =
969+findLocation env path =
1012 do exists <- File.exists path
970 do exists <- File.exists path
1013 if exists
971 if exists
1014− then getRootInfoHelp env path =<< Dir.canonicalizePath path
972+ then findLoc env path =<< Dir.canonicalizePath path
1015 else return (Left (Exit.BP_PathUnknown path))
973 else return (Left (Exit.BP_PathUnknown path))
1016
974
1017
975
1018−getRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
976+findLoc :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem Location)
1019−getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
977+findLoc (Env _ root _ srcDirs _ _ _) path absolutePath =
1020 let
978 let
1021 (dirs, file) = FP.splitFileName absolutePath
979 (dirs, file) = FP.splitFileName absolutePath
1022 (final, ext) = FP.splitExtension file
980 (final, ext) = FP.splitExtension file
@@ -1026,39 +984,45 @@ getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
1026 return $ Left $ Exit.BP_WithBadExtension path
984 return $ Left $ Exit.BP_WithBadExtension path
1027 else
985 else
1028 let
986 let
987+ roots = FP.splitDirectories root
1029− absoluteSegments = FP.splitDirectories dirs ++ [final]
988+ segments = FP.splitDirectories dirs ++ [final]
1030 in
989 in
1031− case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of
990+ case dropPrefix roots segments of
1032− [] ->
991+ Nothing ->
1033− return $ Right $ RootInfo absolutePath path (LOutside path)
992+ return $ Right $ Location absolutePath path (LOutside path)
1034
993
1035− [(_, Right names)] ->
994+ Just relativeSegments ->
1036− do let name = Name.fromChars (List.intercalate "." names)
995+ case Maybe.mapMaybe (isInsideSrcDirByPath relativeSegments) srcDirs of
1037− matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs
996+ [] ->
1038− case matchingDirs of
997+ return $ Right $ Location absolutePath path (LOutside path)
1039− d1:d2:_ ->
1040− do let p1 = addRelative d1 (FP.joinPath names <.> "elm")
1041− let p2 = addRelative d2 (FP.joinPath names <.> "elm")
1042− return $ Left $ Exit.BP_RootNameDuplicate name p1 p2
1043
998
1044− _ ->
999+ [(_, Right names)] ->
1045− return $ Right $ RootInfo absolutePath path (LInside name)
1000+ do let name = Name.fromChars (List.intercalate "." names)
1001+ matchingDirs <- filterM (isInsideSrcDirByName root names) srcDirs
1002+ case matchingDirs of
1003+ d1:d2:_ ->
1004+ do let p1 = d1 </> FP.joinPath names <.> "elm"
1005+ let p2 = d2 </> FP.joinPath names <.> "elm"
1006+ return $ Left $ Exit.BP_MainNameDuplicate name p1 p2
1046
1007
1047− [(s, Left names)] ->
1008+ _ ->
1048− return $ Left $ Exit.BP_RootNameInvalid path s names
1009+ return $ Right $ Location absolutePath path (LInside name)
1049
1010
1050− (s1,_):(s2,_):_ ->
1011+ [(s, Left names)] ->
1051− return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
1012+ return $ Left $ Exit.BP_MainNameInvalid path s names
1052
1013
1014+ (s1,_):(s2,_):_ ->
1015+ return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
1053
1016
1054
1017
1055−isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
1056−isInsideSrcDirByName names srcDir =
1057− File.exists (addRelative srcDir (FP.joinPath names <.> "elm"))
1058
1018
1019+isInsideSrcDirByName :: FilePath -> [String] -> FilePath -> IO Bool
1020+isInsideSrcDirByName root names srcDir =
1021+ File.exists (root </> srcDir </> FP.joinPath names <.> "elm")
1059
1022
1023+
1060−isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])
1024+isInsideSrcDirByPath :: [String] -> FilePath -> Maybe (FilePath, Either [String] [String])
1061−isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
1025+isInsideSrcDirByPath segments srcDir =
1062 case dropPrefix (FP.splitDirectories srcDir) segments of
1026 case dropPrefix (FP.splitDirectories srcDir) segments of
1063 Nothing ->
1027 Nothing ->
1064 Nothing
1028 Nothing
@@ -1079,33 +1043,35 @@ isGoodName name =
1079 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars
1043 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars
1080
1044
1081
1045
1082−-- INVARIANT: Dir.canonicalizePath has been run on both inputs
1083−--
1084dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]
1046dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]
1085dropPrefix roots paths =
1047dropPrefix roots paths =
1086 case roots of
1048 case roots of
1087 [] ->
1049 [] ->
1088 Just paths
1050 Just paths
1089
1051
1052+ ".":rs ->
1053+ dropPrefix rs paths
1054+
1090 r:rs ->
1055 r:rs ->
1091 case paths of
1056 case paths of
1092− [] -> Nothing
1057+ [] -> Nothing
1058+ ".":ps -> dropPrefix roots ps
1093− p:ps -> if r == p then dropPrefix rs ps else Nothing
1059+ p:ps -> if r == p then dropPrefix rs ps else Nothing
1094
1060
1095
1061
1096
1062
1097−-- CRAWL ROOTS
1063+-- CRAWL MAINS
1098
1064
1099
1065
1100−data RootStatus
1066+data MainStatus
1101 = SInside ModuleName.Raw
1067 = SInside ModuleName.Raw
1102 | SOutsideOk Details.Local B.ByteString Src.Module
1068 | SOutsideOk Details.Local B.ByteString Src.Module
1103 | SOutsideErr Error.Module
1069 | SOutsideErr Error.Module
1104
1070
1105
1071
1106−crawlRoot :: Env -> MVar StatusDict -> RootLocation -> IO RootStatus
1072+crawlMain :: Env -> MVar StatusDict -> MainLocation -> IO MainStatus
1107−crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
1073+crawlMain env@(Env _ _ pkg _ buildID _ _) mvar given =
1108− case root of
1074+ case given of
1109 LInside name ->
1075 LInside name ->
1110 do statusMVar <- newEmptyMVar
1076 do statusMVar <- newEmptyMVar
1111 statusDict <- takeMVar mvar
1077 statusDict <- takeMVar mvar
@@ -1116,7 +1082,7 @@ crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
1116 LOutside path ->
1082 LOutside path ->
1117 do time <- File.getTime path
1083 do time <- File.getTime path
1118 source <- File.readUtf8 path
1084 source <- File.readUtf8 path
1119− case Parse.fromByteString projectType source of
1085+ case Parse.fromByteString pkg source of
1120 Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->
1086 Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->
1121 do let deps = map Src.getImportName imports
1087 do let deps = map Src.getImportName imports
1122 let local = Details.Local path time deps (any isMain values) buildID buildID
1088 let local = Details.Local path time deps (any isMain values) buildID buildID
@@ -1128,19 +1094,19 @@ crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
1128
1094
1129
1095
1130
1096
1131−-- CHECK ROOTS
1097+-- CHECK MAINS
1132
1098
1133
1099
1134−data RootResult
1100+data MainResult
1135 = RInside ModuleName.Raw
1101 = RInside ModuleName.Raw
1136 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph
1102 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph
1137 | ROutsideErr Error.Module
1103 | ROutsideErr Error.Module
1138 | ROutsideBlocked
1104 | ROutsideBlocked
1139
1105
1140
1106
1141−checkRoot :: Env -> ResultDict -> RootStatus -> IO RootResult
1107+checkMain :: Env -> ResultDict -> MainStatus -> IO MainResult
1142−checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =
1108+checkMain env@(Env _ root _ _ _ _ _) results pendingMain =
1143− case rootStatus of
1109+ case pendingMain of
1144 SInside name ->
1110 SInside name ->
1145 return (RInside name)
1111 return (RInside name)
1146
1112
@@ -1167,10 +1133,9 @@ checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =
1167 Error.BadImports (toImportErrors env results imports problems)
1133 Error.BadImports (toImportErrors env results imports problems)
1168
1134
1169
1135
1170−compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO RootResult
1136+compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO MainResult
1171−compileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =
1137+compileOutside (Env key _ pkg _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =
1172 let
1138 let
1173− pkg = projectTypeToPkg projectType
1174 name = Src.getName modul
1139 name = Src.getName modul
1175 in
1140 in
1176 case Compile.compile pkg ifaces modul of
1141 case Compile.compile pkg ifaces modul of
@@ -1186,35 +1151,35 @@ compileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _)
1186-- TO ARTIFACTS
1151-- TO ARTIFACTS
1187
1152
1188
1153
1189−data Root
1154+data Main
1190 = Inside ModuleName.Raw
1155 = Inside ModuleName.Raw
1191 | Outside ModuleName.Raw I.Interface Opt.LocalGraph
1156 | Outside ModuleName.Raw I.Interface Opt.LocalGraph
1192
1157
1193
1158
1194−toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either Exit.BuildProblem Artifacts
1159+toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either Exit.BuildProblem Artifacts
1195−toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults =
1160+toArtifacts (Env _ _ pkg _ _ _ _) foreigns results mainResults =
1196− case gatherProblemsOrMains results rootResults of
1161+ case gatherProblemsOrMains results mainResults of
1197 Left (NE.List e es) ->
1162 Left (NE.List e es) ->
1198− Left (Exit.BuildBadModules root e es)
1163+ Left (Exit.BuildBadModules e es)
1199
1164
1200− Right roots ->
1165+ Right mains ->
1201− Right $ Artifacts (projectTypeToPkg projectType) foreigns roots $
1166+ Right $ Artifacts pkg foreigns mains $
1202− Map.foldrWithKey addInside (foldr addOutside [] rootResults) results
1167+ Map.foldrWithKey addInside (foldr addOutside [] mainResults) results
1203
1168
1204
1169
1205−gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either (NE.List Error.Module) (NE.List Root)
1170+gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either (NE.List Error.Module) (NE.List Main)
1206−gatherProblemsOrMains results (NE.List rootResult rootResults) =
1171+gatherProblemsOrMains results (NE.List mainResult mainResults) =
1207 let
1172 let
1208− addResult result (es, roots) =
1173+ sortMain result (es, mains) =
1209 case result of
1174 case result of
1210− RInside n -> ( es, Inside n : roots)
1175+ RInside n -> ( es, Inside n : mains)
1211− ROutsideOk n i o -> ( es, Outside n i o : roots)
1176+ ROutsideOk n i o -> ( es, Outside n i o : mains)
1212− ROutsideErr e -> (e:es, roots)
1177+ ROutsideErr e -> (e:es, mains)
1213− ROutsideBlocked -> ( es, roots)
1178+ ROutsideBlocked -> ( es, mains)
1214
1179
1215 errors = Map.foldr addErrors [] results
1180 errors = Map.foldr addErrors [] results
1216 in
1181 in
1217− case (rootResult, foldr addResult (errors, []) rootResults) of
1182+ case (mainResult, foldr sortMain (errors, []) mainResults) of
1218 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)
1183 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)
1219 (RInside _ , (e:es, _ )) -> Left (NE.List e es)
1184 (RInside _ , (e:es, _ )) -> Left (NE.List e es)
1220 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
1185 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
@@ -1242,9 +1207,9 @@ badInside name =
1242 "Error from `" ++ Name.toChars name ++ "` should have been reported already."
1207 "Error from `" ++ Name.toChars name ++ "` should have been reported already."
1243
1208
1244
1209
1245−addOutside :: RootResult -> [Module] -> [Module]
1210+addOutside :: MainResult -> [Module] -> [Module]
1246−addOutside root modules =
1211+addOutside main modules =
1247− case root of
1212+ case main of
1248 RInside _ -> modules
1213 RInside _ -> modules
1249 ROutsideOk name iface objs -> Fresh name iface objs : modules
1214 ROutsideOk name iface objs -> Fresh name iface objs : modules
1250 ROutsideErr _ -> modules
1215 ROutsideErr _ -> modules
builder/src/Elm/Details.hs+2−2
@@ -79,7 +79,7 @@ type BuildID = Word64
79
79
80
80
81data ValidOutline
81data ValidOutline
82− = ValidApp (NE.List Outline.SrcDir)
82+ = ValidApp (NE.List FilePath)
83 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})
83 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})
84
84
85
85
@@ -595,7 +595,7 @@ crawlModule foreignDeps mvar pkg src docsStatus name =
595crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
595crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
596crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
596crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
597 do bytes <- File.readUtf8 path
597 do bytes <- File.readUtf8 path
598− case Parse.fromByteString (Parse.Package pkg) bytes of
598+ case Parse.fromByteString pkg bytes of
599 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->
599 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->
600 do deps <- crawlImports foreignDeps mvar pkg src imports
600 do deps <- crawlImports foreignDeps mvar pkg src imports
601 return (Just (SLocal docsStatus deps modul))
601 return (Just (SLocal docsStatus deps modul))
builder/src/Elm/Outline.hs+12−96
@@ -5,7 +5,6 @@ module Elm.Outline
5 , AppOutline(..)
5 , AppOutline(..)
6 , PkgOutline(..)
6 , PkgOutline(..)
7 , Exposed(..)
7 , Exposed(..)
8− , SrcDir(..)
9 , read
8 , read
10 , write
9 , write
11 , encode
10 , encode
@@ -17,14 +16,11 @@ module Elm.Outline
17
16
18
17
19import Prelude hiding (read)
18import Prelude hiding (read)
20−import Control.Monad (filterM, liftM)
19+import Control.Monad (filterM)
21−import Data.Binary (Binary, get, put, getWord8, putWord8)
22import qualified Data.Map as Map
20import qualified Data.Map as Map
23import qualified Data.NonEmptyList as NE
21import qualified Data.NonEmptyList as NE
24−import qualified Data.OneOrMore as OneOrMore
25import Foreign.Ptr (minusPtr)
22import Foreign.Ptr (minusPtr)
26import qualified System.Directory as Dir
23import qualified System.Directory as Dir
27−import qualified System.FilePath as FP
28import System.FilePath ((</>))
24import System.FilePath ((</>))
29
25
30import qualified Elm.Constraint as Con
26import qualified Elm.Constraint as Con
@@ -53,7 +49,7 @@ data Outline
53data AppOutline =
49data AppOutline =
54 AppOutline
50 AppOutline
55 { _app_elm_version :: V.Version
51 { _app_elm_version :: V.Version
56− , _app_source_dirs :: NE.List SrcDir
52+ , _app_source_dirs :: NE.List FilePath
57 , _app_deps_direct :: Map.Map Pkg.Name V.Version
53 , _app_deps_direct :: Map.Map Pkg.Name V.Version
58 , _app_deps_indirect :: Map.Map Pkg.Name V.Version
54 , _app_deps_indirect :: Map.Map Pkg.Name V.Version
59 , _app_test_direct :: Map.Map Pkg.Name V.Version
55 , _app_test_direct :: Map.Map Pkg.Name V.Version
@@ -79,11 +75,6 @@ data Exposed
79 | ExposedDict [(Json.String, [ModuleName.Raw])]
75 | ExposedDict [(Json.String, [ModuleName.Raw])]
80
76
81
77
82−data SrcDir
83− = AbsoluteSrcDir FilePath
84− | RelativeSrcDir FilePath
85−
86−
87
78
88-- DEFAULTS
79-- DEFAULTS
89
80
@@ -126,7 +117,7 @@ encode outline =
126 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->
117 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->
127 E.object
118 E.object
128 [ "type" ==> E.chars "application"
119 [ "type" ==> E.chars "application"
129− , "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs)
120+ , "source-directories" ==> E.list E.chars (NE.toList srcDirs)
130 , "elm-version" ==> V.encode elm
121 , "elm-version" ==> V.encode elm
131 , "dependencies" ==>
122 , "dependencies" ==>
132 E.object
123 E.object
@@ -174,13 +165,6 @@ encodeDeps encodeValue deps =
174 E.dict Pkg.toJsonString encodeValue deps
165 E.dict Pkg.toJsonString encodeValue deps
175
166
176
167
177−encodeSrcDir :: SrcDir -> E.Value
178−encodeSrcDir srcDir =
179− case srcDir of
180− AbsoluteSrcDir dir -> E.chars dir
181− RelativeSrcDir dir -> E.chars dir
182−
183−
184
168
185-- PARSE AND VERIFY
169-- PARSE AND VERIFY
186
170
@@ -208,58 +192,15 @@ read root =
208 return $ Left Exit.OutlineNoAppJson
192 return $ Left Exit.OutlineNoAppJson
209
193
210 | otherwise ->
194 | otherwise ->
211− do badDirs <- filterM (isSrcDirMissing root) (NE.toList srcDirs)
195+ do badDirs <- filterM (isBadSrcDir root) (NE.toList srcDirs)
212− case map toGiven badDirs of
196+ case badDirs of
213− d:ds ->
214− return $ Left (Exit.OutlineHasMissingSrcDirs d ds)
215−
216− [] ->
217− do maybeDups <- detectDuplicates root (NE.toList srcDirs)
218− case maybeDups of
219− Nothing ->
220− return $ Right outline
197+ [] -> return $ Right outline
221−
198+ d:ds -> return $ Left (Exit.OutlineHasBadSrcDirs d ds)
222− Just (canonicalDir, (dir1,dir2)) ->
223− return $ Left (Exit.OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2)
224−
225−
226−isSrcDirMissing :: FilePath -> SrcDir -> IO Bool
227−isSrcDirMissing root srcDir =
228− not <$> Dir.doesDirectoryExist (toAbsolute root srcDir)
229−
230−
231−toGiven :: SrcDir -> FilePath
232−toGiven srcDir =
233− case srcDir of
234− AbsoluteSrcDir dir -> dir
235− RelativeSrcDir dir -> dir
236−
237−
238−toAbsolute :: FilePath -> SrcDir -> FilePath
239−toAbsolute root srcDir =
240− case srcDir of
241− AbsoluteSrcDir dir -> dir
242− RelativeSrcDir dir -> root </> dir
243
199
244
200
245−detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))
201+isBadSrcDir :: FilePath -> FilePath -> IO Bool
246−detectDuplicates root srcDirs =
202+isBadSrcDir root dir =
247− do pairs <- traverse (toPair root) srcDirs
203+ not <$> Dir.doesDirectoryExist (root </> dir)
248− return $ Map.lookupMin $ Map.mapMaybe isDup $
249− Map.fromListWith OneOrMore.more pairs
250−
251−
252−toPair :: FilePath -> SrcDir -> IO (FilePath, OneOrMore.OneOrMore FilePath)
253−toPair root srcDir =
254− do key <- Dir.canonicalizePath (toAbsolute root srcDir)
255− return (key, OneOrMore.one (toGiven srcDir))
256−
257−
258−isDup :: OneOrMore.OneOrMore FilePath -> Maybe (FilePath, FilePath)
259−isDup paths =
260− case paths of
261− OneOrMore.One _ -> Nothing
262− OneOrMore.More a b -> Just (OneOrMore.getFirstTwo a b)
263
204
264
205
265
206
@@ -337,16 +278,9 @@ depsDecoder valueDecoder =
337 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder
278 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder
338
279
339
280
340−dirsDecoder :: Decoder (NE.List SrcDir)
281+dirsDecoder :: Decoder (NE.List FilePath)
341dirsDecoder =
282dirsDecoder =
342− fmap (toSrcDir . Json.toChars) <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs
283+ fmap Json.toChars <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs
343−
344−
345−toSrcDir :: FilePath -> SrcDir
346−toSrcDir path =
347− if FP.isRelative path
348− then RelativeSrcDir path
349− else AbsoluteSrcDir path
350
284
351
285
352
286
@@ -387,21 +321,3 @@ boundParser bound tooLong =
387 if len < bound
321 if len < bound
388 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)
322 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)
389 else cerr row newCol (\_ _ -> tooLong)
323 else cerr row newCol (\_ _ -> tooLong)
390−
391−
392−
393−-- BINARY
394−
395−
396−instance Binary SrcDir where
397− put outline =
398− case outline of
399− AbsoluteSrcDir a -> putWord8 0 >> put a
400− RelativeSrcDir a -> putWord8 1 >> put a
401−
402− get =
403− do n <- getWord8
404− case n of
405− 0 -> liftM AbsoluteSrcDir get
406− 1 -> liftM RelativeSrcDir get
407− _ -> fail "binary encoding of SrcDir was corrupted"
builder/src/Generate.hs+6−6
@@ -99,18 +99,18 @@ checkForDebugUses (Objects _ locals) =
99-- GATHER MAINS
99-- GATHER MAINS
100
100
101
101
102−gatherMains :: Pkg.Name -> Objects -> NE.List Build.Root -> Map.Map ModuleName.Canonical Opt.Main
102+gatherMains :: Pkg.Name -> Objects -> NE.List Build.Main -> Map.Map ModuleName.Canonical Opt.Main
103−gatherMains pkg (Objects _ locals) roots =
103+gatherMains pkg (Objects _ locals) buildMains =
104− Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList roots)
104+ Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList buildMains)
105
105
106
106
107−lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Root -> Maybe (ModuleName.Canonical, Opt.Main)
107+lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Main -> Maybe (ModuleName.Canonical, Opt.Main)
108−lookupMain pkg locals root =
108+lookupMain pkg locals buildMain =
109 let
109 let
110 toPair name (Opt.LocalGraph maybeMain _ _) =
110 toPair name (Opt.LocalGraph maybeMain _ _) =
111 (,) (ModuleName.Canonical pkg name) <$> maybeMain
111 (,) (ModuleName.Canonical pkg name) <$> maybeMain
112 in
112 in
113− case root of
113+ case buildMain of
114 Build.Inside name -> toPair name =<< Map.lookup name locals
114 Build.Inside name -> toPair name =<< Map.lookup name locals
115 Build.Outside name _ g -> toPair name g
115 Build.Outside name _ g -> toPair name g
116
116
builder/src/Http.hs+1−1
@@ -241,4 +241,4 @@ jsonPart name filePath value =
241
241
242stringPart :: String -> String -> Multi.Part
242stringPart :: String -> String -> Multi.Part
243stringPart name string =
243stringPart name string =
244− Multi.partBS (String.fromString name) (BS.pack string)
244+ Multi.partBS (String.fromString name) (BS.pack string)
builder/src/Reporting.hs+2−2
@@ -364,10 +364,10 @@ toFinalMessage done result =
364
364
365 Left problem ->
365 Left problem ->
366 case problem of
366 case problem of
367− Exit.BuildBadModules _ _ [] ->
367+ Exit.BuildBadModules _ [] ->
368 "Detected problems in 1 module."
368 "Detected problems in 1 module."
369
369
370− Exit.BuildBadModules _ _ (_:ps) ->
370+ Exit.BuildBadModules _ (_:ps) ->
371 "Detected problems in " ++ show (2 + length ps) ++ " modules."
371 "Detected problems in " ++ show (2 + length ps) ++ " modules."
372
372
373 Exit.BuildProjectProblem _ ->
373 Exit.BuildProjectProblem _ ->
builder/src/Reporting/Exit.hs+60−44
@@ -8,6 +8,7 @@ module Reporting.Exit
8 , Publish(..), publishToReport
8 , Publish(..), publishToReport
9 , Install(..), installToReport
9 , Install(..), installToReport
10 , Reactor(..), reactorToReport
10 , Reactor(..), reactorToReport
11+ , Worker(..), workerToReport
11 , newPackageOverview
12 , newPackageOverview
12 --
13 --
13 , Solver(..)
14 , Solver(..)
@@ -947,8 +948,7 @@ toSolverReport problem =
947
948
948data Outline
949data Outline
949 = OutlineHasBadStructure (Decode.Error OutlineProblem)
950 = OutlineHasBadStructure (Decode.Error OutlineProblem)
950− | OutlineHasMissingSrcDirs FilePath [FilePath]
951+ | OutlineHasBadSrcDirs FilePath [FilePath]
951− | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath
952 | OutlineNoPkgCore
952 | OutlineNoPkgCore
953 | OutlineNoAppCore
953 | OutlineNoAppCore
954 | OutlineNoAppJson
954 | OutlineNoAppJson
@@ -974,12 +974,12 @@ toOutlineReport problem =
974 Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $
974 Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $
975 Json.ExplicitReason "I ran into a problem with your elm.json file."
975 Json.ExplicitReason "I ran into a problem with your elm.json file."
976
976
977− OutlineHasMissingSrcDirs dir dirs ->
977+ OutlineHasBadSrcDirs dir dirs ->
978 case dirs of
978 case dirs of
979 [] ->
979 [] ->
980 Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")
980 Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")
981 "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"
981 "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"
982− [ D.indent 4 $ D.red $ D.fromChars dir
982+ [ D.indent 4 $ D.dullyellow $ D.fromChars dir
983 , D.reflow $
983 , D.reflow $
984 "I cannot find it though. Is it missing? Is there a typo?"
984 "I cannot find it though. Is it missing? Is there a typo?"
985 ]
985 ]
@@ -987,33 +987,11 @@ toOutlineReport problem =
987 _:_ ->
987 _:_ ->
988 Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")
988 Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")
989 "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"
989 "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"
990− [ D.indent 4 $ D.vcat $
991− map (D.red . D.fromChars) (dir:dirs)
990+ [ D.indent 4 $ D.dullyellow $ D.fromChars dir
992 , D.reflow $
991 , D.reflow $
993 "I cannot find them though. Are they missing? Are there typos?"
992 "I cannot find them though. Are they missing? Are there typos?"
994 ]
993 ]
995
994
996− OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2 ->
997− if dir1 == dir2 then
998− Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")
999− "I need a valid elm.json file, but the \"source-directories\" field lists the same directory twice:"
1000− [ D.indent 4 $ D.vcat $
1001− map (D.red . D.fromChars) [dir1,dir2]
1002− , D.reflow $
1003− "Remove one of the entries!"
1004− ]
1005− else
1006− Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")
1007− "I need a valid elm.json file, but the \"source-directories\" field has some redundant directories:"
1008− [ D.indent 4 $ D.vcat $
1009− map (D.red . D.fromChars) [dir1,dir2]
1010− , D.reflow $
1011− "These are two different ways of refering to the same directory:"
1012− , D.indent 4 $ D.dullyellow $ D.fromChars canonicalDir
1013− , D.reflow $
1014− "Remove one of the redundant entries from your \"source-directories\" field."
1015− ]
1016−
1017 OutlineNoPkgCore ->
995 OutlineNoPkgCore ->
1018 Help.report "MISSING DEPENDENCY" (Just "elm.json")
996 Help.report "MISSING DEPENDENCY" (Just "elm.json")
1019 "I need to see an \"elm/core\" dependency your elm.json file. The default imports\
997 "I need to see an \"elm/core\" dependency your elm.json file. The default imports\
@@ -1282,7 +1260,8 @@ toDetailsReport details =
1282 "The dependencies in your elm.json are not compatible."
1260 "The dependencies in your elm.json are not compatible."
1283 [ D.fillSep
1261 [ D.fillSep
1284 ["Did","you","change","them","by","hand?","Try","to","change","it","back!"
1262 ["Did","you","change","them","by","hand?","Try","to","change","it","back!"
1285− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1263+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1264+ ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
1286 ]
1265 ]
1287 , D.reflow $
1266 , D.reflow $
1288 "Please ask for help on the community forums if you try those paths and are still\
1267 "Please ask for help on the community forums if you try those paths and are still\
@@ -1299,7 +1278,8 @@ toDetailsReport details =
1299 \ get access to the registry!"
1278 \ get access to the registry!"
1300 , D.toFancyNote
1279 , D.toFancyNote
1301 ["If","you","changed","your","dependencies","by","hand,","try","to","change","them","back!"
1280 ["If","you","changed","your","dependencies","by","hand,","try","to","change","them","back!"
1302− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1281+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1282+ ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
1303 ]
1283 ]
1304 ]
1284 ]
1305
1285
@@ -1335,7 +1315,8 @@ toDetailsReport details =
1335 \ party tool) leaving them in an invalid state."
1315 \ party tool) leaving them in an invalid state."
1336 [ D.fillSep
1316 [ D.fillSep
1337 ["Try","to","change","them","back","to","what","they","were","before!"
1317 ["Try","to","change","them","back","to","what","they","were","before!"
1338− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1318+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1319+ ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
1339 ]
1320 ]
1340 , D.reflow $
1321 , D.reflow $
1341 "Please ask for help on the community forums if you try those paths and are still\
1322 "Please ask for help on the community forums if you try those paths and are still\
@@ -1522,7 +1503,7 @@ toHttpErrorReport title err context =
1522
1503
1523 Http.BadHttp url httpExceptionContent ->
1504 Http.BadHttp url httpExceptionContent ->
1524 case httpExceptionContent of
1505 case httpExceptionContent of
1525− HTTP.StatusCodeException response body ->
1506+ HTTP.StatusCodeException response _ ->
1526 let
1507 let
1527 (HTTP.Status code message) = HTTP.responseStatus response
1508 (HTTP.Status code message) = HTTP.responseStatus response
1528 in
1509 in
@@ -1530,7 +1511,6 @@ toHttpErrorReport title err context =
1530 [ D.fillSep $
1511 [ D.fillSep $
1531 ["But","it","came","back","as",D.red (D.fromInt code)]
1512 ["But","it","came","back","as",D.red (D.fromInt code)]
1532 ++ map D.fromChars (words (BS_UTF8.toString message))
1513 ++ map D.fromChars (words (BS_UTF8.toString message))
1533− , D.indent 4 $ D.reflow $ BS_UTF8.toString body
1534 , D.reflow $
1514 , D.reflow $
1535 "This may mean some online endpoint changed in an unexpected way, so if does not\
1515 "This may mean some online endpoint changed in an unexpected way, so if does not\
1536 \ seem like something on your side is causing this (e.g. firewall) please report\
1516 \ seem like something on your side is causing this (e.g. firewall) please report\
@@ -1756,7 +1736,7 @@ makeToReport make =
1756
1736
1757
1737
1758data BuildProblem
1738data BuildProblem
1759− = BuildBadModules FilePath Error.Module [Error.Module]
1739+ = BuildBadModules Error.Module [Error.Module]
1760 | BuildProjectProblem BuildProjectProblem
1740 | BuildProjectProblem BuildProjectProblem
1761
1741
1762
1742
@@ -1765,8 +1745,8 @@ data BuildProjectProblem
1765 | BP_WithBadExtension FilePath
1745 | BP_WithBadExtension FilePath
1766 | BP_WithAmbiguousSrcDir FilePath FilePath FilePath
1746 | BP_WithAmbiguousSrcDir FilePath FilePath FilePath
1767 | BP_MainPathDuplicate FilePath FilePath
1747 | BP_MainPathDuplicate FilePath FilePath
1768− | BP_RootNameDuplicate ModuleName.Raw FilePath FilePath
1748+ | BP_MainNameDuplicate ModuleName.Raw FilePath FilePath
1769− | BP_RootNameInvalid FilePath FilePath [String]
1749+ | BP_MainNameInvalid FilePath FilePath [String]
1770 | BP_CannotLoadDependencies
1750 | BP_CannotLoadDependencies
1771 | BP_Cycle ModuleName.Raw [ModuleName.Raw]
1751 | BP_Cycle ModuleName.Raw [ModuleName.Raw]
1772 | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))
1752 | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))
@@ -1775,8 +1755,8 @@ data BuildProjectProblem
1775toBuildProblemReport :: BuildProblem -> Help.Report
1755toBuildProblemReport :: BuildProblem -> Help.Report
1776toBuildProblemReport problem =
1756toBuildProblemReport problem =
1777 case problem of
1757 case problem of
1778− BuildBadModules root e es ->
1758+ BuildBadModules e es ->
1779− Help.compilerReport root e es
1759+ Help.compilerReport e es
1780
1760
1781 BuildProjectProblem projectProblem ->
1761 BuildProjectProblem projectProblem ->
1782 toProjectProblemReport projectProblem
1762 toProjectProblemReport projectProblem
@@ -1833,7 +1813,7 @@ toProjectProblemReport projectProblem =
1833 \ unstuck!"
1813 \ unstuck!"
1834 ]
1814 ]
1835
1815
1836− BP_RootNameDuplicate name outsidePath otherPath ->
1816+ BP_MainNameDuplicate name outsidePath otherPath ->
1837 Help.report "MODULE NAME CLASH" Nothing
1817 Help.report "MODULE NAME CLASH" Nothing
1838 "These two files are causing a module name clash:"
1818 "These two files are causing a module name clash:"
1839 [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]
1819 [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]
@@ -1844,7 +1824,7 @@ toProjectProblemReport projectProblem =
1844 "Try changing to a different module name in one of them!"
1824 "Try changing to a different module name in one of them!"
1845 ]
1825 ]
1846
1826
1847− BP_RootNameInvalid givenPath srcDir _ ->
1827+ BP_MainNameInvalid givenPath srcDir _ ->
1848 Help.report "UNEXPECTED FILE NAME" Nothing
1828 Help.report "UNEXPECTED FILE NAME" Nothing
1849 "I am having trouble with this file name:"
1829 "I am having trouble with this file name:"
1850 [ D.indent 4 $ D.red $ D.fromChars givenPath
1830 [ D.indent 4 $ D.red $ D.fromChars givenPath
@@ -1968,7 +1948,7 @@ toGenerateReport problem =
1968 "The issue is that --optimize strips out info needed by `Debug` functions.\
1948 "The issue is that --optimize strips out info needed by `Debug` functions.\
1969 \ Here are two examples:"
1949 \ Here are two examples:"
1970 , D.indent 4 $ D.reflow $
1950 , D.indent 4 $ D.reflow $
1971− "(1) It shortens record field names. This makes the generated JavaScript\
1951+ "(1) It shortens record field names. This makes the generated JavaScript is\
1972 \ smaller, but `Debug.toString` cannot know the real field names anymore."
1952 \ smaller, but `Debug.toString` cannot know the real field names anymore."
1973 , D.indent 4 $ D.reflow $
1953 , D.indent 4 $ D.reflow $
1974 "(2) Values like `type Height = Height Float` are unboxed. This reduces\
1954 "(2) Values like `type Height = Height Float` are unboxed. This reduces\
@@ -2037,7 +2017,7 @@ reactorToReport problem =
2037data Repl
2017data Repl
2038 = ReplBadDetails Details
2018 = ReplBadDetails Details
2039 | ReplBadInput BS.ByteString Error.Error
2019 | ReplBadInput BS.ByteString Error.Error
2040− | ReplBadLocalDeps FilePath Error.Module [Error.Module]
2020+ | ReplBadLocalDeps Error.Module [Error.Module]
2041 | ReplProjectProblem BuildProjectProblem
2021 | ReplProjectProblem BuildProjectProblem
2042 | ReplBadGenerate Generate
2022 | ReplBadGenerate Generate
2043 | ReplBadCache
2023 | ReplBadCache
@@ -2051,10 +2031,10 @@ replToReport problem =
2051 toDetailsReport details
2031 toDetailsReport details
2052
2032
2053 ReplBadInput source err ->
2033 ReplBadInput source err ->
2054− Help.compilerReport "/" (Error.Module N.replModule "REPL" File.zeroTime source err) []
2034+ Help.compilerReport (Error.Module N.replModule "REPL" File.zeroTime source err) []
2055
2035
2056− ReplBadLocalDeps root e es ->
2036+ ReplBadLocalDeps e es ->
2057− Help.compilerReport root e es
2037+ Help.compilerReport e es
2058
2038
2059 ReplProjectProblem projectProblem ->
2039 ReplProjectProblem projectProblem ->
2060 toProjectProblemReport projectProblem
2040 toProjectProblemReport projectProblem
@@ -2067,3 +2047,39 @@ replToReport problem =
2067
2047
2068 ReplBlocked ->
2048 ReplBlocked ->
2069 corruptCacheReport
2049 corruptCacheReport
2050+
2051+
2052+
2053+-- WORKER
2054+
2055+
2056+data Worker
2057+ = WorkerInputError Error.Module
2058+ | WorkerNoMain
2059+
2060+
2061+workerToReport :: Worker -> Help.Report
2062+workerToReport problem =
2063+ case problem of
2064+ WorkerInputError err ->
2065+ Help.compilerReport err []
2066+
2067+ WorkerNoMain ->
2068+ Help.report "NO MAIN" Nothing
2069+ (
2070+ "Without a `main` value, I do not know what to show on screen!"
2071+ )
2072+ [ D.reflow $
2073+ "Adding a `main` value can be as brief as:"
2074+ , D.vcat
2075+ [ D.fillSep [D.cyan "import","Html"]
2076+ , ""
2077+ , D.fillSep [D.green "main","="]
2078+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
2079+ ]
2080+ , D.reflow $
2081+ "Try adding something like that!"
2082+ , D.toSimpleNote $
2083+ "I recommend looking through https://guide.elm-lang.org for more advice on\
2084+ \ how to fill in `main` values."
2085+ ]
builder/src/Reporting/Exit/Help.hs+5−5
@@ -29,7 +29,7 @@ import qualified Reporting.Error as Error
29
29
30
30
31data Report
31data Report
32− = CompilerReport FilePath Error.Module [Error.Module]
32+ = CompilerReport Error.Module [Error.Module]
33 | Report
33 | Report
34 { _title :: String
34 { _title :: String
35 , _path :: Maybe FilePath
35 , _path :: Maybe FilePath
@@ -52,7 +52,7 @@ jsonReport =
52 Report
52 Report
53
53
54
54
55−compilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report
55+compilerReport :: Error.Module -> [Error.Module] -> Report
56compilerReport =
56compilerReport =
57 CompilerReport
57 CompilerReport
58
58
@@ -64,8 +64,8 @@ compilerReport =
64reportToDoc :: Report -> D.Doc
64reportToDoc :: Report -> D.Doc
65reportToDoc report_ =
65reportToDoc report_ =
66 case report_ of
66 case report_ of
67− CompilerReport root e es ->
67+ CompilerReport e es ->
68− Error.toDoc root e es
68+ Error.toDoc e es
69
69
70 Report title maybePath message ->
70 Report title maybePath message ->
71 let
71 let
@@ -94,7 +94,7 @@ reportToDoc report_ =
94reportToJson :: Report -> E.Value
94reportToJson :: Report -> E.Value
95reportToJson report_ =
95reportToJson report_ =
96 case report_ of
96 case report_ of
97− CompilerReport _ e es ->
97+ CompilerReport e es ->
98 E.object
98 E.object
99 [ "type" ==> E.chars "compile-errors"
99 [ "type" ==> E.chars "compile-errors"
100 , "errors" ==> E.list Error.toJson (e:es)
100 , "errors" ==> E.list Error.toJson (e:es)
builder/src/Stuff.hs+1−1
@@ -62,7 +62,7 @@ prepublishDir root =
62
62
63compilerVersion :: FilePath
63compilerVersion :: FilePath
64compilerVersion =
64compilerVersion =
65− V.toChars V.compiler
65+ V.toChars V.compiler ++ "-alpha-4"
66
66
67
67
68
68
compiler/src/AST/Source.hs+5−5
@@ -195,15 +195,15 @@ newtype Comment =
195
195
196data Exposing
196data Exposing
197 = Open
197 = Open
198− | Explicit [Exposed]
198+ | Explicit [A.Located Exposed]
199
199
200
200
201data Exposed
201data Exposed
202− = Lower (A.Located Name)
202+ = Lower Name
203− | Upper (A.Located Name) Privacy
203+ | Upper Name Privacy
204− | Operator A.Region Name
204+ | Operator Name
205
205
206
206
207data Privacy
207data Privacy
208− = Public A.Region
208+ = Public
209 | Private
209 | Private
compiler/src/AST/Utils/Type.hs+1
@@ -1,4 +1,5 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
2module AST.Utils.Type
3module AST.Utils.Type
3 ( delambda
4 ( delambda
4 , dealias
5 , dealias
compiler/src/Canonicalize/Environment.hs+20−50
@@ -4,8 +4,6 @@ module Canonicalize.Environment
4 ( Env(..)
4 ( Env(..)
5 , Exposed
5 , Exposed
6 , Qualified
6 , Qualified
7− , Info(..)
8− , mergeInfo
9 , Var(..)
7 , Var(..)
10 , Type(..)
8 , Type(..)
11 , Ctor(..)
9 , Ctor(..)
@@ -22,8 +20,8 @@ module Canonicalize.Environment
22
20
23import qualified Data.Map.Merge.Strict as Map
21import qualified Data.Map.Merge.Strict as Map
24import qualified Data.Map.Strict as Map
22import qualified Data.Map.Strict as Map
23+import qualified Data.Map.Strict.Internal as I
25import qualified Data.Name as Name
24import qualified Data.Name as Name
26−import qualified Data.OneOrMore as OneOrMore
27
25
28import qualified AST.Utils.Binop as Binop
26import qualified AST.Utils.Binop as Binop
29import qualified AST.Canonical as Can
27import qualified AST.Canonical as Can
@@ -60,34 +58,11 @@ data Env =
60
58
61
59
62type Exposed a =
60type Exposed a =
63− Map.Map Name.Name (Info a)
61+ Map.Map Name.Name (Map.Map ModuleName.Canonical a)
64
62
65
63
66type Qualified a =
64type Qualified a =
67− Map.Map Name.Name (Map.Map Name.Name (Info a))
65+ Map.Map Name.Name (Map.Map Name.Name (Map.Map ModuleName.Canonical a))
68−
69−
70−
71−-- INFO
72−
73−
74−data Info a
75− = Specific ModuleName.Canonical a
76− | Ambiguous ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
77−
78−
79−mergeInfo :: Info a -> Info a -> Info a
80−mergeInfo info1 info2 =
81− case info1 of
82− Specific h1 _ ->
83− case info2 of
84− Specific h2 _ -> if h1 == h2 then info1 else Ambiguous h1 (OneOrMore.one h2)
85− Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more (OneOrMore.one h2) hs2)
86−
87− Ambiguous h1 hs1 ->
88− case info2 of
89− Specific h2 _ -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.one h2))
90− Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.more (OneOrMore.one h2) hs2))
91
66
92
67
93
68
@@ -97,8 +72,7 @@ mergeInfo info1 info2 =
97data Var
72data Var
98 = Local A.Region
73 = Local A.Region
99 | TopLevel A.Region
74 | TopLevel A.Region
100− | Foreign ModuleName.Canonical Can.Annotation
75+ | Foreign (Map.Map ModuleName.Canonical Can.Annotation)
101− | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
102
76
103
77
104
78
@@ -165,10 +139,7 @@ addLocalLeft _ region =
165addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
139addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
166addLocalBoth name region var =
140addLocalBoth name region var =
167 case var of
141 case var of
168− Foreign _ _ ->
142+ Foreign _ ->
169− Result.ok (Local region)
170−
171− Foreigns _ _ ->
172 Result.ok (Local region)
143 Result.ok (Local region)
173
144
174 Local parentRegion ->
145 Local parentRegion ->
@@ -179,18 +150,17 @@ addLocalBoth name region var =
179
150
180
151
181
152
182−
183-- FIND TYPE
153-- FIND TYPE
184
154
185
155
186findType :: A.Region -> Env -> Name.Name -> Result i w Type
156findType :: A.Region -> Env -> Name.Name -> Result i w Type
187findType region (Env _ _ ts _ _ _ qts _) name =
157findType region (Env _ _ ts _ _ _ qts _) name =
188 case Map.lookup name ts of
158 case Map.lookup name ts of
189− Just (Specific _ tipe) ->
159+ Just (I.Bin 1 _ tipe _ _) ->
190 Result.ok tipe
160 Result.ok tipe
191
161
192− Just (Ambiguous h hs) ->
162+ Just homes ->
193− Result.throw (Error.AmbiguousType region Nothing name h hs)
163+ Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))
194
164
195 Nothing ->
165 Nothing ->
196 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
166 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
@@ -201,11 +171,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
201 case Map.lookup prefix qts of
171 case Map.lookup prefix qts of
202 Just qualified ->
172 Just qualified ->
203 case Map.lookup name qualified of
173 case Map.lookup name qualified of
204− Just (Specific _ tipe) ->
174+ Just (I.Bin 1 _ tipe _ _) ->
205 Result.ok tipe
175 Result.ok tipe
206
176
207− Just (Ambiguous h hs) ->
177+ Just homes ->
208− Result.throw (Error.AmbiguousType region (Just prefix) name h hs)
178+ Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))
209
179
210 Nothing ->
180 Nothing ->
211 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
181 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
@@ -221,11 +191,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
221findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
191findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
222findCtor region (Env _ _ _ cs _ _ _ qcs) name =
192findCtor region (Env _ _ _ cs _ _ _ qcs) name =
223 case Map.lookup name cs of
193 case Map.lookup name cs of
224− Just (Specific _ ctor) ->
194+ Just (I.Bin 1 _ ctor _ _) ->
225 Result.ok ctor
195 Result.ok ctor
226
196
227− Just (Ambiguous h hs) ->
197+ Just homes ->
228− Result.throw (Error.AmbiguousVariant region Nothing name h hs)
198+ Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))
229
199
230 Nothing ->
200 Nothing ->
231 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
201 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
@@ -236,11 +206,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
236 case Map.lookup prefix qcs of
206 case Map.lookup prefix qcs of
237 Just qualified ->
207 Just qualified ->
238 case Map.lookup name qualified of
208 case Map.lookup name qualified of
239− Just (Specific _ pattern) ->
209+ Just (I.Bin 1 _ pattern _ _) ->
240 Result.ok pattern
210 Result.ok pattern
241
211
242− Just (Ambiguous h hs) ->
212+ Just homes ->
243− Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)
213+ Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))
244
214
245 Nothing ->
215 Nothing ->
246 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
216 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
@@ -256,11 +226,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
256findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
226findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
257findBinop region (Env _ _ _ _ binops _ _ _) name =
227findBinop region (Env _ _ _ _ binops _ _ _) name =
258 case Map.lookup name binops of
228 case Map.lookup name binops of
259− Just (Specific _ binop) ->
229+ Just (I.Bin 1 _ binop _ _) ->
260 Result.ok binop
230 Result.ok binop
261
231
262− Just (Ambiguous h hs) ->
232+ Just homes ->
263− Result.throw (Error.AmbiguousBinop region name h hs)
233+ Result.throw (Error.AmbiguousBinop region name (Map.keys homes))
264
234
265 Nothing ->
235 Nothing ->
266 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))
236 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))
compiler/src/Canonicalize/Environment/Dups.hs+1−1
@@ -105,7 +105,7 @@ one name region value =
105
105
106insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a
106insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a
107insert name region value dict =
107insert name region value dict =
108− Map.insertWith (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict
108+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict
109
109
110
110
111union :: Dict a -> Dict a -> Dict a
111union :: Dict a -> Dict a -> Dict a
compiler/src/Canonicalize/Environment/Foreign.hs+37−49
@@ -35,14 +35,7 @@ type Result i w a =
35createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
35createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
36createInitialEnv home ifaces imports =
36createInitialEnv home ifaces imports =
37 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)
37 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)
38− Result.ok (Env.Env home (Map.map infoToVar vs) ts cs bs qvs qts qcs)
38+ Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)
39−
40−
41−infoToVar :: Env.Info Can.Annotation -> Env.Var
42−infoToVar info =
43− case info of
44− Env.Specific home tipe -> Env.Foreign home tipe
45− Env.Ambiguous h hs -> Env.Foreigns h hs
46
39
47
40
48
41
@@ -68,7 +61,7 @@ emptyState =
68
61
69emptyTypes :: Env.Exposed Env.Type
62emptyTypes :: Env.Exposed Env.Type
70emptyTypes =
63emptyTypes =
71− Map.singleton "List" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))
64+ Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))
72
65
73
66
74
67
@@ -109,8 +102,8 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
109 (Map.mapMaybeWithKey (unionToType home) unions)
102 (Map.mapMaybeWithKey (unionToType home) unions)
110 (Map.mapMaybeWithKey (aliasToType home) aliases)
103 (Map.mapMaybeWithKey (aliasToType home) aliases)
111
104
112− !vars = Map.map (Env.Specific home) defs
105+ !vars = Map.map (Map.singleton home) defs
113− !types = Map.map (Env.Specific home . fst) rawTypeInfo
106+ !types = Map.map (Map.singleton home . fst) rawTypeInfo
114 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
107 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
115
108
116 !qvs2 = addQualified prefix vars qvs
109 !qvs2 = addQualified prefix vars qvs
@@ -136,7 +129,7 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
136
129
137addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
130addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
138addExposed =
131addExposed =
139− Map.unionWith Env.mergeInfo
132+ Map.unionWith Map.union
140
133
141
134
142addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
135addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
@@ -157,7 +150,7 @@ unionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type,
157unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
150unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
158 let
151 let
159 addCtor dict (Can.Ctor ctor index _ args) =
152 addCtor dict (Can.Ctor ctor index _ args) =
160− Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict
153+ Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict
161 in
154 in
162 ( Env.Union (length vars) home
155 ( Env.Union (length vars) home
163 , List.foldl' addCtor Map.empty ctors
156 , List.foldl' addCtor Map.empty ctors
@@ -188,7 +181,7 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
188 (Can.TAlias home name avars (Can.Filled tipe))
181 (Can.TAlias home name avars (Can.Filled tipe))
189 (Can.fieldsToList fields)
182 (Can.fieldsToList fields)
190 in
183 in
191− Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))
184+ Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))
192
185
193 _ ->
186 _ ->
194 Map.empty
187 Map.empty
@@ -199,9 +192,9 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
199-- BINOP
192-- BINOP
200
193
201
194
202−binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop
195+binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop
203binopToBinop home op (I.Binop name annotation associativity precedence) =
196binopToBinop home op (I.Binop name annotation associativity precedence) =
204− Env.Specific home (Env.Binop op home name annotation associativity precedence)
197+ Map.singleton home (Env.Binop op home name annotation associativity precedence)
205
198
206
199
207
200
@@ -214,19 +207,19 @@ addExposedValue
214 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)
207 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)
215 -> Map.Map Name.Name I.Binop
208 -> Map.Map Name.Name I.Binop
216 -> State
209 -> State
217− -> Src.Exposed
210+ -> A.Located Src.Exposed
218 -> Result i w State
211 -> Result i w State
219−addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
212+addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At region exposed) =
220 case exposed of
213 case exposed of
221− Src.Lower (A.At region name) ->
214+ Src.Lower name ->
222 case Map.lookup name vars of
215 case Map.lookup name vars of
223 Just info ->
216 Just info ->
224− Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)
217+ Result.ok (State (Map.insertWith Map.union name info vs) ts cs bs qvs qts qcs)
225
218
226 Nothing ->
219 Nothing ->
227 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
220 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
228
221
229− Src.Upper (A.At region name) privacy ->
222+ Src.Upper name privacy ->
230 case privacy of
223 case privacy of
231 Src.Private ->
224 Src.Private ->
232 case Map.lookup name types of
225 case Map.lookup name types of
@@ -234,43 +227,43 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
234 case tipe of
227 case tipe of
235 Env.Union _ _ ->
228 Env.Union _ _ ->
236 let
229 let
237− !ts2 = Map.insert name (Env.Specific home tipe) ts
230+ !ts2 = Map.insert name (Map.singleton home tipe) ts
238 in
231 in
239 Result.ok (State vs ts2 cs bs qvs qts qcs)
232 Result.ok (State vs ts2 cs bs qvs qts qcs)
240
233
241 Env.Alias _ _ _ _ ->
234 Env.Alias _ _ _ _ ->
242 let
235 let
243− !ts2 = Map.insert name (Env.Specific home tipe) ts
236+ !ts2 = Map.insert name (Map.singleton home tipe) ts
244 !cs2 = addExposed cs ctors
237 !cs2 = addExposed cs ctors
245 in
238 in
246 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
239 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
247
240
248 Nothing ->
241 Nothing ->
249− case checkForCtorMistake name types of
242+ case Map.lookup name (toCtors types) of
250− tipe:_ ->
243+ Just tipe ->
251 Result.throw $ Error.ImportCtorByName region name tipe
244 Result.throw $ Error.ImportCtorByName region name tipe
252
245
253− [] ->
246+ Nothing ->
254 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
247 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
255
248
256− Src.Public dotDotRegion ->
249+ Src.Public ->
257 case Map.lookup name types of
250 case Map.lookup name types of
258 Just (tipe, ctors) ->
251 Just (tipe, ctors) ->
259 case tipe of
252 case tipe of
260 Env.Union _ _ ->
253 Env.Union _ _ ->
261 let
254 let
262− !ts2 = Map.insert name (Env.Specific home tipe) ts
255+ !ts2 = Map.insert name (Map.singleton home tipe) ts
263 !cs2 = addExposed cs ctors
256 !cs2 = addExposed cs ctors
264 in
257 in
265 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
258 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
266
259
267 Env.Alias _ _ _ _ ->
260 Env.Alias _ _ _ _ ->
268− Result.throw (Error.ImportOpenAlias dotDotRegion name)
261+ Result.throw (Error.ImportOpenAlias region name)
269
262
270 Nothing ->
263 Nothing ->
271 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))
264 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))
272
265
273− Src.Operator region op ->
266+ Src.Operator op ->
274 case Map.lookup op binops of
267 case Map.lookup op binops of
275 Just binop ->
268 Just binop ->
276 let
269 let
@@ -282,23 +275,18 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
282 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
275 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
283
276
284
277
278+
285−checkForCtorMistake :: Name.Name -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> [Name.Name]
279+toCtors :: Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> Map.Map Name.Name Name.Name
286−checkForCtorMistake givenName types =
280+toCtors types =
287− Map.foldr addMatches [] types
281+ Map.foldr addCtors Map.empty types
288 where
282 where
289− addMatches (_, exposedCtors) matches =
283+ addCtors (_, exposedCtors) dict =
290− Map.foldrWithKey addMatch matches exposedCtors
284+ Map.foldrWithKey addCtor dict exposedCtors
291−
285+
292− addMatch ctorName info matches =
286+ addCtor ctorName homes dict =
293− if ctorName /= givenName
294− then matches
295− else
296− case info of
287+ case Map.elems homes of
297− Env.Specific _ (Env.Ctor _ tipeName _ _ _) ->
288+ [Env.Ctor _ tipeName _ _ _] ->
298− tipeName : matches
289+ Map.insert ctorName tipeName dict
299−
290+
300− Env.Specific _ (Env.RecordCtor _ _ _) ->
291+ _ ->
301− matches
292+ dict
302−
303− Env.Ambiguous _ _ ->
304− matches
compiler/src/Canonicalize/Environment/Local.hs+5−5
@@ -110,7 +110,7 @@ addTypes (Src.Module _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs
110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)
110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)
111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =
111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =
112 do arity <- checkUnionFreeVars union
112 do arity <- checkUnionFreeVars union
113− let one = Env.Specific home (Env.Union arity home)
113+ let one = Map.singleton home (Env.Union arity home)
114 Result.ok $ Map.insert name one types
114 Result.ok $ Map.insert name one types
115
115
116
116
@@ -133,7 +133,7 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =
133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->
133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->
134 do args <- checkAliasFreeVars alias
134 do args <- checkAliasFreeVars alias
135 ctype <- Type.canonicalize env tipe
135 ctype <- Type.canonicalize env tipe
136− let one = Env.Specific home (Env.Alias (length args) home args ctype)
136+ let one = Map.singleton home (Env.Alias (length args) home args ctype)
137 let ts1 = Map.insert name one ts
137 let ts1 = Map.insert name one ts
138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
139
139
@@ -281,7 +281,7 @@ addCtors (Src.Module _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs
281 )
281 )
282
282
283
283
284−type CtorDups = Dups.Dict (Env.Info Env.Ctor)
284+type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)
285
285
286
286
287
287
@@ -297,7 +297,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At regi
297 ,
297 ,
298 case ctipe of
298 case ctipe of
299 Can.TRecord fields Nothing ->
299 Can.TRecord fields Nothing ->
300− Dups.one name region (Env.Specific home (toRecordCtor home name vars fields))
300+ Dups.one name region (Map.singleton home (toRecordCtor home name vars fields))
301
301
302 _ ->
302 _ ->
303 Dups.none
303 Dups.none
@@ -351,5 +351,5 @@ toOpts ctors =
351
351
352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
354− Dups.one name region $ Env.Specific home $
354+ Dups.one name region $ Map.singleton home $
355 Env.Ctor home typeName union index args
355 Env.Ctor home typeName union index args
compiler/src/Canonicalize/Expression.hs+7−6
@@ -14,6 +14,7 @@ import Control.Monad (foldM)
14import qualified Data.Graph as Graph
14import qualified Data.Graph as Graph
15import qualified Data.List as List
15import qualified Data.List as List
16import qualified Data.Map.Strict as Map
16import qualified Data.Map.Strict as Map
17+import qualified Data.Map.Strict.Internal as I
17import qualified Data.Name as Name
18import qualified Data.Name as Name
18
19
19import qualified AST.Canonical as Can
20import qualified AST.Canonical as Can
@@ -695,15 +696,15 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =
695 Env.TopLevel _ ->
696 Env.TopLevel _ ->
696 logVar name (Can.VarTopLevel localHome name)
697 logVar name (Can.VarTopLevel localHome name)
697
698
698− Env.Foreign home annotation ->
699+ Env.Foreign (I.Bin 1 home annotation _ _) ->
699 Result.ok $
700 Result.ok $
700 if home == ModuleName.debug then
701 if home == ModuleName.debug then
701 Can.VarDebug localHome name annotation
702 Can.VarDebug localHome name annotation
702 else
703 else
703 Can.VarForeign home name annotation
704 Can.VarForeign home name annotation
704
705
705− Env.Foreigns h hs ->
706+ Env.Foreign homes ->
706− Result.throw (Error.AmbiguousVar region Nothing name h hs)
707+ Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))
707
708
708 Nothing ->
709 Nothing ->
709 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
710 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
@@ -714,15 +715,15 @@ findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =
714 case Map.lookup prefix qvs of
715 case Map.lookup prefix qvs of
715 Just qualified ->
716 Just qualified ->
716 case Map.lookup name qualified of
717 case Map.lookup name qualified of
717− Just (Env.Specific home annotation) ->
718+ Just (I.Bin 1 home annotation _ _) ->
718 Result.ok $
719 Result.ok $
719 if home == ModuleName.debug then
720 if home == ModuleName.debug then
720 Can.VarDebug localHome name annotation
721 Can.VarDebug localHome name annotation
721 else
722 else
722 Can.VarForeign home name annotation
723 Can.VarForeign home name annotation
723
724
724− Just (Env.Ambiguous h hs) ->
725+ Just homes ->
725− Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)
726+ Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))
726
727
727 Nothing ->
728 Nothing ->
728 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))
729 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))
compiler/src/Canonicalize/Module.hs+7−7
@@ -236,11 +236,11 @@ checkExposed
236 -> Map.Map Name.Name alias
236 -> Map.Map Name.Name alias
237 -> Map.Map Name.Name binop
237 -> Map.Map Name.Name binop
238 -> Can.Effects
238 -> Can.Effects
239− -> Src.Exposed
239+ -> A.Located Src.Exposed
240 -> Result i w (Dups.Dict (A.Located Can.Export))
240 -> Result i w (Dups.Dict (A.Located Can.Export))
241−checkExposed values unions aliases binops effects exposed =
241+checkExposed values unions aliases binops effects (A.At region exposed) =
242 case exposed of
242 case exposed of
243− Src.Lower (A.At region name) ->
243+ Src.Lower name ->
244 if Map.member name values then
244 if Map.member name values then
245 ok name region Can.ExportValue
245 ok name region Can.ExportValue
246 else
246 else
@@ -252,23 +252,23 @@ checkExposed values unions aliases binops effects exposed =
252 Result.throw $ Error.ExportNotFound region Error.BadVar name $
252 Result.throw $ Error.ExportNotFound region Error.BadVar name $
253 ports ++ Map.keys values
253 ports ++ Map.keys values
254
254
255− Src.Operator region name ->
255+ Src.Operator name ->
256 if Map.member name binops then
256 if Map.member name binops then
257 ok name region Can.ExportBinop
257 ok name region Can.ExportBinop
258 else
258 else
259 Result.throw $ Error.ExportNotFound region Error.BadOp name $
259 Result.throw $ Error.ExportNotFound region Error.BadOp name $
260 Map.keys binops
260 Map.keys binops
261
261
262− Src.Upper (A.At region name) (Src.Public dotDotRegion) ->
262+ Src.Upper name Src.Public ->
263 if Map.member name unions then
263 if Map.member name unions then
264 ok name region Can.ExportUnionOpen
264 ok name region Can.ExportUnionOpen
265 else if Map.member name aliases then
265 else if Map.member name aliases then
266− Result.throw $ Error.ExportOpenAlias dotDotRegion name
266+ Result.throw $ Error.ExportOpenAlias region name
267 else
267 else
268 Result.throw $ Error.ExportNotFound region Error.BadType name $
268 Result.throw $ Error.ExportNotFound region Error.BadType name $
269 Map.keys unions ++ Map.keys aliases
269 Map.keys unions ++ Map.keys aliases
270
270
271− Src.Upper (A.At region name) Src.Private ->
271+ Src.Upper name Src.Private ->
272 if Map.member name unions then
272 if Map.member name unions then
273 ok name region Can.ExportUnionClosed
273 ok name region Can.ExportUnionClosed
274 else if Map.member name aliases then
274 else if Map.member name aliases then
compiler/src/Canonicalize/Pattern.hs+2−3
@@ -8,7 +8,6 @@ module Canonicalize.Pattern
8 where
8 where
9
9
10
10
11−import qualified Data.List as List
12import qualified Data.Map.Strict as Map
11import qualified Data.Map.Strict as Map
13import qualified Data.Name as Name
12import qualified Data.Name as Name
14
13
@@ -174,8 +173,8 @@ logVar name region value =
174logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a
173logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a
175logFields fields value =
174logFields fields value =
176 let
175 let
177− addField dict (A.At region name) =
176+ addField (A.At region name) dict =
178 Dups.insert name region region dict
177 Dups.insert name region region dict
179 in
178 in
180 Result.Result $ \bindings warnings _ ok ->
179 Result.Result $ \bindings warnings _ ok ->
181− ok (List.foldl' addField bindings fields) warnings value
180+ ok (foldr addField bindings fields) warnings value
compiler/src/Data/Name.hs+1−1
@@ -304,7 +304,7 @@ fromManyNames names =
304 case names of
304 case names of
305 [] ->
305 [] ->
306 blank
306 blank
307− -- NOTE: this case is needed for (let _ = Debug.log "x" x in ...)
307+ -- this case is needed for (let _ = Debug.log "x" x in ...)
308 -- but maybe unused patterns should be stripped out instead
308 -- but maybe unused patterns should be stripped out instead
309
309
310 Utf8.Utf8 ba# : _ ->
310 Utf8.Utf8 ba# : _ ->
compiler/src/Data/Utf8.hs+1−3
@@ -261,9 +261,7 @@ instance Eq (Utf8 t) where
261
261
262
262
263-- COMPARE
263-- COMPARE
264−--
264+
265−-- TODO: is it fine to sort by length and only compare bytes on length ties?
266−--
267
265
268instance Ord (Utf8 t) where
266instance Ord (Utf8 t) where
269 compare (Utf8 ba1#) (Utf8 ba2#) =
267 compare (Utf8 ba1#) (Utf8 ba2#) =
compiler/src/Elm/Compiler/Imports.hs+3−3
@@ -49,14 +49,14 @@ closed =
49
49
50typeOpen :: Name.Name -> Src.Exposing
50typeOpen :: Name.Name -> Src.Exposing
51typeOpen name =
51typeOpen name =
52− Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]
52+ Src.Explicit [ A.At A.zero (Src.Upper name Src.Public) ]
53
53
54
54
55typeClosed :: Name.Name -> Src.Exposing
55typeClosed :: Name.Name -> Src.Exposing
56typeClosed name =
56typeClosed name =
57− Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]
57+ Src.Explicit [ A.At A.zero (Src.Upper name Src.Private) ]
58
58
59
59
60operator :: Name.Name -> Src.Exposing
60operator :: Name.Name -> Src.Exposing
61operator op =
61operator op =
62− Src.Explicit [ Src.Operator A.zero op ]
62+ Src.Explicit [ A.At A.zero (Src.Operator op) ]
compiler/src/Elm/Kernel.hs+6−6
@@ -319,19 +319,19 @@ toNames exposing =
319 map toName exposedList
319 map toName exposedList
320
320
321
321
322−toName :: Src.Exposed -> Name.Name
322+toName :: A.Located Src.Exposed -> Name.Name
323−toName exposed =
323+toName (A.At _ exposed) =
324 case exposed of
324 case exposed of
325− Src.Lower (A.At _ name) ->
325+ Src.Lower name ->
326 name
326 name
327
327
328− Src.Upper (A.At _ name) Src.Private ->
328+ Src.Upper name Src.Private ->
329 name
329 name
330
330
331− Src.Upper _ (Src.Public _) ->
331+ Src.Upper _ Src.Public ->
332 error "cannot have Maybe(..) syntax in kernel code header"
332 error "cannot have Maybe(..) syntax in kernel code header"
333
333
334− Src.Operator _ _ ->
334+ Src.Operator _ ->
335 error "cannot use binops in kernel code"
335 error "cannot use binops in kernel code"
336
336
337
337
compiler/src/Elm/ModuleName.hs+6−2
@@ -7,13 +7,12 @@ module Elm.ModuleName
7 --
7 --
8 , encode
8 , encode
9 , decoder
9 , decoder
10− , parser
11 --
10 --
12 , Canonical(..)
11 , Canonical(..)
13 , basics, char, string
12 , basics, char, string
14 , maybe, result, list, array, dict, tuple
13 , maybe, result, list, array, dict, tuple
15 , platform, cmd, sub
14 , platform, cmd, sub
16− , debug
15+ , debug, bitwise
17 , virtualDom
16 , virtualDom
18 , jsonDecode, jsonEncode
17 , jsonDecode, jsonEncode
19 , webgl, texture, vector2, vector3, vector4, matrix4
18 , webgl, texture, vector2, vector3, vector4, matrix4
@@ -226,6 +225,11 @@ debug :: Canonical
226debug = Canonical Pkg.core Name.debug
225debug = Canonical Pkg.core Name.debug
227
226
228
227
228+{-# NOINLINE bitwise #-}
229+bitwise :: Canonical
230+bitwise = Canonical Pkg.core Name.bitwise
231+
232+
229
233
230-- HTML
234-- HTML
231
235
compiler/src/Generate/Html.hs+8−4
@@ -29,16 +29,20 @@ sandwich moduleName javascript =
29
29
30<body>
30<body>
31
31
32−<pre id="elm"></pre>
32+<pre id="elm">
33+This is a headless program, meaning there is nothing to show here.
34+
35+I started the program anyway though!
36+
37+You can access it as `app` in the developer console.
38+</pre>
33
39
34<script>
40<script>
35try {
41try {
36|] <> javascript <> [r|
42|] <> javascript <> [r|
37
43
38 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
44 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
39−}
40−catch (e)
45+} catch (e) {
41−{
42 // display initialization errors (e.g. bad flags, infinite recursion)
46 // display initialization errors (e.g. bad flags, infinite recursion)
43 var header = document.createElement("h1");
47 var header = document.createElement("h1");
44 header.style.fontFamily = "monospace";
48 header.style.fontFamily = "monospace";
compiler/src/Generate/JavaScript.hs+10−45
@@ -2,7 +2,6 @@
2module Generate.JavaScript
2module Generate.JavaScript
3 ( generate
3 ( generate
4 , generateForRepl
4 , generateForRepl
5− , generateForReplEndpoint
6 )
5 )
7 where
6 where
8
7
@@ -86,8 +85,7 @@ generateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _
86 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")
85 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")
87 evalState = addGlobal mode graph debugState (Opt.Global home name)
86 evalState = addGlobal mode graph debugState (Opt.Global home name)
88 in
87 in
89− "process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\n'); process.exit(1); });"
90− <> Functions.functions
88+ Functions.functions
91 <> stateToBuilder evalState
89 <> stateToBuilder evalState
92 <> print ansi localizer home name tipe
90 <> print ansi localizer home name tipe
93
91
@@ -100,47 +98,14 @@ print ansi localizer home name tipe =
100 tipeDoc = RT.canToDoc localizer RT.None tipe
98 tipeDoc = RT.canToDoc localizer RT.None tipe
101 bool = if ansi then "true" else "false"
99 bool = if ansi then "true" else "false"
102 in
100 in
103− "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\
101+ "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\
104− \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\
102+ \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\
105− \function _print(t) { console.log(_value + (" <> bool <> " ? '\x1b[90m' + t + '\x1b[0m' : t)); }\n\
103+ \function _print(t) { console.log(_value + (" <> bool <> " ? '\x1b[90m' + t + '\x1b[0m' : t)); }\n\
106− \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\
104+ \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\
107− \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\
105+ \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\
108− \} else {\n\
106+ \} else {\n\
109− \ _print(' : ' + _type);\n\
107+ \ _print(' : ' + _type);\n\
110− \}\n"
111−
112−
113−
114−-- GENERATE FOR REPL ENDPOINT
115−
116−
117−generateForReplEndpoint :: L.Localizer -> Opt.GlobalGraph -> ModuleName.Canonical -> Maybe Name.Name -> Can.Annotation -> B.Builder
118−generateForReplEndpoint localizer (Opt.GlobalGraph graph _) home maybeName (Can.Forall _ tipe) =
119− let
120− name = maybe Name.replValueToPrint id maybeName
121− mode = Mode.Dev Nothing
122− debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")
123− evalState = addGlobal mode graph debugState (Opt.Global home name)
124− in
125− Functions.functions
126− <> stateToBuilder evalState
127− <> postMessage localizer home maybeName tipe
128−
129−
130−postMessage :: L.Localizer -> ModuleName.Canonical -> Maybe Name.Name -> Can.Type -> B.Builder
131−postMessage localizer home maybeName tipe =
132− let
133− name = maybe Name.replValueToPrint id maybeName
134− value = JsName.toBuilder (JsName.fromGlobal home name)
135− toString = JsName.toBuilder (JsName.fromKernel Name.debug "toAnsiString")
136− tipeDoc = RT.canToDoc localizer RT.None tipe
137− toName n = "\"" <> Name.toBuilder n <> "\""
138− in
139− "self.postMessage({\n\
140− \ name: " <> maybe "null" toName maybeName <> ",\n\
141− \ value: " <> toString <> "(true, " <> value <> "),\n\
142− \ type: " <> B.stringUtf8 (show (D.toString tipeDoc)) <> "\n\
143− \});\n"
108+ \}\n"
144
109
145
110
146
111
@@ -292,7 +257,7 @@ generateCycle mode (Opt.Global home _) names values functions =
292 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"
257 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"
293 <> drawCycle names
258 <> drawCycle names
294 <> "\\n\\nThese errors are very tricky, so read "
259 <> "\\n\\nThese errors are very tricky, so read "
295− <> B.stringUtf8 (D.makeNakedLink "bad-recursion")
260+ <> B.stringUtf8 (D.makeNakedLink "halting-problem")
296 <> " to learn how to fix it!"
261 <> " to learn how to fix it!"
297 ]
262 ]
298
263
compiler/src/Optimize/Port.hs+1−1
@@ -58,7 +58,7 @@ toEncoder tipe =
58 | name == Name.array -> encodeArray arg
58 | name == Name.array -> encodeArray arg
59
59
60 _ ->
60 _ ->
61− error "toEncoder: bad custom type"
61+ error "toEncoder: bad union type"
62
62
63 Can.TRecord _ (Just _) ->
63 Can.TRecord _ (Just _) ->
64 error "toEncoder: bad record"
64 error "toEncoder: bad record"
compiler/src/Parse/Module.hs+35−81
@@ -2,8 +2,6 @@
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
3module Parse.Module
4 ( fromByteString
4 ( fromByteString
5− , ProjectType(..)
6− , isKernel
7 , chompImports
5 , chompImports
8 , chompImport
6 , chompImport
9 )
7 )
@@ -31,37 +29,14 @@ import qualified Reporting.Error.Syntax as E
31-- FROM BYTE STRING
29-- FROM BYTE STRING
32
30
33
31
34−fromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module
32+fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module
35−fromByteString projectType source =
33+fromByteString pkg source =
36− case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of
34+ case P.fromByteString (chompModule pkg) E.ModuleBadEnd source of
37− Right modul -> checkModule projectType modul
35+ Right modul -> checkModule modul
38 Left err -> Left (E.ParseError err)
36 Left err -> Left (E.ParseError err)
39
37
40
38
41
39
42−-- PROJECT TYPE
43−
44−
45−data ProjectType
46− = Package Pkg.Name
47− | Application
48−
49−
50−isCore :: ProjectType -> Bool
51−isCore projectType =
52− case projectType of
53− Package pkg -> pkg == Pkg.core
54− Application -> False
55−
56−
57−isKernel :: ProjectType -> Bool
58−isKernel projectType =
59− case projectType of
60− Package pkg -> Pkg.isKernel pkg
61− Application -> False
62−
63−
64−
65-- MODULE
40-- MODULE
66
41
67
42
@@ -74,11 +49,11 @@ data Module =
74 }
49 }
75
50
76
51
77−chompModule :: ProjectType -> Parser E.Module Module
52+chompModule :: Pkg.Name -> Parser E.Module Module
78−chompModule projectType =
53+chompModule pkg =
79 do header <- chompHeader
54 do header <- chompHeader
80− imports <- chompImports (if isCore projectType then [] else Imports.defaults)
55+ imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)
81− infixes <- if isKernel projectType then chompInfixes [] else return []
56+ infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []
82 decls <- specialize E.Declarations $ chompDecls []
57 decls <- specialize E.Declarations $ chompDecls []
83 return (Module header imports infixes decls)
58 return (Module header imports infixes decls)
84
59
@@ -87,15 +62,15 @@ chompModule projectType =
87-- CHECK MODULE
62-- CHECK MODULE
88
63
89
64
90−checkModule :: ProjectType -> Module -> Either E.Error Src.Module
65+checkModule :: Module -> Either E.Error Src.Module
91−checkModule projectType (Module maybeHeader imports infixes decls) =
66+checkModule (Module maybeHeader imports infixes decls) =
92 let
67 let
93 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
68 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
94 in
69 in
95 case maybeHeader of
70 case maybeHeader of
96 Just (Header name effects exports docs) ->
71 Just (Header name effects exports docs) ->
97 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
72 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
98− <$> checkEffects projectType ports effects
73+ <$> checkEffects ports effects
99
74
100 Nothing ->
75 Nothing ->
101 Right $
76 Right $
@@ -105,37 +80,23 @@ checkModule projectType (Module maybeHeader imports infixes decls) =
105 _:_ -> Src.Ports ports
80 _:_ -> Src.Ports ports
106
81
107
82
108−checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects
83+checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects
109−checkEffects projectType ports effects =
84+checkEffects ports effects =
110 case effects of
85 case effects of
111 NoEffects region ->
86 NoEffects region ->
112 case ports of
87 case ports of
113− [] ->
114− Right Src.NoEffects
88+ [] -> Right Src.NoEffects
115−
116− Src.Port name _ : _ ->
117− case projectType of
118− Package _ -> Left (E.NoPortsInPackage name)
119− Application -> Left (E.UnexpectedPort region)
89+ _:_ -> Left (E.UnexpectedPort region)
120
90
121 Ports region ->
91 Ports region ->
122− case projectType of
123− Package _ ->
124− Left (E.NoPortModulesInPackage region)
125−
126− Application ->
127− case ports of
92+ case ports of
128− [] -> Left (E.NoPorts region)
93+ [] -> Left (E.NoPorts region)
129− _:_ -> Right (Src.Ports ports)
94+ _:_ -> Right (Src.Ports ports)
130
95
131 Manager region manager ->
96 Manager region manager ->
132− if isKernel projectType then
133− case ports of
97+ case ports of
134− [] -> Right (Src.Manager region manager)
98+ [] -> Right (Src.Manager region manager)
135− _:_ -> Left (E.UnexpectedPort region)
99+ _:_ -> Left (E.UnexpectedPort region)
136− else
137− Left (E.NoEffectsOutsideKernel region)
138−
139
100
140
101
141categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )
102categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )
@@ -434,18 +395,18 @@ exposing =
434 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
395 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
435 word1 0x29 {-)-} E.ExposingEnd
396 word1 0x29 {-)-} E.ExposingEnd
436 return Src.Open
397 return Src.Open
437− , do exposed <- chompExposed
398+ , do exposed <- addLocation chompExposed
438 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
399 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
439 exposingHelp [exposed]
400 exposingHelp [exposed]
440 ]
401 ]
441
402
442
403
443−exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing
404+exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing
444exposingHelp revExposed =
405exposingHelp revExposed =
445 oneOf E.ExposingEnd
406 oneOf E.ExposingEnd
446 [ do word1 0x2C {-,-} E.ExposingEnd
407 [ do word1 0x2C {-,-} E.ExposingEnd
447 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
408 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
448− exposed <- chompExposed
409+ exposed <- addLocation chompExposed
449 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
410 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
450 exposingHelp (exposed:revExposed)
411 exposingHelp (exposed:revExposed)
451 , do word1 0x29 {-)-} E.ExposingEnd
412 , do word1 0x29 {-)-} E.ExposingEnd
@@ -455,21 +416,16 @@ exposingHelp revExposed =
455
416
456chompExposed :: Parser E.Exposing Src.Exposed
417chompExposed :: Parser E.Exposing Src.Exposed
457chompExposed =
418chompExposed =
458− do start <- getPosition
459− oneOf E.ExposingValue
419+ oneOf E.ExposingValue
460− [ do name <- Var.lower E.ExposingValue
420+ [ Src.Lower <$> Var.lower E.ExposingValue
461− end <- getPosition
462− return $ Src.Lower $ A.at start end name
463− , do word1 0x28 {-(-} E.ExposingValue
421+ , do word1 0x28 {-(-} E.ExposingValue
464− op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
422+ op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
465− word1 0x29 {-)-} E.ExposingOperatorRightParen
423+ word1 0x29 {-)-} E.ExposingOperatorRightParen
466− end <- getPosition
467− return $ Src.Operator (A.Region start end) op
424+ return (Src.Operator op)
468− , do name <- Var.upper E.ExposingValue
425+ , do name <- Var.upper E.ExposingValue
469− end <- getPosition
470− Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
426+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
471− Src.Upper (A.at start end name) <$> privacy
427+ Src.Upper name <$> privacy
472− ]
428+ ]
473
429
474
430
475privacy :: Parser E.Exposing Src.Privacy
431privacy :: Parser E.Exposing Src.Privacy
@@ -477,11 +433,9 @@ privacy =
477 oneOfWithFallback
433 oneOfWithFallback
478 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
434 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
479 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
435 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
480− start <- getPosition
481 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
436 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
482− end <- getPosition
483 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
437 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
484 word1 0x29 {-)-} E.ExposingTypePrivacy
438 word1 0x29 {-)-} E.ExposingTypePrivacy
485− return $ Src.Public (A.Region start end)
439+ return Src.Public
486 ]
440 ]
487 Src.Private
441 Src.Private
compiler/src/Parse/Pattern.hs+1−1
@@ -129,7 +129,7 @@ recordHelp start vars =
129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd
129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd
130 recordHelp start (var:vars)
130 recordHelp start (var:vars)
131 , do word1 0x7D {-}-} E.PRecordEnd
131 , do word1 0x7D {-}-} E.PRecordEnd
132− addEnd start (Src.PRecord (reverse vars))
132+ addEnd start (Src.PRecord vars)
133 ]
133 ]
134
134
135
135
compiler/src/Parse/Variable.hs+2−2
@@ -149,14 +149,14 @@ foreignUpper toError =
149 let
149 let
150 !newState = P.State src upperEnd end indent row newCol
150 !newState = P.State src upperEnd end indent row newCol
151 !name = Name.fromPtr upperStart upperEnd
151 !name = Name.fromPtr upperStart upperEnd
152− !upperName =
152+ !foreign =
153 if upperStart == pos then
153 if upperStart == pos then
154 Unqualified name
154 Unqualified name
155 else
155 else
156 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in
156 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in
157 Qualified home name
157 Qualified home name
158 in
158 in
159− cok upperName newState
159+ cok foreign newState
160
160
161
161
162foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)
162foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)
compiler/src/Reporting/Error.hs+16−20
@@ -12,7 +12,6 @@ module Reporting.Error
12import qualified Data.ByteString as B
12import qualified Data.ByteString as B
13import qualified Data.NonEmptyList as NE
13import qualified Data.NonEmptyList as NE
14import qualified Data.OneOrMore as OneOrMore
14import qualified Data.OneOrMore as OneOrMore
15−import qualified System.FilePath as FP
16
15
17import qualified Elm.ModuleName as ModuleName
16import qualified Elm.ModuleName as ModuleName
18import qualified File
17import qualified File
@@ -39,8 +38,8 @@ import qualified Reporting.Report as Report
39data Module =
38data Module =
40 Module
39 Module
41 { _name :: ModuleName.Raw
40 { _name :: ModuleName.Raw
42− , _absolutePath :: FilePath
41+ , _path :: FilePath
43− , _modificationTime :: File.Time
42+ , _time :: File.Time
44 , _source :: B.ByteString
43 , _source :: B.ByteString
45 , _error :: Error
44 , _error :: Error
46 }
45 }
@@ -93,26 +92,26 @@ toReports source err =
93-- TO DOC
92-- TO DOC
94
93
95
94
96−toDoc :: FilePath -> Module -> [Module] -> D.Doc
95+toDoc :: Module -> [Module] -> D.Doc
97−toDoc root err errs =
96+toDoc err errs =
98 let
97 let
99− (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)
98+ (NE.List m ms) = NE.sortBy _time (NE.List err errs)
100 in
99 in
101− D.vcat (toDocHelp root m ms)
100+ D.vcat (toDocHelp m ms)
102
101
103
102
104−toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]
103+toDocHelp :: Module -> [Module] -> [D.Doc]
105−toDocHelp root module1 modules =
104+toDocHelp module1 modules =
106 case modules of
105 case modules of
107 [] ->
106 [] ->
108− [moduleToDoc root module1
107+ [moduleToDoc module1
109 ,""
108 ,""
110 ]
109 ]
111
110
112 module2 : otherModules ->
111 module2 : otherModules ->
113− moduleToDoc root module1
112+ moduleToDoc module1
114 : toSeparator module1 module2
113 : toSeparator module1 module2
115− : toDocHelp root module2 otherModules
114+ : toDocHelp module2 otherModules
116
115
117
116
118toSeparator :: Module -> Module -> D.Doc
117toSeparator :: Module -> Module -> D.Doc
@@ -134,22 +133,19 @@ toSeparator beforeModule afterModule =
134-- MODULE TO DOC
133-- MODULE TO DOC
135
134
136
135
137−moduleToDoc :: FilePath -> Module -> D.Doc
136+moduleToDoc :: Module -> D.Doc
138−moduleToDoc root (Module _ absolutePath _ source err) =
137+moduleToDoc (Module _ path _ source err) =
139 let
138 let
140 reports =
139 reports =
141 toReports (Code.toSource source) err
140 toReports (Code.toSource source) err
142−
143− relativePath =
144− FP.makeRelative root absolutePath
145 in
141 in
146− D.vcat $ map (reportToDoc relativePath) (NE.toList reports)
142+ D.vcat $ map (reportToDoc path) (NE.toList reports)
147
143
148
144
149reportToDoc :: FilePath -> Report.Report -> D.Doc
145reportToDoc :: FilePath -> Report.Report -> D.Doc
150−reportToDoc relativePath (Report.Report title _ _ message) =
146+reportToDoc path (Report.Report title _ _ message) =
151 D.vcat
147 D.vcat
152− [ toMessageBar title relativePath
148+ [ toMessageBar title path
153 , ""
149 , ""
154 , message
150 , message
155 , ""
151 , ""
compiler/src/Reporting/Error/Canonicalize.hs+16−21
@@ -14,10 +14,8 @@ module Reporting.Error.Canonicalize
14
14
15
15
16import qualified Data.Char as Char
16import qualified Data.Char as Char
17−import qualified Data.List as List
18import qualified Data.Map as Map
17import qualified Data.Map as Map
19import qualified Data.Name as Name
18import qualified Data.Name as Name
20−import qualified Data.OneOrMore as OneOrMore
21import qualified Data.Set as Set
19import qualified Data.Set as Set
22
20
23import qualified AST.Canonical as Can
21import qualified AST.Canonical as Can
@@ -39,10 +37,10 @@ import qualified Reporting.Suggest as Suggest
39
37
40data Error
38data Error
41 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
39 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
42− | AmbiguousVar A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
40+ | AmbiguousVar A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
43− | AmbiguousType A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
41+ | AmbiguousType A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
44− | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
42+ | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
45− | AmbiguousBinop A.Region Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
43+ | AmbiguousBinop A.Region Name.Name [ModuleName.Canonical]
46 | BadArity A.Region BadArityContext Name.Name Int Int
44 | BadArity A.Region BadArityContext Name.Name Int Int
47 | Binop A.Region Name.Name Name.Name
45 | Binop A.Region Name.Name Name.Name
48 | DuplicateDecl Name.Name A.Region A.Region
46 | DuplicateDecl Name.Name A.Region A.Region
@@ -166,17 +164,17 @@ toReport source err =
166 <> " be deleted? Maybe some parentheses are missing?"
164 <> " be deleted? Maybe some parentheses are missing?"
167 )
165 )
168
166
169− AmbiguousVar region maybePrefix name h hs ->
167+ AmbiguousVar region maybePrefix name possibleHomes ->
170− ambiguousName source region maybePrefix name h hs "variable"
168+ ambiguousName source region maybePrefix name possibleHomes "variable"
171
169
172− AmbiguousType region maybePrefix name h hs ->
170+ AmbiguousType region maybePrefix name possibleHomes ->
173− ambiguousName source region maybePrefix name h hs "type"
171+ ambiguousName source region maybePrefix name possibleHomes "type"
174
172
175− AmbiguousVariant region maybePrefix name h hs ->
173+ AmbiguousVariant region maybePrefix name possibleHomes ->
176− ambiguousName source region maybePrefix name h hs "variant"
174+ ambiguousName source region maybePrefix name possibleHomes "variant"
177
175
178− AmbiguousBinop region name h hs ->
176+ AmbiguousBinop region name possibleHomes ->
179− ambiguousName source region Nothing name h hs "operator"
177+ ambiguousName source region Nothing name possibleHomes "operator"
180
178
181 BadArity region badArityContext name expected actual ->
179 BadArity region badArityContext name expected actual ->
182 let
180 let
@@ -679,7 +677,7 @@ toReport source err =
679 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
677 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
680 ,
678 ,
681 D.stack
679 D.stack
682− [ makeTheory "Are you trying to mutate a variable?" $
680+ [ makeTheory "Are you are trying to mutate a variable?" $
683 "Elm does not have mutation, so when I see " ++ Name.toChars name
681 "Elm does not have mutation, so when I see " ++ Name.toChars name
684 ++ " defined in terms of " ++ Name.toChars name
682 ++ " defined in terms of " ++ Name.toChars name
685 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
683 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -725,7 +723,7 @@ toReport source err =
725 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
723 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
726 ,
724 ,
727 D.stack
725 D.stack
728− [ makeTheory "Are you trying to mutate a variable?" $
726+ [ makeTheory "Are you are trying to mutate a variable?" $
729 "Elm does not have mutation, so when I see " ++ Name.toChars name
727 "Elm does not have mutation, so when I see " ++ Name.toChars name
730 ++ " defined in terms of " ++ Name.toChars name
728 ++ " defined in terms of " ++ Name.toChars name
731 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
729 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -976,11 +974,8 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =
976-- AMBIGUOUS NAME
974-- AMBIGUOUS NAME
977
975
978
976
979−ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> ModuleName.Canonical -> OneOrMore.OneOrMore ModuleName.Canonical -> String -> Report.Report
977+ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> [ModuleName.Canonical] -> String -> Report.Report
980−ambiguousName source region maybePrefix name h hs thing =
978+ambiguousName source region maybePrefix name possibleHomes thing =
981− let
982− possibleHomes = List.sort (h : OneOrMore.destruct (:) hs)
983− in
984 Report.Report "AMBIGUOUS NAME" region [] $
979 Report.Report "AMBIGUOUS NAME" region [] $
985 Code.toSnippet source region Nothing $
980 Code.toSnippet source region Nothing $
986 case maybePrefix of
981 case maybePrefix of
compiler/src/Reporting/Error/Import.hs+1−1
@@ -56,7 +56,7 @@ toReport source (Error region name unimportedModules problem) =
56 D.stack
56 D.stack
57 [
57 [
58 D.reflow $
58 D.reflow $
59− "I checked the \"dependencies\" and \"source-directories\" listed in your elm.json,\
59+ "I checked the \"dependencies\" and \"source-directories\" listend in your elm.json,\
60 \ but I cannot find it! Maybe it is a typo for one of these names?"
60 \ but I cannot find it! Maybe it is a typo for one of these names?"
61 ,
61 ,
62 D.dullyellow $ D.indent 4 $ D.vcat $
62 D.dullyellow $ D.indent 4 $ D.vcat $
compiler/src/Reporting/Error/Json.hs+4−16
@@ -51,13 +51,9 @@ parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Re
51parseErrorToReport path source parseError reason =
51parseErrorToReport path source parseError reason =
52 let
52 let
53 toSnippet title row col (problem, details) =
53 toSnippet title row col (problem, details) =
54− let
55− pos = A.Position row col
54+ let pos = A.Position row col in
56− surroundings = A.Region (A.Position (max 1 (row - 2)) 1) pos
57− region = A.Region pos pos
58− in
59 Help.jsonReport title (Just path) $
55 Help.jsonReport title (Just path) $
60− Code.toSnippet source surroundings (Just region)
56+ Code.toSnippet source (A.Region pos pos) Nothing
61 ( D.reflow (because reason problem)
57 ( D.reflow (because reason problem)
62 , details
58 , details
63 )
59 )
@@ -81,20 +77,12 @@ parseErrorToReport path source parseError reason =
81 )
77 )
82
78
83 ObjectField row col ->
79 ObjectField row col ->
84− toSnippet "EXTRA COMMA" row col
80+ toSnippet "UNFINISHED OBJECT" row col
85 (
81 (
86 "I was partway through parsing a JSON object when I got stuck here:"
82 "I was partway through parsing a JSON object when I got stuck here:"
87 ,
83 ,
88 D.stack
84 D.stack
89− [ D.fillSep
90− ["I","saw","a","comma","right","before","I","got","stuck","here,"
91− ,"so","I","was","expecting","to","see","a","field","name","like"
85+ [ D.reflow $ "I was expecting to see a field name next."
92− ,D.dullyellow "\"type\"","or",D.dullyellow "\"dependencies\"","next."
93− ]
94− , D.reflow $
95− "This error is commonly caused by trailing commas in JSON objects. Those are\
96− \ actually disallowed by <https://json.org> so check the previous line for a\
97− \ trailing comma that may need to be deleted."
98 , objectNote
86 , objectNote
99 ]
87 ]
100 )
88 )
compiler/src/Reporting/Error/Pattern.hs+2−2
@@ -41,7 +41,7 @@ toReport source err =
41 Report.Report "UNSAFE PATTERN" region [] $
41 Report.Report "UNSAFE PATTERN" region [] $
42 Code.toSnippet source region Nothing
42 Code.toSnippet source region Nothing
43 (
43 (
44− "This pattern does not cover all possibilities:"
44+ "This pattern does not cover all possiblities:"
45 ,
45 ,
46 D.stack
46 D.stack
47 [ "Other possibilities include:"
47 [ "Other possibilities include:"
@@ -64,7 +64,7 @@ toReport source err =
64 , unhandledPatternsToDocBlock unhandled
64 , unhandledPatternsToDocBlock unhandled
65 , D.reflow $
65 , D.reflow $
66 "I would have to crash if I saw one of those! You can use\
66 "I would have to crash if I saw one of those! You can use\
67− \ `let` to deconstruct values only if there is ONE possibility.\
67+ \ `let` to deconstruct values only if there is ONE possiblity.\
68 \ Switch to a `case` expression to account for all possibilities."
68 \ Switch to a `case` expression to account for all possibilities."
69 , D.toSimpleHint $
69 , D.toSimpleHint $
70 "Are you calling a function that definitely returns values\
70 "Are you calling a function that definitely returns values\
compiler/src/Reporting/Error/Syntax.hs+516−963
@@ -69,9 +69,6 @@ data Error
69 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)
69 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)
70 | UnexpectedPort A.Region
70 | UnexpectedPort A.Region
71 | NoPorts A.Region
71 | NoPorts A.Region
72− | NoPortsInPackage (A.Located Name.Name)
73− | NoPortModulesInPackage A.Region
74− | NoEffectsOutsideKernel A.Region
75 | ParseError Module
72 | ParseError Module
76
73
77
74
@@ -564,84 +561,10 @@ toReport source err =
564 ]
561 ]
565 )
562 )
566
563
567− NoPortsInPackage (A.At region _) ->
568− Report.Report "PACKAGES CANNOT HAVE PORTS" region [] $
569− Code.toSnippet source region Nothing
570− (
571− D.reflow $
572− "Packages cannot declare any ports, so I am getting stuck here:"
573− ,
574− D.stack
575− [ D.reflow $
576− "Remove this port declaration."
577− , noteForPortsInPackage
578− ]
579− )
580−
581− NoPortModulesInPackage region ->
582− Report.Report "PACKAGES CANNOT HAVE PORTS" region [] $
583− Code.toSnippet source region Nothing
584− (
585− D.reflow $
586− "Packages cannot declare any ports, so I am getting stuck here:"
587− ,
588− D.stack
589− [ D.fillSep $
590− ["Remove","the",D.cyan "port","keyword","and","I"
591− ,"should","be","able","to","continue."
592− ]
593− , noteForPortsInPackage
594− ]
595− )
596−
597− NoEffectsOutsideKernel region ->
598− Report.Report "INVALID EFFECT MODULE" region [] $
599− Code.toSnippet source region Nothing
600− (
601− D.reflow $
602− "It is not possible to declare an `effect module` outside the @elm organization,\
603− \ so I am getting stuck here:"
604− ,
605− D.stack
606− [ D.reflow $
607− "Switch to a normal module declaration."
608− , D.toSimpleNote $
609− "Effect modules are designed to allow certain core functionality to be\
610− \ defined separately from the compiler. So the @elm organization has access to\
611− \ this so that certain changes, extensions, and fixes can be introduced without\
612− \ needing to release new Elm binaries. For example, we want to make it possible\
613− \ to test effects, but this may require changes to the design of effect modules.\
614− \ By only having them defined in the @elm organization, that kind of design work\
615− \ can proceed much more smoothly."
616− ]
617− )
618−
619 ParseError modul ->
564 ParseError modul ->
620 toParseErrorReport source modul
565 toParseErrorReport source modul
621
566
622
567
623−noteForPortsInPackage :: D.Doc
624−noteForPortsInPackage =
625− D.stack
626− [ D.toSimpleNote $
627− "One of the major goals of the package ecosystem is to be completely written\
628− \ in Elm. This means when you install an Elm package, you can be sure you are safe\
629− \ from security issues on install and that you are not going to get any runtime\
630− \ exceptions coming from your new dependency. This design also sets the ecosystem\
631− \ up to target other platforms more easily (like mobile phones, WebAssembly, etc.)\
632− \ since no community code explicitly depends on JavaScript even existing."
633− , D.reflow $
634− "Given that overall goal, allowing ports in packages would lead to some pretty\
635− \ surprising behavior. If ports were allowed in packages, you could install a\
636− \ package but not realize that it brings in an indirect dependency that defines a\
637− \ port. Now you have a program that does not work and the fix is to realize that\
638− \ some JavaScript needs to be added for a dependency you did not even know about.\
639− \ That would be extremely frustrating! \"So why not allow the package author to\
640− \ include the necessary JS code as well?\" Now we are back in conflict with our\
641− \ overall goal to keep all community packages free from runtime exceptions."
642− ]
643−
644−
645toParseErrorReport :: Code.Source -> Module -> Report.Report
568toParseErrorReport :: Code.Source -> Module -> Report.Report
646toParseErrorReport source modul =
569toParseErrorReport source modul =
647 case modul of
570 case modul of
@@ -649,9 +572,156 @@ toParseErrorReport source modul =
649 toSpaceReport source space row col
572 toSpaceReport source space row col
650
573
651 ModuleBadEnd row col ->
574 ModuleBadEnd row col ->
652− if col == 1
575+ case Code.whatIsNext source row col of
653− then toDeclStartReport source row col
576+ Code.Keyword keyword ->
654− else toWeirdEndReport source row col
577+ let
578+ region = toKeywordRegion row col keyword
579+ in
580+ Report.Report "RESERVED WORD" region [] $
581+ Code.toSnippet source region Nothing
582+ (
583+ D.reflow $
584+ "I got stuck on this reserved word:"
585+ ,
586+ D.reflow $
587+ "The name `" ++ keyword ++ "` is reserved, so try using a different name?"
588+ )
589+
590+ Code.Operator op ->
591+ let
592+ region = toKeywordRegion row col op
593+ in
594+ Report.Report "UNEXPECTED SYMBOL" region [] $
595+ Code.toSnippet source region Nothing
596+ (
597+ D.reflow $
598+ "I ran into an unexpected symbol:"
599+ ,
600+ D.reflow $
601+ "I was not expecting to see a " ++ op ++ " here. Try deleting it? Maybe\
602+ \ I can give a better hint from there?"
603+ )
604+
605+ Code.Close term bracket ->
606+ let
607+ region = toRegion row col
608+ in
609+ Report.Report ("UNEXPECTED " ++ map Char.toUpper term) region [] $
610+ Code.toSnippet source region Nothing
611+ (
612+ D.reflow $
613+ "I ran into an unexpected " ++ term ++ ":"
614+ ,
615+ D.reflow $
616+ "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"
617+ )
618+
619+ Code.Other maybeChar ->
620+ let
621+ region = toRegion row col
622+ in
623+ case maybeChar of
624+ Just ';' ->
625+ Report.Report "UNEXPECTED SEMICOLON" region [] $
626+ Code.toSnippet source region Nothing
627+ (
628+ D.reflow $
629+ "I got stuck on this semicolon:"
630+ ,
631+ D.stack
632+ [ D.reflow $ "Try removing it?"
633+ , D.toSimpleNote $
634+ "Some languages require semicolons at the end of each statement. These are\
635+ \ often called C-like languages, and they usually share a lot of language design\
636+ \ choices. (E.g. side-effects, for loops, etc.) Elm manages effects with commands\
637+ \ and subscriptions instead, so there is no special syntax for \"statements\" and\
638+ \ therefore no need to use semicolons to separate them. I think this will make\
639+ \ more sense as you work through <https://guide.elm-lang.org> though!"
640+ ]
641+ )
642+
643+ Just ',' ->
644+ Report.Report "UNEXPECTED COMMA" region [] $
645+ Code.toSnippet source region Nothing
646+ (
647+ D.reflow $
648+ "I got stuck on this comma:"
649+ ,
650+ D.stack
651+ [ D.reflow $
652+ "I do not think I am parsing a list or tuple right now. Try deleting the comma?"
653+ , D.toSimpleNote $
654+ "If this is supposed to be part of a list, the problem may be a bit earlier.\
655+ \ Perhaps the opening [ is missing? Or perhaps some value in the list has an extra\
656+ \ closing ] that is making me think the list ended earlier? The same kinds of\
657+ \ things could be going wrong if this is supposed to be a tuple."
658+ ]
659+ )
660+
661+ Just '`' ->
662+ Report.Report "UNEXPECTED CHARACTER" region [] $
663+ Code.toSnippet source region Nothing
664+ (
665+ D.reflow $
666+ "I got stuck on this character:"
667+ ,
668+ D.stack
669+ [ D.reflow $
670+ "It is not used for anything in Elm syntax. It is used for multi-line strings in\
671+ \ some languages though, so if you want a string that spans multiple lines, you\
672+ \ can use Elm's multi-line string syntax like this:"
673+ , D.vcat
674+ [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
675+ , mempty
676+ , D.dullyellow "# Multi-line Strings"
677+ , mempty
678+ , D.dullyellow "- start with triple double quotes"
679+ , D.dullyellow "- write whatever you want"
680+ , D.dullyellow "- no need to escape newlines or double quotes"
681+ , D.dullyellow "- end with triple double quotes"
682+ , mempty
683+ , D.dullyellow "\"\"\""
684+ ]
685+ , D.reflow $
686+ "Otherwise I do not know what is going on! Try removing the character?"
687+ ]
688+ )
689+
690+ Just '$' ->
691+ Report.Report "UNEXPECTED SYMBOL" region [] $
692+ Code.toSnippet source region Nothing
693+ (
694+ D.reflow $
695+ "I got stuck on this dollar sign:"
696+ ,
697+ D.reflow $
698+ "It is not used for anything in Elm syntax. Are you coming from a language where\
699+ \ dollar signs can be used in variable names? If so, try a name that (1) starts\
700+ \ with a letter and (2) only contains letters, numbers, and underscores."
701+ )
702+
703+ Just c | elem c ['#','@','!','%','~'] ->
704+ Report.Report "UNEXPECTED SYMBOL" region [] $
705+ Code.toSnippet source region Nothing
706+ (
707+ D.reflow $
708+ "I got stuck on this symbol:"
709+ ,
710+ D.reflow $
711+ "It is not used for anything in Elm syntax. Try removing it?"
712+ )
713+
714+ _ ->
715+ Report.Report "SYNTAX PROBLEM" region [] $
716+ Code.toSnippet source region Nothing
717+ (
718+ D.reflow $
719+ "I got stuck here:"
720+ ,
721+ D.reflow $
722+ "Whatever I am running into is confusing me a lot! Normally I can give fairly\
723+ \ specific hints, but something is really tripping me up this time."
724+ )
655
725
656 ModuleProblem row col ->
726 ModuleProblem row col ->
657 let
727 let
@@ -797,11 +867,11 @@ toParseErrorReport source modul =
797 [ D.reflow $
867 [ D.reflow $
798 "I am not sure what is going on, but I recommend starting an Elm\
868 "I am not sure what is going on, but I recommend starting an Elm\
799 \ file with the following lines:"
869 \ file with the following lines:"
800− , D.indent 4 $ D.vcat $
870+ , D.vcat
801 [ D.fillSep [D.cyan "import","Html"]
871 [ D.fillSep [D.cyan "import","Html"]
802 , ""
872 , ""
803− , "main ="
873+ , D.fillSep [D.green "main","="]
804− , " Html.text " <> D.dullyellow "\"Hello!\""
874+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
805 ]
875 ]
806 , D.reflow $
876 , D.reflow $
807 "You should be able to copy those lines directly into your file. Check out the\
877 "You should be able to copy those lines directly into your file. Check out the\
@@ -830,12 +900,11 @@ toParseErrorReport source modul =
830 , D.indent 4 $ D.vcat $
900 , D.indent 4 $ D.vcat $
831 [ D.fillSep [D.cyan "import","Dict"]
901 [ D.fillSep [D.cyan "import","Dict"]
832 , D.fillSep [D.cyan "import","Maybe"]
902 , D.fillSep [D.cyan "import","Maybe"]
833− , D.fillSep [D.cyan "import","Html.Attributes",D.cyan "as","A"]
903+ , D.fillSep [D.cyan "import","Html.Attributes"]
834− , D.fillSep [D.cyan "import","Json.Decode",D.cyan "exposing","(..)"]
904+ , D.fillSep [D.cyan "import","Json.Decode"]
835 ]
905 ]
836 , D.reflow $
906 , D.reflow $
837 "Notice that the module names all start with capital letters. That is required!"
907 "Notice that the module names all start with capital letters. That is required!"
838− , D.reflowLink "Read" "imports" "to learn more."
839 ]
908 ]
840 )
909 )
841
910
@@ -862,7 +931,6 @@ toParseErrorReport source modul =
862 ]
931 ]
863 , D.reflow $
932 , D.reflow $
864 "Notice that the alias always starts with a capital letter. That is required!"
933 "Notice that the alias always starts with a capital letter. That is required!"
865− , D.reflowLink "Read" "imports" "to learn more."
866 ]
934 ]
867 )
935 )
868
936
@@ -925,192 +993,6 @@ toParseErrorReport source modul =
925
993
926
994
927
995
928−-- WEIRD END
929−
930−
931−toWeirdEndReport :: Code.Source -> Row -> Col -> Report.Report
932−toWeirdEndReport source row col =
933− case Code.whatIsNext source row col of
934− Code.Keyword keyword ->
935− let
936− region = toKeywordRegion row col keyword
937− in
938− Report.Report "RESERVED WORD" region [] $
939− Code.toSnippet source region Nothing
940− (
941− D.reflow $
942− "I got stuck on this reserved word:"
943− ,
944− D.reflow $
945− "The name `" ++ keyword ++ "` is reserved, so try using a different name?"
946− )
947−
948− Code.Operator op ->
949− let
950− region = toKeywordRegion row col op
951− in
952− Report.Report "UNEXPECTED SYMBOL" region [] $
953− Code.toSnippet source region Nothing
954− (
955− D.reflow $
956− "I ran into an unexpected symbol:"
957− ,
958− D.reflow $
959− "I was not expecting to see a " ++ op ++ " here. Try deleting it? Maybe\
960− \ I can give a better hint from there?"
961− )
962−
963− Code.Close term bracket ->
964− let
965− region = toRegion row col
966− in
967− Report.Report ("UNEXPECTED " ++ map Char.toUpper term) region [] $
968− Code.toSnippet source region Nothing
969− (
970− D.reflow $
971− "I ran into an unexpected " ++ term ++ ":"
972− ,
973− D.reflow $
974− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"
975− )
976−
977− Code.Lower c cs ->
978− let
979− region = toKeywordRegion row col (c:cs)
980− in
981− Report.Report "UNEXPECTED NAME" region [] $
982− Code.toSnippet source region Nothing
983− (
984− D.reflow $
985− "I got stuck on this name:"
986− ,
987− D.reflow $
988− "It is confusing me a lot! Normally I can give fairly specific hints, but\
989− \ something is really tripping me up this time."
990− )
991−
992− Code.Upper c cs ->
993− let
994− region = toKeywordRegion row col (c:cs)
995− in
996− Report.Report "UNEXPECTED NAME" region [] $
997− Code.toSnippet source region Nothing
998− (
999− D.reflow $
1000− "I got stuck on this name:"
1001− ,
1002− D.reflow $
1003− "It is confusing me a lot! Normally I can give fairly specific hints, but\
1004− \ something is really tripping me up this time."
1005− )
1006−
1007− Code.Other maybeChar ->
1008− let
1009− region = toRegion row col
1010− in
1011− case maybeChar of
1012− Just ';' ->
1013− Report.Report "UNEXPECTED SEMICOLON" region [] $
1014− Code.toSnippet source region Nothing
1015− (
1016− D.reflow $
1017− "I got stuck on this semicolon:"
1018− ,
1019− D.stack
1020− [ D.reflow $ "Try removing it?"
1021− , D.toSimpleNote $
1022− "Some languages require semicolons at the end of each statement. These are\
1023− \ often called C-like languages, and they usually share a lot of language design\
1024− \ choices. (E.g. side-effects, for loops, etc.) Elm manages effects with commands\
1025− \ and subscriptions instead, so there is no special syntax for \"statements\" and\
1026− \ therefore no need to use semicolons to separate them. I think this will make\
1027− \ more sense as you work through <https://guide.elm-lang.org> though!"
1028− ]
1029− )
1030−
1031− Just ',' ->
1032− Report.Report "UNEXPECTED COMMA" region [] $
1033− Code.toSnippet source region Nothing
1034− (
1035− D.reflow $
1036− "I got stuck on this comma:"
1037− ,
1038− D.stack
1039− [ D.reflow $
1040− "I do not think I am parsing a list or tuple right now. Try deleting the comma?"
1041− , D.toSimpleNote $
1042− "If this is supposed to be part of a list, the problem may be a bit earlier.\
1043− \ Perhaps the opening [ is missing? Or perhaps some value in the list has an extra\
1044− \ closing ] that is making me think the list ended earlier? The same kinds of\
1045− \ things could be going wrong if this is supposed to be a tuple."
1046− ]
1047− )
1048−
1049− Just '`' ->
1050− Report.Report "UNEXPECTED CHARACTER" region [] $
1051− Code.toSnippet source region Nothing
1052− (
1053− D.reflow $
1054− "I got stuck on this character:"
1055− ,
1056− D.stack
1057− [ D.reflow $
1058− "It is not used for anything in Elm syntax. It is used for multi-line strings in\
1059− \ some languages though, so if you want a string that spans multiple lines, you\
1060− \ can use Elm's multi-line string syntax like this:"
1061− , D.dullyellow $ D.indent 4 $ D.vcat $
1062− [ "\"\"\""
1063− , "# Multi-line Strings"
1064− , ""
1065− , "- start with triple double quotes"
1066− , "- write whatever you want"
1067− , "- no need to escape newlines or double quotes"
1068− , "- end with triple double quotes"
1069− , "\"\"\""
1070− ]
1071− , D.reflow $
1072− "Otherwise I do not know what is going on! Try removing the character?"
1073− ]
1074− )
1075−
1076− Just '$' ->
1077− Report.Report "UNEXPECTED SYMBOL" region [] $
1078− Code.toSnippet source region Nothing
1079− (
1080− D.reflow $
1081− "I got stuck on this dollar sign:"
1082− ,
1083− D.reflow $
1084− "It is not used for anything in Elm syntax. Are you coming from a language where\
1085− \ dollar signs can be used in variable names? If so, try a name that (1) starts\
1086− \ with a letter and (2) only contains letters, numbers, and underscores."
1087− )
1088−
1089− Just c | elem c ['#','@','!','%','~'] ->
1090− Report.Report "UNEXPECTED SYMBOL" region [] $
1091− Code.toSnippet source region Nothing
1092− (
1093− D.reflow $
1094− "I got stuck on this symbol:"
1095− ,
1096− D.reflow $
1097− "It is not used for anything in Elm syntax. Try removing it?"
1098− )
1099−
1100− _ ->
1101− Report.Report "SYNTAX PROBLEM" region [] $
1102− Code.toSnippet source region Nothing
1103− (
1104− D.reflow $
1105− "I got stuck here:"
1106− ,
1107− D.reflow $
1108− "Whatever I am running into is confusing me a lot! Normally I can give fairly\
1109− \ specific hints, but something is really tripping me up this time."
1110− )
1111−
1112−
1113−
1114-- IMPORTS
996-- IMPORTS
1115
997
1116
998
@@ -1136,7 +1018,6 @@ toImportReport source row col =
1136 ]
1018 ]
1137 , D.reflow $
1019 , D.reflow $
1138 "You are probably trying to import a different module, but try to make it look like one of these examples!"
1020 "You are probably trying to import a different module, but try to make it look like one of these examples!"
1139− , D.reflowLink "Read" "imports" "to learn more."
1140 ]
1021 ]
1141 )
1022 )
1142
1023
@@ -1443,7 +1324,106 @@ toDeclarationsReport :: Code.Source -> Decl -> Report.Report
1443toDeclarationsReport source decl =
1324toDeclarationsReport source decl =
1444 case decl of
1325 case decl of
1445 DeclStart row col ->
1326 DeclStart row col ->
1446− toDeclStartReport source row col
1327+ case Code.whatIsNext source row col of
1328+ Code.Close term bracket ->
1329+ let
1330+ region = toRegion row col
1331+ in
1332+ Report.Report ("STRAY " ++ map Char.toUpper term) region [] $
1333+ Code.toSnippet source region Nothing
1334+ (
1335+ D.reflow $
1336+ "I was not expecting to see a " ++ term ++ " here:"
1337+ , D.reflow $
1338+ "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"
1339+ )
1340+
1341+ Code.Keyword keyword ->
1342+ let
1343+ region = toKeywordRegion row col keyword
1344+ in
1345+ Report.Report "RESERVED WORD" region [] $
1346+ Code.toSnippet source region Nothing
1347+ (
1348+ D.reflow $
1349+ "I was not expecting to run into the `" ++ keyword ++ "` keyword here:"
1350+ ,
1351+ case keyword of
1352+ "import" ->
1353+ D.reflow $
1354+ "It is reserved for declaring imports at the top of your module. If you want\
1355+ \ another import, try moving it up top with the other imports. If you want to\
1356+ \ define a value or function, try changing the name to something else!"
1357+
1358+ "case" ->
1359+ D.stack
1360+ [ D.reflow $
1361+ "It is reserved for writing `case` expressions. Try using a different name?"
1362+ , D.toSimpleNote $
1363+ "If you are trying to write a `case` expression, it needs to be part of a\
1364+ \ definition. So you could write something like this instead:"
1365+ , D.vcat $
1366+ [ D.indent 0 $ D.fillSep [D.green "getWidth","maybeWidth","="]
1367+ , D.indent 2 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]
1368+ , D.indent 4 $ D.fillSep [D.blue "Just","width","->"]
1369+ , D.indent 6 $ D.fillSep ["width","+",D.dullyellow "200"]
1370+ , ""
1371+ , D.indent 4 $ D.fillSep [D.blue "Nothing","->"]
1372+ , D.indent 6 $ D.fillSep [D.dullyellow "400"]
1373+ ]
1374+ , D.reflow $
1375+ "This defines a `getWidth` function that we can use elsewhere in our program."
1376+ ]
1377+
1378+ "if" ->
1379+ D.stack
1380+ [ D.reflow $
1381+ "It is reserved for writing `if` expressions. Try using a different name?"
1382+ , D.toSimpleNote $
1383+ "If you are trying to write an `if` expression, it needs to be part of a\
1384+ \ definition. So you could write something like this instead:"
1385+ , D.vcat $
1386+ [ D.indent 0 $ D.fillSep [D.green "reviewPowerLevel","powerLevel","="]
1387+ , D.indent 2 $ D.fillSep $
1388+ [D.cyan "if","powerLevel",">",D.dullyellow "9000"
1389+ ,D.cyan "then",D.dullyellow "\"OVER 9000!!!\""
1390+ ,D.cyan "else",D.dullyellow "\"not bad\""
1391+ ]
1392+ ]
1393+ , D.reflow $
1394+ "This defines a `reviewPowerLevel` function that we can use elsewhere in our program."
1395+ ]
1396+
1397+ _ ->
1398+ D.reflow $
1399+ "It is a reserved word. Try changing the name to something else?"
1400+ )
1401+
1402+ _ ->
1403+ let
1404+ region = toRegion row col
1405+ in
1406+ Report.Report "SYNTAX PROBLEM" region [] $
1407+ Code.toSnippet source region Nothing
1408+ (
1409+ D.reflow $
1410+ "I was expecting to see a new declaration here:"
1411+ ,
1412+ D.stack
1413+ [ D.reflow $
1414+ "I am not sure what is going wrong exactly, but here are a couple valid\
1415+ \ declarations for reference:"
1416+ , D.vcat
1417+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
1418+ , D.fillSep [D.green "add","x","y","="]
1419+ , D.fillSep [" ","x","+","y"]
1420+ ]
1421+ , D.fillSep [D.cyan "type",D.green "User","=","Anonymous","|","LoggedIn String"]
1422+ , D.reflow $
1423+ "Note that all declarations start with lower-case letters in Elm. Capitalization\
1424+ \ makes a difference, so be conscious of that if you are working from examples!"
1425+ ]
1426+ )
1447
1427
1448 DeclSpace space row col ->
1428 DeclSpace space row col ->
1449 toSpaceReport source space row col
1429 toSpaceReport source space row col
@@ -1473,165 +1453,6 @@ toDeclarationsReport source decl =
1473 )
1453 )
1474
1454
1475
1455
1476−toDeclStartReport :: Code.Source -> Row -> Col -> Report.Report
1477−toDeclStartReport source row col =
1478− case Code.whatIsNext source row col of
1479− Code.Close term bracket ->
1480− let
1481− region = toRegion row col
1482− in
1483− Report.Report ("STRAY " ++ map Char.toUpper term) region [] $
1484− Code.toSnippet source region Nothing
1485− (
1486− D.reflow $
1487− "I was not expecting to see a " ++ term ++ " here:"
1488− , D.reflow $
1489− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"
1490− )
1491−
1492− Code.Keyword keyword ->
1493− let
1494− region = toKeywordRegion row col keyword
1495− in
1496− Report.Report "RESERVED WORD" region [] $
1497− Code.toSnippet source region Nothing
1498− (
1499− D.reflow $
1500− "I was not expecting to run into the `" ++ keyword ++ "` keyword here:"
1501− ,
1502− case keyword of
1503− "import" ->
1504− D.reflow $
1505− "It is reserved for declaring imports at the top of your module. If you want\
1506− \ another import, try moving it up top with the other imports. If you want to\
1507− \ define a value or function, try changing the name to something else!"
1508−
1509− "case" ->
1510− D.stack
1511− [ D.reflow $
1512− "It is reserved for writing `case` expressions. Try using a different name?"
1513− , D.toSimpleNote $
1514− "If you are trying to write a `case` expression, it needs to be part of a\
1515− \ definition. So you could write something like this instead:"
1516− , D.indent 4 $ D.vcat $
1517− [ D.indent 0 $ D.fillSep ["getWidth","maybeWidth","="]
1518− , D.indent 2 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]
1519− , D.indent 4 $ D.fillSep [D.blue "Just","width","->"]
1520− , D.indent 6 $ D.fillSep ["width","+",D.dullyellow "200"]
1521− , ""
1522− , D.indent 4 $ D.fillSep [D.blue "Nothing","->"]
1523− , D.indent 6 $ D.fillSep [D.dullyellow "400"]
1524− ]
1525− , D.reflow $
1526− "This defines a `getWidth` function that you can use elsewhere in your program."
1527− ]
1528−
1529− "if" ->
1530− D.stack
1531− [ D.reflow $
1532− "It is reserved for writing `if` expressions. Try using a different name?"
1533− , D.toSimpleNote $
1534− "If you are trying to write an `if` expression, it needs to be part of a\
1535− \ definition. So you could write something like this instead:"
1536− , D.indent 4 $ D.vcat $
1537− [ "greet name ="
1538− , D.fillSep $
1539− [" "
1540− ,D.cyan "if","name","==",D.dullyellow "\"Abraham Lincoln\""
1541− ,D.cyan "then",D.dullyellow "\"Greetings Mr. President.\""
1542− ,D.cyan "else",D.dullyellow "\"Hey!\""
1543− ]
1544− ]
1545− , D.reflow $
1546− "This defines a `reviewPowerLevel` function that you can use elsewhere in your program."
1547− ]
1548−
1549− _ ->
1550− D.reflow $
1551− "It is a reserved word. Try changing the name to something else?"
1552− )
1553−
1554− Code.Upper c cs ->
1555− let
1556− region = toRegion row col
1557− in
1558− Report.Report "UNEXPECTED CAPITAL LETTER" region [] $
1559− Code.toSnippet source region Nothing
1560− (
1561− D.reflow $
1562− "Declarations always start with a lower-case letter, so I am getting stuck here:"
1563− ,
1564− D.stack
1565− [ D.fillSep $
1566− ["Try","a","name","like"
1567− ,D.green (D.fromChars (Char.toLower c : cs))
1568− ,"instead?"
1569− ]
1570− , D.toSimpleNote $
1571− "Here are a couple valid declarations for reference:"
1572− , D.indent 4 $ D.vcat $
1573− [ "greet : String -> String"
1574− , "greet name ="
1575− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
1576− , ""
1577− , D.cyan "type" <> " User = Anonymous | LoggedIn String"
1578− ]
1579− , D.reflow $
1580− "Notice that they always start with a lower-case letter. Capitalization matters!"
1581− ]
1582− )
1583−
1584− Code.Other (Just char) | elem char ['(', '{', '[', '+', '-', '*', '/', '^', '&', '|', '"', '\'', '!', '@', '#', '$', '%'] ->
1585− let
1586− region = toRegion row col
1587− in
1588− Report.Report "UNEXPECTED SYMBOL" region [] $
1589− Code.toSnippet source region Nothing
1590− (
1591− D.reflow $
1592− "I am getting stuck because this line starts with the " ++ [char] ++ " symbol:"
1593− ,
1594− D.stack
1595− [ D.reflow $
1596− "When a line has no spaces at the beginning, I expect it to be a declaration like one of these:"
1597− , D.indent 4 $ D.vcat $
1598− [ "greet : String -> String"
1599− , "greet name ="
1600− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
1601− , ""
1602− , D.cyan "type" <> " User = Anonymous | LoggedIn String"
1603− ]
1604− , D.reflow $
1605− "If this is not supposed to be a declaration, try adding some spaces before it?"
1606− ]
1607− )
1608−
1609− _ ->
1610− let
1611− region = toRegion row col
1612− in
1613− Report.Report "WEIRD DECLARATION" region [] $
1614− Code.toSnippet source region Nothing
1615− (
1616− D.reflow $
1617− "I am trying to parse a declaration, but I am getting stuck here:"
1618− ,
1619− D.stack
1620− [ D.reflow $
1621− "When a line has no spaces at the beginning, I expect it to be a declaration like one of these:"
1622− , D.indent 4 $ D.vcat $
1623− [ "greet : String -> String"
1624− , "greet name ="
1625− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
1626− , ""
1627− , D.cyan "type" <> " User = Anonymous | LoggedIn String"
1628− ]
1629− , D.reflow $
1630− "Try to make your declaration look like one of those? Or if this is not\
1631− \ supposed to be a declaration, try adding some spaces before it?"
1632− ]
1633− )
1634−
1635
1456
1636-- PORT
1457-- PORT
1637
1458
@@ -1758,7 +1579,7 @@ toPortReport source port_ startRow startCol =
1758 [ D.reflow $
1579 [ D.reflow $
1759 "I was expecting to see a type next. Here are examples of outgoing and\
1580 "I was expecting to see a type next. Here are examples of outgoing and\
1760 \ incoming ports for reference:"
1581 \ incoming ports for reference:"
1761− , D.indent 4 $ D.vcat $
1582+ , D.vcat
1762 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1583 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1763 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1584 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1764 ]
1585 ]
@@ -1777,7 +1598,7 @@ portNote =
1777 D.stack
1598 D.stack
1778 [ D.toSimpleNote $
1599 [ D.toSimpleNote $
1779 "Here are some example `port` declarations for reference:"
1600 "Here are some example `port` declarations for reference:"
1780− , D.indent 4 $ D.vcat $
1601+ , D.vcat
1781 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1602 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1782 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1603 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1783 ]
1604 ]
@@ -1960,8 +1781,8 @@ typeAliasNote =
1960 [ D.toSimpleNote $
1781 [ D.toSimpleNote $
1961 "Here is an example of a valid `type alias` for reference:"
1782 "Here is an example of a valid `type alias` for reference:"
1962 , D.vcat $
1783 , D.vcat $
1963− [ D.indent 4 $ D.fillSep [D.cyan "type",D.cyan "alias","Person","="]
1784+ [ D.indent 0 $ D.fillSep [D.cyan "type",D.cyan "alias",D.green "Person","="]
1964− , D.indent 6 $ D.vcat $
1785+ , D.indent 2 $ D.vcat $
1965 ["{ name : String"
1786 ["{ name : String"
1966 ,", age : Int"
1787 ,", age : Int"
1967 ,", height : Float"
1788 ,", height : Float"
@@ -2161,10 +1982,10 @@ customTypeNote =
2161 [ D.toSimpleNote $
1982 [ D.toSimpleNote $
2162 "Here is an example of a valid `type` declaration for reference:"
1983 "Here is an example of a valid `type` declaration for reference:"
2163 , D.vcat $
1984 , D.vcat $
2164− [ D.indent 4 $ D.fillSep [D.cyan "type","Status"]
1985+ [ D.indent 0 $ D.fillSep [D.cyan "type",D.green "Status"]
2165− , D.indent 6 $ D.fillSep ["=","Failure"]
1986+ , D.indent 2 $ D.fillSep ["=","Failure"]
2166− , D.indent 6 $ D.fillSep ["|","Waiting"]
1987+ , D.indent 2 $ D.fillSep ["|","Waiting"]
2167− , D.indent 6 $ D.fillSep ["|","Success","String"]
1988+ , D.indent 2 $ D.fillSep ["|","Success","String"]
2168 ]
1989 ]
2169 , D.reflow $
1990 , D.reflow $
2170 "This defines a new `Status` type with three variants. This could be useful if\
1991 "This defines a new `Status` type with three variants. This could be useful if\
@@ -2193,57 +2014,13 @@ toDeclDefReport source name declDef startRow startCol =
2193 region = toKeywordRegion row col keyword
2014 region = toKeywordRegion row col keyword
2194 in
2015 in
2195 Report.Report "RESERVED WORD" region [] $
2016 Report.Report "RESERVED WORD" region [] $
2196− Code.toSnippet source surroundings (Just region)
2197− (
2198− D.fillSep
2199− ["The","name"
2200− ,"`" <> D.cyan (D.fromChars keyword) <> "`"
2201− ,"is","reserved","in","Elm,","so","it","cannot"
2202− ,"be","used","as","an","argument","here:"
2203− ]
2204− ,
2205− D.stack
2206− [ D.reflow $
2207− "Try renaming it to something else."
2208− , case keyword of
2209− "as" ->
2210− D.toFancyNote
2211− ["This","keyword","is","reserved","for","pattern","matches","like"
2212− ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"
2213− ,"the","values","it","contains."
2214− ]
2215−
2216− _ ->
2217− D.toSimpleNote $
2218− "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."
2219− ]
2220− )
2221−
2222− Code.Operator "->" ->
2223− let
2224− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
2225− region = toWiderRegion row col 2
2226− in
2227− Report.Report "MISSING COLON?" region [] $
2228 Code.toSnippet source surroundings (Just region)
2017 Code.toSnippet source surroundings (Just region)
2229 (
2018 (
2230 D.reflow $
2019 D.reflow $
2231− "I was not expecting to see an arrow here:"
2020+ "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
2232 ,
2021 ,
2233− D.stack
2022+ D.reflow $
2234− [ D.fillSep
2023+ "This is a reserved word! Try using some other name?"
2235− ["This","usually","means","a",D.green ":","is","missing","a","bit","earlier","in"
2236− ,"a","type","annotation.","It","could","be","something","else","though,","so"
2237− ,"here","is","a","valid","definition","for","reference:"
2238− ]
2239− , D.indent 4 $ D.vcat $
2240− [ "greet : String -> String"
2241− , "greet name ="
2242− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2243− ]
2244− , D.reflow $
2245− "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
2246− ]
2247 )
2024 )
2248
2025
2249 Code.Operator op ->
2026 Code.Operator op ->
@@ -2261,10 +2038,10 @@ toDeclDefReport source name declDef startRow startCol =
2261 [ D.reflow $
2038 [ D.reflow $
2262 "I am not sure what is going wrong exactly, so here is a valid\
2039 "I am not sure what is going wrong exactly, so here is a valid\
2263 \ definition (with an optional type annotation) for reference:"
2040 \ definition (with an optional type annotation) for reference:"
2264− , D.indent 4 $ D.vcat $
2041+ , D.vcat
2265− [ "greet : String -> String"
2042+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2266− , "greet name ="
2043+ , D.fillSep [D.green "add","x","y","="]
2267− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2044+ , D.fillSep [" ","x","+","y"]
2268 ]
2045 ]
2269 , D.reflow $
2046 , D.reflow $
2270 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
2047 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -2286,10 +2063,10 @@ toDeclDefReport source name declDef startRow startCol =
2286 [ D.reflow $
2063 [ D.reflow $
2287 "I am not sure what is going wrong exactly, so here is a valid\
2064 "I am not sure what is going wrong exactly, so here is a valid\
2288 \ definition (with an optional type annotation) for reference:"
2065 \ definition (with an optional type annotation) for reference:"
2289− , D.indent 4 $ D.vcat $
2066+ , D.vcat
2290− [ "greet : String -> String"
2067+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2291− , "greet name ="
2068+ , D.fillSep [D.green "add","x","y","="]
2292− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2069+ , D.fillSep [" ","x","+","y"]
2293 ]
2070 ]
2294 , D.reflow $
2071 , D.reflow $
2295 "Try to use that format!"
2072 "Try to use that format!"
@@ -2404,10 +2181,10 @@ declDefNote =
2404 D.stack
2181 D.stack
2405 [ D.reflow $
2182 [ D.reflow $
2406 "Here is a valid definition (with a type annotation) for reference:"
2183 "Here is a valid definition (with a type annotation) for reference:"
2407− , D.indent 4 $ D.vcat $
2184+ , D.vcat
2408− [ "greet : String -> String"
2185+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2409− , "greet name ="
2186+ , D.fillSep [D.green "add","x","y","="]
2410− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2187+ , D.fillSep [" ","x","+","y"]
2411 ]
2188 ]
2412 , D.reflow $
2189 , D.reflow $
2413 "The top line (called a \"type annotation\") is optional. You can leave it off\
2190 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -2519,40 +2296,25 @@ toExprReport source context expr startRow startCol =
2519 )
2296 )
2520
2297
2521 OperatorRight op row col ->
2298 OperatorRight op row col ->
2522− let
2523− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
2524− region = toRegion row col
2299+ let region = toRegion row col in
2525− isMath = elem op ["-","+","*","/","^"]
2526− in
2527 Report.Report "MISSING EXPRESSION" region [] $
2300 Report.Report "MISSING EXPRESSION" region [] $
2528− Code.toSnippet source surroundings (Just region)
2301+ Code.toSnippet source region Nothing
2529 (
2302 (
2530 D.reflow $
2303 D.reflow $
2531− "I just saw a " ++ Name.toChars op ++ " "
2304+ "I was expecting to see an expression after this " ++ Name.toChars op ++ " operator:"
2532− ++ (if isMath then "sign" else "operator")
2533− ++ ", so I am getting stuck here:"
2534 ,
2305 ,
2535− if isMath then
2306+ D.stack
2536− D.fillSep
2307+ [ D.fillSep $
2537− ["I","was","expecting","to","see","an","expression","next."
2308+ ["You","can","just","put","anything","for","now,","like"
2538− ,"Something","like",D.dullyellow "42","or",D.dullyellow "1000"
2309+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"" <> "."
2539− ,"that","makes","sense","with","a",D.fromName op,"sign."
2310+ ,"Once","there","is","something","there,","I","can","probably"
2540− ]
2311+ ,"give","a","more","specific","hint!"
2541− else if op == "&&" || op == "||" then
2542− D.fillSep
2543− ["I","was","expecting","to","see","an","expression","next."
2544− ,"Something","like",D.dullyellow "True","or",D.dullyellow "False"
2545− ,"that","makes","sense","with","boolean","logic."
2546− ]
2312+ ]
2547− else if op == "|>" then
2313+ , D.toSimpleNote $
2548− D.reflow $
2314+ "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
2549− "I was expecting to see a function next."
2315+ \ Or if I run into operators in unexpected spots. Point is, there are a\
2550− else if op == "<|" then
2316+ \ couple ways I can get confused and give sort of weird advice!"
2551− D.reflow $
2317+ ]
2552− "I was expecting to see an argument next."
2553− else
2554− D.reflow $
2555− "I was expecting to see an expression next."
2556 )
2318 )
2557
2319
2558 OperatorReserved operator row col ->
2320 OperatorReserved operator row col ->
@@ -2591,7 +2353,7 @@ toExprReport source context expr startRow startCol =
2591 ,"give","a","more","specific","hint!"
2353 ,"give","a","more","specific","hint!"
2592 ]
2354 ]
2593 , D.toSimpleNote $
2355 , D.toSimpleNote $
2594− "This can also happen if I run into reserved words like `let` or `as` unexpectedly.\
2356+ "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
2595 \ Or if I run into operators in unexpected spots. Point is, there are a\
2357 \ Or if I run into operators in unexpected spots. Point is, there are a\
2596 \ couple ways I can get confused and give sort of weird advice!"
2358 \ couple ways I can get confused and give sort of weird advice!"
2597 ]
2359 ]
@@ -2740,15 +2502,17 @@ toStringReport source string row col =
2740 , D.toSimpleNote $
2502 , D.toSimpleNote $
2741 "For a string that spans multiple lines, you can use the multi-line string\
2503 "For a string that spans multiple lines, you can use the multi-line string\
2742 \ syntax like this:"
2504 \ syntax like this:"
2743− , D.dullyellow $ D.indent 4 $ D.vcat $
2505+ , D.vcat
2744− [ "\"\"\""
2506+ [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2507+ , mempty
2745− , "# Multi-line Strings"
2508+ , D.dullyellow "# Multi-line Strings"
2746− , ""
2509+ , mempty
2747− , "- start with triple double quotes"
2510+ , D.dullyellow "- start with triple double quotes"
2748− , "- write whatever you want"
2511+ , D.dullyellow "- write whatever you want"
2749− , "- no need to escape newlines or double quotes"
2512+ , D.dullyellow "- no need to escape newlines or double quotes"
2750− , "- end with triple double quotes"
2513+ , D.dullyellow "- end with triple double quotes"
2514+ , mempty
2751− , "\"\"\""
2515+ , D.dullyellow "\"\"\""
2752 ]
2516 ]
2753 ]
2517 ]
2754 )
2518 )
@@ -2767,15 +2531,17 @@ toStringReport source string row col =
2767 [ D.reflow "Add a \"\"\" somewhere after this to end the string."
2531 [ D.reflow "Add a \"\"\" somewhere after this to end the string."
2768 , D.toSimpleNote $
2532 , D.toSimpleNote $
2769 "Here is a valid multi-line string for reference:"
2533 "Here is a valid multi-line string for reference:"
2770− , D.dullyellow $ D.indent 4 $ D.vcat $
2534+ , D.vcat
2771− [ "\"\"\""
2535+ [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2536+ , mempty
2772− , "# Multi-line Strings"
2537+ , D.dullyellow "# Multi-line Strings"
2773− , ""
2538+ , mempty
2774− , "- start with triple double quotes"
2539+ , D.dullyellow "- start with triple double quotes"
2775− , "- write whatever you want"
2540+ , D.dullyellow "- write whatever you want"
2776− , "- no need to escape newlines or double quotes"
2541+ , D.dullyellow "- no need to escape newlines or double quotes"
2777− , "- end with triple double quotes"
2542+ , D.dullyellow "- end with triple double quotes"
2543+ , mempty
2778− , "\"\"\""
2544+ , D.dullyellow "\"\"\""
2779 ]
2545 ]
2780 ]
2546 ]
2781 )
2547 )
@@ -3027,7 +2793,7 @@ toOperatorReport source context operator row col =
3027 ,
2793 ,
3028 D.stack
2794 D.stack
3029 [ D.reflow $
2795 [ D.reflow $
3030− "It makes sense to see arrows around here, so I suspect it is something earlier. Maybe this pattern is indented a bit farther than the previous patterns?"
2796+ "It makes sense to see arrows around here, so I suspect it is something earlier."
3031 , noteForCaseIndentError
2797 , noteForCaseIndentError
3032 ]
2798 ]
3033 )
2799 )
@@ -3035,15 +2801,11 @@ toOperatorReport source context operator row col =
3035 else
2801 else
3036 (
2802 (
3037 D.reflow $
2803 D.reflow $
3038− "I was partway through parsing an expression when I got stuck on this arrow:"
2804+ "I was not expecting an arrow here:"
3039 ,
2805 ,
3040− D.stack
2806+ D.reflow $
3041− [ "Arrows should only appear in `case` expressions and anonymous functions.\n\
2807+ "Arrows should only appear in `case` expressions and anonymous functions. Maybe\
3042− \Maybe it was supposed to be a > sign instead?"
2808+ \ you want > or >= instead?"
3043− , D.toSimpleNote $
3044− "The syntax for anonymous functions is (\\x -> x + 1) so the arguments all appear\
3045− \ after the backslash and before the arrow. Maybe a backslash is missing earlier?"
3046− ]
3047 )
2809 )
3048
2810
3049 BadEquals ->
2811 BadEquals ->
@@ -3240,8 +3002,8 @@ toUnfinishLetReport source row col startRow startCol message =
3240 [ message
3002 [ message
3241 , D.toSimpleNote $
3003 , D.toSimpleNote $
3242 "Here is an example with a valid `let` expression for reference:"
3004 "Here is an example with a valid `let` expression for reference:"
3243− , D.indent 4 $ D.vcat $
3005+ , D.vcat $
3244− [ D.indent 0 $ D.fillSep ["viewPerson","person","="]
3006+ [ D.indent 0 $ D.fillSep [D.green "viewPerson","person","="]
3245 , D.indent 2 $ D.fillSep [D.cyan "let"]
3007 , D.indent 2 $ D.fillSep [D.cyan "let"]
3246 , D.indent 4 $ D.fillSep ["fullName","="]
3008 , D.indent 4 $ D.fillSep ["fullName","="]
3247 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]
3009 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]
@@ -3313,60 +3075,16 @@ toLetDefReport source name def startRow startCol =
3313 Code.Keyword keyword ->
3075 Code.Keyword keyword ->
3314 let
3076 let
3315 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3077 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3316− region = toKeywordRegion row col keyword
3078+ region = toKeywordRegion row col keyword
3317− in
3318− Report.Report "RESERVED WORD" region [] $
3319− Code.toSnippet source surroundings (Just region)
3320− (
3321− D.fillSep
3322− ["The","name"
3323− ,"`" <> D.cyan (D.fromChars keyword) <> "`"
3324− ,"is","reserved","in","Elm,","so","it","cannot"
3325− ,"be","used","as","an","argument","here:"
3326− ]
3327− ,
3328− D.stack
3329− [ D.reflow $
3330− "Try renaming it to something else."
3331− , case keyword of
3332− "as" ->
3333− D.toFancyNote
3334− ["This","keyword","is","reserved","for","pattern","matches","like"
3335− ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"
3336− ,"the","values","it","contains."
3337− ]
3338−
3339− _ ->
3340− D.toSimpleNote $
3341− "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."
3342− ]
3343− )
3344−
3345− Code.Operator "->" ->
3346− let
3347− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3348− region = toWiderRegion row col 2
3349 in
3079 in
3350− Report.Report "MISSING COLON?" region [] $
3080+ Report.Report "RESERVED WORD" region [] $
3351 Code.toSnippet source surroundings (Just region)
3081 Code.toSnippet source surroundings (Just region)
3352 (
3082 (
3353 D.reflow $
3083 D.reflow $
3354− "I was not expecting to see an arrow here:"
3084+ "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
3355 ,
3085 ,
3356− D.stack
3086+ D.reflow $
3357− [ D.fillSep
3087+ "This is a reserved word! Try using some other name?"
3358− ["This","usually","means","a",D.green ":","is","missing","a","bit","earlier","in"
3359− ,"a","type","annotation.","It","could","be","something","else","though,","so"
3360− ,"here","is","a","valid","definition","for","reference:"
3361− ]
3362− , D.indent 4 $ D.vcat $
3363− [ "greet : String -> String"
3364− , "greet name ="
3365− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3366− ]
3367− , D.reflow $
3368− "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
3369− ]
3370 )
3088 )
3371
3089
3372 Code.Operator op ->
3090 Code.Operator op ->
@@ -3384,10 +3102,10 @@ toLetDefReport source name def startRow startCol =
3384 [ D.reflow $
3102 [ D.reflow $
3385 "I am not sure what is going wrong exactly, so here is a valid\
3103 "I am not sure what is going wrong exactly, so here is a valid\
3386 \ definition (with an optional type annotation) for reference:"
3104 \ definition (with an optional type annotation) for reference:"
3387− , D.indent 4 $ D.vcat $
3105+ , D.vcat
3388− [ "greet : String -> String"
3106+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3389− , "greet name ="
3107+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3390− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3108+ , D.indent 6 $ D.fillSep ["x","+","y"]
3391 ]
3109 ]
3392 , D.reflow $
3110 , D.reflow $
3393 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
3111 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -3409,10 +3127,10 @@ toLetDefReport source name def startRow startCol =
3409 [ D.reflow $
3127 [ D.reflow $
3410 "I am not sure what is going wrong exactly, so here is a valid\
3128 "I am not sure what is going wrong exactly, so here is a valid\
3411 \ definition (with an optional type annotation) for reference:"
3129 \ definition (with an optional type annotation) for reference:"
3412− , D.indent 4 $ D.vcat $
3130+ , D.vcat
3413− [ "greet : String -> String"
3131+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3414− , "greet name ="
3132+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3415− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3133+ , D.indent 4 $ D.fillSep ["x","+","y"]
3416 ]
3134 ]
3417 , D.reflow $
3135 , D.reflow $
3418 "Try to use that format!"
3136 "Try to use that format!"
@@ -3502,10 +3220,10 @@ defNote =
3502 D.stack
3220 D.stack
3503 [ D.reflow $
3221 [ D.reflow $
3504 "Here is a valid definition (with a type annotation) for reference:"
3222 "Here is a valid definition (with a type annotation) for reference:"
3505− , D.indent 4 $ D.vcat $
3223+ , D.vcat
3506− [ "greet : String -> String"
3224+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3507− , "greet name ="
3225+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3508− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3226+ , D.indent 6 $ D.fillSep ["x","+","y"]
3509 ]
3227 ]
3510 , D.reflow $
3228 , D.reflow $
3511 "The top line (called a \"type annotation\") is optional. You can leave it off\
3229 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -3764,9 +3482,8 @@ noteForCaseIndentError =
3764 , D.indent 8 $ D.fillSep [D.dullyellow "400"]
3482 , D.indent 8 $ D.fillSep [D.dullyellow "400"]
3765 ]
3483 ]
3766 , D.reflow $
3484 , D.reflow $
3767− "Notice the indentation! Patterns are aligned with each other. Same indentation.\
3485+ "Notice the indentation! Each pattern is aligned, and each branch is indented\
3768− \ The expressions after each arrow are all indented a bit more than the patterns.\
3769− \ That is important!"
3486+ \ a bit more than the corresponding pattern. That is important!"
3770 ]
3487 ]
3771
3488
3772
3489
@@ -3918,43 +3635,23 @@ toIfReport source context if_ startRow startCol =
3918 )
3635 )
3919
3636
3920 IfIndentElse row col ->
3637 IfIndentElse row col ->
3921− case Code.nextLineStartsWithKeyword "else" source row of
3922− Just (elseRow, elseCol) ->
3923− let
3638+ let
3924− surroundings = A.Region (A.Position startRow startCol) (A.Position elseRow elseCol)
3925− region = toWiderRegion elseRow elseCol 4
3926− in
3927− Report.Report "WEIRD ELSE BRANCH" region [] $
3928− Code.toSnippet source surroundings (Just region)
3929− (
3930− D.reflow $
3931− "I was partway through an `if` expression when I got stuck here:"
3932− ,
3933− D.fillSep $
3934− ["I","think","this",D.cyan "else","keyword","needs","to","be","indented","more."
3935− ,"Try","adding","some","spaces","before","it."
3936− ]
3937− )
3938−
3939− Nothing ->
3940− let
3941− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3639+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3942− region = toRegion row col
3640+ region = toRegion row col
3943− in
3641+ in
3944− Report.Report "UNFINISHED IF" region [] $
3642+ Report.Report "UNFINISHED IF" region [] $
3945− Code.toSnippet source surroundings (Just region)
3643+ Code.toSnippet source surroundings (Just region)
3946− (
3644+ (
3947− D.reflow $
3645+ D.reflow $
3948− "I was expecting to see an `else` branch after this:"
3646+ "I was expecting to see an `else` branch after this:"
3949− ,
3647+ ,
3950− D.stack
3648+ D.stack
3951− [ D.fillSep
3649+ [ D.reflow $
3952− ["I","know","what","to","do","when","the","condition","is","True,"
3650+ "I know what to do when the condition is `True`, but not when it is `False`."
3953− ,"but","what","happens","when","it","is","False?"
3651+ , D.fillSep
3954− ,"Add","an",D.cyan "else","branch","to","handle","that","scenario!"
3652+ ["Add","an",D.cyan "else","branch","to","handle","that","scenario!"]
3955− ]
3956− ]
3653+ ]
3957− )
3654+ )
3958
3655
3959
3656
3960
3657
@@ -3987,22 +3684,15 @@ toRecordReport source context record startRow startCol =
3987 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3684 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3988 region = toRegion row col
3685 region = toRegion row col
3989 in
3686 in
3990− Report.Report "PROBLEM IN RECORD" region [] $
3687+ Report.Report "UNFINISHED RECORD" region [] $
3991 Code.toSnippet source surroundings (Just region)
3688 Code.toSnippet source surroundings (Just region)
3992 (
3689 (
3993 D.reflow $
3690 D.reflow $
3994 "I just started parsing a record, but I got stuck here:"
3691 "I just started parsing a record, but I got stuck here:"
3995 ,
3692 ,
3996− D.stack
3997− [ D.fillSep
3693+ D.fillSep
3694+ ["Records","look","like",D.dullyellow "{ x = 3, y = 4 },"
3998− ["I","was","expecting","to","see","a","record","field","defined","next,"
3695+ ,"so","I","was","expecting","to","see","a","field","name","next."
3999− ,"so","I","am","looking","for","a","name","like"
4000− ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."
4001− ]
4002− , D.toSimpleNote $
4003− "Field names must start with a lower-case letter. After that, you can use\
4004− \ any sequence of letters, numbers, and underscores."
4005− , noteForRecordError
4006 ]
3696 ]
4007 )
3697 )
4008
3698
@@ -4011,7 +3701,7 @@ toRecordReport source context record startRow startCol =
4011 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3701 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4012 region = toRegion row col
3702 region = toRegion row col
4013 in
3703 in
4014− Report.Report "PROBLEM IN RECORD" region [] $
3704+ Report.Report "UNFINISHED RECORD" region [] $
4015 Code.toSnippet source surroundings (Just region)
3705 Code.toSnippet source surroundings (Just region)
4016 (
3706 (
4017 D.reflow $
3707 D.reflow $
@@ -4046,67 +3736,22 @@ toRecordReport source context record startRow startCol =
4046 \ that is a reserved word. Try using a different name!"
3736 \ that is a reserved word. Try using a different name!"
4047 )
3737 )
4048
3738
4049− Code.Other (Just ',') ->
4050− let
4051− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4052− region = toRegion row col
4053− in
4054− Report.Report "EXTRA COMMA" region [] $
4055− Code.toSnippet source surroundings (Just region)
4056− (
4057− D.reflow $
4058− "I am partway through parsing a record, but I got stuck here:"
4059− ,
4060− D.stack
4061− [ D.reflow $
4062− "I am seeing two commas in a row. This is the second one!"
4063− , D.reflow $
4064− "Just delete one of the commas and you should be all set!"
4065− , noteForRecordError
4066− ]
4067− )
4068−
4069− Code.Close _ '}' ->
4070− let
4071− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4072− region = toRegion row col
4073− in
4074− Report.Report "EXTRA COMMA" region [] $
4075− Code.toSnippet source surroundings (Just region)
4076− (
4077− D.reflow $
4078− "I am partway through parsing a record, but I got stuck here:"
4079− ,
4080− D.stack
4081− [ D.reflow $
4082− "Trailing commas are not allowed in records. Try deleting the comma that appears\
4083− \ before this closing curly brace."
4084− , noteForRecordError
4085− ]
4086− )
4087−
4088 _ ->
3739 _ ->
4089 let
3740 let
4090 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3741 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4091 region = toRegion row col
3742 region = toRegion row col
4092 in
3743 in
4093− Report.Report "PROBLEM IN RECORD" region [] $
3744+ Report.Report "UNFINISHED RECORD" region [] $
4094 Code.toSnippet source surroundings (Just region)
3745 Code.toSnippet source surroundings (Just region)
4095 (
3746 (
4096 D.reflow $
3747 D.reflow $
4097− "I am partway through parsing a record, but I got stuck here:"
3748+ "I am partway through parsing a record, but I got stuck after that last comma:"
4098 ,
3749 ,
4099− D.stack
3750+ addNoteForRecordError $
4100− [ D.fillSep
3751+ D.reflow $
4101− ["I","was","expecting","to","see","another","record","field","defined","next,"
3752+ "Trailing commas are not allowed in records, so I was expecting to see another\
4102− ,"so","I","am","looking","for","a","name","like"
3753+ \ record field defined next. If you are done defining the record, the fix may\
4103− ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."
3754+ \ be to delete that last comma?"
4104− ]
4105− , D.toSimpleNote $
4106− "Field names must start with a lower-case letter. After that, you can use\
4107− \ any sequence of letters, numbers, and underscores."
4108− , noteForRecordError
4109− ]
4110 )
3755 )
4111
3756
4112 RecordEquals row col ->
3757 RecordEquals row col ->
@@ -4114,19 +3759,17 @@ toRecordReport source context record startRow startCol =
4114 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3759 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4115 region = toRegion row col
3760 region = toRegion row col
4116 in
3761 in
4117− Report.Report "PROBLEM IN RECORD" region [] $
3762+ Report.Report "UNFINISHED RECORD" region [] $
4118 Code.toSnippet source surroundings (Just region)
3763 Code.toSnippet source surroundings (Just region)
4119 (
3764 (
4120 D.reflow $
3765 D.reflow $
4121 "I am partway through parsing a record, but I got stuck here:"
3766 "I am partway through parsing a record, but I got stuck here:"
4122 ,
3767 ,
4123− D.stack
3768+ addNoteForRecordError $
4124− [ D.fillSep $
3769+ D.fillSep $
4125− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
3770+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
4126− ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"
3771+ ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"
4127− ]
4128− , noteForRecordError
4129− ]
3772+ ]
4130 )
3773 )
4131
3774
4132 RecordExpr expr row col ->
3775 RecordExpr expr row col ->
@@ -4146,54 +3789,29 @@ toRecordReport source context record startRow startCol =
4146 D.reflow $
3789 D.reflow $
4147 "I just saw the opening curly brace of a record, but then I got stuck here:"
3790 "I just saw the opening curly brace of a record, but then I got stuck here:"
4148 ,
3791 ,
4149− D.stack
3792+ addNoteForRecordIndentError $
4150− [ D.fillSep $
3793+ D.fillSep $
4151− ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."
3794+ ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."
4152− ,"Try","defining","some","fields","of","your","own?"
3795+ ,"Try","defining","some","fields","of","your","own?"
4153− ]
4154− , noteForRecordIndentError
4155− ]
3796+ ]
4156 )
3797 )
4157
3798
4158 RecordIndentEnd row col ->
3799 RecordIndentEnd row col ->
4159− case Code.nextLineStartsWithCloseCurly source row of
4160− Just (curlyRow, curlyCol) ->
4161− let
3800+ let
4162− surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)
4163− region = toRegion curlyRow curlyCol
4164− in
4165− Report.Report "NEED MORE INDENTATION" region [] $
4166− Code.toSnippet source surroundings (Just region)
4167− (
4168− D.reflow $
4169− "I was partway through parsing a record, but I got stuck here:"
4170− ,
4171− D.stack
4172− [ D.reflow $
4173− "I need this curly brace to be indented more. Try adding some spaces before it!"
4174− , noteForRecordError
4175− ]
4176− )
4177−
4178− Nothing ->
4179− let
4180− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3801+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4181− region = toRegion row col
3802+ region = toRegion row col
4182− in
3803+ in
4183− Report.Report "UNFINISHED RECORD" region [] $
3804+ Report.Report "UNFINISHED RECORD" region [] $
4184− Code.toSnippet source surroundings (Just region)
3805+ Code.toSnippet source surroundings (Just region)
4185− (
3806+ (
4186− D.reflow $
3807+ D.reflow $
4187− "I was partway through parsing a record, but I got stuck here:"
4188− ,
4189− D.stack
4190− [ D.fillSep $
4191− ["I","was","expecting","to","see","a","closing","curly","brace","next."
3808+ "I was expecting to see a closing curly brace next:"
3809+ ,
3810+ addNoteForRecordIndentError $
3811+ D.fillSep $
4192− ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"
3812+ ["Try","putting","an",D.green "}","and","see","if","that","helps?"
4193− ]
3813+ ]
4194− , noteForRecordIndentError
4195− ]
4196− )
3814+ )
4197
3815
4198 RecordIndentField row col ->
3816 RecordIndentField row col ->
4199 let
3817 let
@@ -4206,13 +3824,11 @@ toRecordReport source context record startRow startCol =
4206 D.reflow $
3824 D.reflow $
4207 "I am partway through parsing a record, but I got stuck after that last comma:"
3825 "I am partway through parsing a record, but I got stuck after that last comma:"
4208 ,
3826 ,
4209− D.stack
3827+ addNoteForRecordError $
4210− [ D.reflow $
3828+ D.reflow $
4211− "Trailing commas are not allowed in records, so the fix may be to\
3829+ "Trailing commas are not allowed in records, so the fix may be to\
4212− \ delete that last comma? Or maybe you were in the middle of defining\
3830+ \ delete that last comma? Or maybe you were in the middle of defining\
4213− \ an additional field?"
3831+ \ an additional field?"
4214− , noteForRecordError
4215− ]
4216 )
3832 )
4217
3833
4218 RecordIndentEquals row col ->
3834 RecordIndentEquals row col ->
@@ -4227,12 +3843,10 @@ toRecordReport source context record startRow startCol =
4227 "I am partway through parsing a record. I just saw a record\
3843 "I am partway through parsing a record. I just saw a record\
4228 \ field, so I was expecting to see an equals sign next:"
3844 \ field, so I was expecting to see an equals sign next:"
4229 ,
3845 ,
4230− D.stack
3846+ addNoteForRecordIndentError $
4231− [ D.fillSep $
3847+ D.fillSep $
4232− ["Try","putting","an",D.green "=","followed","by","an","expression?"
3848+ ["Try","putting","an",D.green "=","followed","by","an","expression?"
4233− ]
4234− , noteForRecordIndentError
4235− ]
3849+ ]
4236 )
3850 )
4237
3851
4238 RecordIndentExpr row col ->
3852 RecordIndentExpr row col ->
@@ -4246,48 +3860,52 @@ toRecordReport source context record startRow startCol =
4246 D.reflow $
3860 D.reflow $
4247 "I am partway through parsing a record, and I was expecting to run into an expression next:"
3861 "I am partway through parsing a record, and I was expecting to run into an expression next:"
4248 ,
3862 ,
4249− D.stack
3863+ addNoteForRecordIndentError $
4250− [ D.fillSep $
3864+ D.fillSep $
4251− ["Try","putting","something","like"
3865+ ["Try","putting","something","like"
4252− ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"
3866+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"
4253− ]
4254− , noteForRecordIndentError
4255− ]
3867+ ]
4256 )
3868 )
4257
3869
4258
3870
4259−noteForRecordError :: D.Doc
3871+addNoteForRecordError :: D.Doc -> D.Doc
4260−noteForRecordError =
3872+addNoteForRecordError normalRecommendation =
4261 D.stack $
3873 D.stack $
3874+ normalRecommendation
3875+ :
4262 [ D.toSimpleNote
3876 [ D.toSimpleNote
4263 "If you are trying to define a record across multiple lines, I recommend using this format:"
3877 "If you are trying to define a record across multiple lines, I recommend using this format:"
4264 , D.indent 4 $ D.vcat $
3878 , D.indent 4 $ D.vcat $
4265− [ "{ name = " <> D.dullyellow "\"Alice\""
3879+ [ "{ name = \"Alice\""
4266− , ", age = " <> D.dullyellow "42"
3880+ , ", age = 42"
4267− , ", height = " <> D.dullyellow "1.75"
3881+ , ", height = 1.75"
4268 , "}"
3882 , "}"
4269 ]
3883 ]
4270 , D.reflow $
3884 , D.reflow $
4271− "Notice that each line starts with some indentation. Usually two or four spaces.\
3885+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
4272− \ This is the stylistic convention in the Elm ecosystem."
3886+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
3887+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4273 ]
3888 ]
4274
3889
4275
3890
4276−noteForRecordIndentError :: D.Doc
3891+addNoteForRecordIndentError :: D.Doc -> D.Doc
4277−noteForRecordIndentError =
3892+addNoteForRecordIndentError normalRecommendation =
4278− D.stack
3893+ D.stack $
3894+ normalRecommendation
3895+ :
4279 [ D.toSimpleNote
3896 [ D.toSimpleNote
4280 "I may be confused by indentation. For example, if you are trying to define\
3897 "I may be confused by indentation. For example, if you are trying to define\
4281 \ a record across multiple lines, I recommend using this format:"
3898 \ a record across multiple lines, I recommend using this format:"
4282 , D.indent 4 $ D.vcat $
3899 , D.indent 4 $ D.vcat $
4283− [ "{ name = " <> D.dullyellow "\"Alice\""
3900+ [ "{ name = \"Alice\""
4284− , ", age = " <> D.dullyellow "42"
3901+ , ", age = 42"
4285− , ", height = " <> D.dullyellow "1.75"
3902+ , ", height = 1.75"
4286 , "}"
3903 , "}"
4287 ]
3904 ]
4288 , D.reflow $
3905 , D.reflow $
4289− "Notice that each line starts with some indentation. Usually two or four spaces.\
3906+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
4290− \ This is the stylistic convention in the Elm ecosystem!"
3907+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
3908+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4291 ]
3909 ]
4292
3910
4293
3911
@@ -4476,14 +4094,15 @@ toListReport source context list startRow startCol =
4476 , D.toSimpleNote
4094 , D.toSimpleNote
4477 "I recommend using the following format for lists that span multiple lines:"
4095 "I recommend using the following format for lists that span multiple lines:"
4478 , D.indent 4 $ D.vcat $
4096 , D.indent 4 $ D.vcat $
4479− [ "[ " <> D.dullyellow "\"Alice\""
4097+ [ "[ \"Alice\""
4480− , ", " <> D.dullyellow "\"Bob\""
4098+ , ", \"Bob\""
4481− , ", " <> D.dullyellow "\"Chuck\""
4099+ , ", \"Chuck\""
4482 , "]"
4100 , "]"
4483 ]
4101 ]
4484 , D.reflow $
4102 , D.reflow $
4485− "Notice that each line starts with some indentation. Usually two or four spaces.\
4103+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4486− \ This is the stylistic convention in the Elm ecosystem."
4104+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4105+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4487 ]
4106 ]
4488 )
4107 )
4489
4108
@@ -4536,14 +4155,15 @@ toListReport source context list startRow startCol =
4536 "I may be confused by indentation. For example, if you are trying to define\
4155 "I may be confused by indentation. For example, if you are trying to define\
4537 \ a list across multiple lines, I recommend using this format:"
4156 \ a list across multiple lines, I recommend using this format:"
4538 , D.indent 4 $ D.vcat $
4157 , D.indent 4 $ D.vcat $
4539− [ "[ " <> D.dullyellow "\"Alice\""
4158+ [ "[ \"Alice\""
4540− , ", " <> D.dullyellow "\"Bob\""
4159+ , ", \"Bob\""
4541− , ", " <> D.dullyellow "\"Chuck\""
4160+ , ", \"Chuck\""
4542 , "]"
4161 , "]"
4543 ]
4162 ]
4544 , D.reflow $
4163 , D.reflow $
4545− "Notice that each line starts with some indentation. Usually two or four spaces.\
4164+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4546− \ This is the stylistic convention in the Elm ecosystem."
4165+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4166+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4547 ]
4167 ]
4548 )
4168 )
4549
4169
@@ -4567,14 +4187,15 @@ toListReport source context list startRow startCol =
4567 "I may be confused by indentation. For example, if you are trying to define\
4187 "I may be confused by indentation. For example, if you are trying to define\
4568 \ a list across multiple lines, I recommend using this format:"
4188 \ a list across multiple lines, I recommend using this format:"
4569 , D.indent 4 $ D.vcat $
4189 , D.indent 4 $ D.vcat $
4570− [ "[ " <> D.dullyellow "\"Alice\""
4190+ [ "[ \"Alice\""
4571− , ", " <> D.dullyellow "\"Bob\""
4191+ , ", \"Bob\""
4572− , ", " <> D.dullyellow "\"Chuck\""
4192+ , ", \"Chuck\""
4573 , "]"
4193 , "]"
4574 ]
4194 ]
4575 , D.reflow $
4195 , D.reflow $
4576− "Notice that each line starts with some indentation. Usually two or four spaces.\
4196+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4577− \ This is the stylistic convention in the Elm ecosystem."
4197+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4198+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4578 ]
4199 ]
4579 )
4200 )
4580
4201
@@ -4595,14 +4216,15 @@ toListReport source context list startRow startCol =
4595 , D.toSimpleNote
4216 , D.toSimpleNote
4596 "I recommend using the following format for lists that span multiple lines:"
4217 "I recommend using the following format for lists that span multiple lines:"
4597 , D.indent 4 $ D.vcat $
4218 , D.indent 4 $ D.vcat $
4598− [ "[ " <> D.dullyellow "\"Alice\""
4219+ [ "[ \"Alice\""
4599− , ", " <> D.dullyellow "\"Bob\""
4220+ , ", \"Bob\""
4600− , ", " <> D.dullyellow "\"Chuck\""
4221+ , ", \"Chuck\""
4601 , "]"
4222 , "]"
4602 ]
4223 ]
4603 , D.reflow $
4224 , D.reflow $
4604− "Notice that each line starts with some indentation. Usually two or four spaces.\
4225+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4605− \ This is the stylistic convention in the Elm ecosystem."
4226+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4227+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4606 ]
4228 ]
4607 )
4229 )
4608
4230
@@ -5475,64 +5097,22 @@ toTRecordReport source context record startRow startCol =
5475 \ that is a reserved word. Try using a different name!"
5097 \ that is a reserved word. Try using a different name!"
5476 )
5098 )
5477
5099
5478− Code.Other (Just ',') ->
5479− let
5480− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5481− region = toRegion row col
5482− in
5483− Report.Report "EXTRA COMMA" region [] $
5484− Code.toSnippet source surroundings (Just region)
5485− (
5486− D.reflow $
5487− "I am partway through parsing a record type, but I got stuck here:"
5488− ,
5489− D.stack
5490− [ D.reflow $
5491− "I am seeing two commas in a row. This is the second one!"
5492− , D.reflow $
5493− "Just delete one of the commas and you should be all set!"
5494− , noteForRecordTypeError
5495− ]
5496− )
5497−
5498− Code.Close _ '}' ->
5499− let
5500− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5501− region = toRegion row col
5502− in
5503− Report.Report "EXTRA COMMA" region [] $
5504− Code.toSnippet source surroundings (Just region)
5505− (
5506− D.reflow $
5507− "I am partway through parsing a record type, but I got stuck here:"
5508− ,
5509− D.stack
5510− [ D.reflow $
5511− "Trailing commas are not allowed in record types. Try deleting the comma that\
5512− \ appears before this closing curly brace."
5513− , noteForRecordTypeError
5514− ]
5515− )
5516−
5517 _ ->
5100 _ ->
5518 let
5101 let
5519 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5102 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5520 region = toRegion row col
5103 region = toRegion row col
5521 in
5104 in
5522− Report.Report "PROBLEM IN RECORD TYPE" region [] $
5105+ Report.Report "UNFINISHED RECORD TYPE" region [] $
5523 Code.toSnippet source surroundings (Just region)
5106 Code.toSnippet source surroundings (Just region)
5524 (
5107 (
5525 D.reflow $
5108 D.reflow $
5526− "I am partway through parsing a record type, but I got stuck here:"
5109+ "I am partway through parsing a record type, but I got stuck after that last comma:"
5527 ,
5110 ,
5528− D.stack
5111+ addNoteForRecordTypeError $
5529− [ D.fillSep
5112+ D.reflow $
5530− ["I","was","expecting","to","see","another","record","field","defined","next,"
5113+ "Trailing commas are not allowed in records, so I was expecting to see another\
5531− ,"so","I","am","looking","for","a","name","like"
5114+ \ record field defined next. If you are done defining the record, the fix may\
5532− ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."
5115+ \ be to delete that last comma?"
5533− ]
5534− , noteForRecordTypeError
5535− ]
5536 )
5116 )
5537
5117
5538 TRecordColon row col ->
5118 TRecordColon row col ->
@@ -5546,13 +5126,11 @@ toTRecordReport source context record startRow startCol =
5546 D.reflow $
5126 D.reflow $
5547 "I am partway through parsing a record type, but I got stuck here:"
5127 "I am partway through parsing a record type, but I got stuck here:"
5548 ,
5128 ,
5549− D.stack
5129+ addNoteForRecordTypeError $
5550− [ D.fillSep $
5130+ D.fillSep $
5551− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
5131+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
5552− ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"
5132+ ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"
5553− ]
5554− , noteForRecordTypeError
5555− ]
5133+ ]
5556 )
5134 )
5557
5135
5558 TRecordType tipe row col ->
5136 TRecordType tipe row col ->
@@ -5572,54 +5150,29 @@ toTRecordReport source context record startRow startCol =
5572 D.reflow $
5150 D.reflow $
5573 "I just saw the opening curly brace of a record type, but then I got stuck here:"
5151 "I just saw the opening curly brace of a record type, but then I got stuck here:"
5574 ,
5152 ,
5575− D.stack
5153+ addNoteForRecordTypeIndentError $
5576− [ D.fillSep $
5154+ D.fillSep $
5577− ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."
5155+ ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."
5578− ,"Try","defining","some","fields","of","your","own?"
5156+ ,"Try","defining","some","fields","of","your","own?"
5579− ]
5580− , noteForRecordTypeIndentError
5581− ]
5157+ ]
5582 )
5158 )
5583
5159
5584 TRecordIndentEnd row col ->
5160 TRecordIndentEnd row col ->
5585− case Code.nextLineStartsWithCloseCurly source row of
5586− Just (curlyRow, curlyCol) ->
5587− let
5161+ let
5588− surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)
5589− region = toRegion curlyRow curlyCol
5590− in
5591− Report.Report "NEED MORE INDENTATION" region [] $
5592− Code.toSnippet source surroundings (Just region)
5593− (
5594− D.reflow $
5595− "I was partway through parsing a record type, but I got stuck here:"
5596− ,
5597− D.stack
5598− [ D.reflow $
5599− "I need this curly brace to be indented more. Try adding some spaces before it!"
5600− , noteForRecordTypeError
5601− ]
5602− )
5603−
5604− Nothing ->
5605− let
5606− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5162+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5607− region = toRegion row col
5163+ region = toRegion row col
5608− in
5164+ in
5609− Report.Report "UNFINISHED RECORD TYPE" region [] $
5165+ Report.Report "UNFINISHED RECORD TYPE" region [] $
5610− Code.toSnippet source surroundings (Just region)
5166+ Code.toSnippet source surroundings (Just region)
5611− (
5167+ (
5612− D.reflow $
5168+ D.reflow $
5613− "I was partway through parsing a record type, but I got stuck here:"
5614− ,
5615− D.stack
5616− [ D.fillSep $
5617− ["I","was","expecting","to","see","a","closing","curly","brace","next."
5169+ "I was expecting to see a closing curly brace next:"
5170+ ,
5171+ addNoteForRecordTypeIndentError $
5172+ D.fillSep $
5618− ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"
5173+ ["Try","putting","an",D.green "}","and","see","if","that","helps?"
5619− ]
5174+ ]
5620− , noteForRecordTypeIndentError
5621− ]
5622− )
5175+ )
5623
5176
5624 TRecordIndentField row col ->
5177 TRecordIndentField row col ->
5625 let
5178 let
@@ -5632,13 +5185,11 @@ toTRecordReport source context record startRow startCol =
5632 D.reflow $
5185 D.reflow $
5633 "I am partway through parsing a record type, but I got stuck after that last comma:"
5186 "I am partway through parsing a record type, but I got stuck after that last comma:"
5634 ,
5187 ,
5635− D.stack
5188+ addNoteForRecordTypeIndentError $
5636− [ D.reflow $
5189+ D.reflow $
5637− "Trailing commas are not allowed in record types, so the fix may be to\
5190+ "Trailing commas are not allowed in record types, so the fix may be to\
5638− \ delete that last comma? Or maybe you were in the middle of defining\
5191+ \ delete that last comma? Or maybe you were in the middle of defining\
5639− \ an additional field?"
5192+ \ an additional field?"
5640− , noteForRecordTypeIndentError
5641− ]
5642 )
5193 )
5643
5194
5644 TRecordIndentColon row col ->
5195 TRecordIndentColon row col ->
@@ -5653,12 +5204,10 @@ toTRecordReport source context record startRow startCol =
5653 "I am partway through parsing a record type. I just saw a record\
5204 "I am partway through parsing a record type. I just saw a record\
5654 \ field, so I was expecting to see a colon next:"
5205 \ field, so I was expecting to see a colon next:"
5655 ,
5206 ,
5656− D.stack
5207+ addNoteForRecordTypeIndentError $
5657− [ D.fillSep $
5208+ D.fillSep $
5658− ["Try","putting","an",D.green ":","followed","by","a","type?"
5209+ ["Try","putting","an",D.green ":","followed","by","a","type?"
5659− ]
5660− , noteForRecordTypeIndentError
5661− ]
5210+ ]
5662 )
5211 )
5663
5212
5664 TRecordIndentType row col ->
5213 TRecordIndentType row col ->
@@ -5672,19 +5221,19 @@ toTRecordReport source context record startRow startCol =
5672 D.reflow $
5221 D.reflow $
5673 "I am partway through parsing a record type, and I was expecting to run into a type next:"
5222 "I am partway through parsing a record type, and I was expecting to run into a type next:"
5674 ,
5223 ,
5675− D.stack
5224+ addNoteForRecordTypeIndentError $
5676− [ D.fillSep $
5225+ D.fillSep $
5677− ["Try","putting","something","like"
5226+ ["Try","putting","something","like"
5678− ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"
5227+ ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"
5679− ]
5680− , noteForRecordTypeIndentError
5681− ]
5228+ ]
5682 )
5229 )
5683
5230
5684
5231
5685−noteForRecordTypeError :: D.Doc
5232+addNoteForRecordTypeError :: D.Doc -> D.Doc
5686−noteForRecordTypeError =
5233+addNoteForRecordTypeError normalRecommendation =
5687 D.stack $
5234 D.stack $
5235+ normalRecommendation
5236+ :
5688 [ D.toSimpleNote
5237 [ D.toSimpleNote
5689 "If you are trying to define a record type across multiple lines, I recommend using this format:"
5238 "If you are trying to define a record type across multiple lines, I recommend using this format:"
5690 , D.indent 4 $ D.vcat $
5239 , D.indent 4 $ D.vcat $
@@ -5694,14 +5243,17 @@ noteForRecordTypeError =
5694 , "}"
5243 , "}"
5695 ]
5244 ]
5696 , D.reflow $
5245 , D.reflow $
5697− "Notice that each line starts with some indentation. Usually two or four spaces.\
5246+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
5698− \ This is the stylistic convention in the Elm ecosystem."
5247+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
5248+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
5699 ]
5249 ]
5700
5250
5701
5251
5702−noteForRecordTypeIndentError :: D.Doc
5252+addNoteForRecordTypeIndentError :: D.Doc -> D.Doc
5703−noteForRecordTypeIndentError =
5253+addNoteForRecordTypeIndentError normalRecommendation =
5704 D.stack $
5254 D.stack $
5255+ normalRecommendation
5256+ :
5705 [ D.toSimpleNote
5257 [ D.toSimpleNote
5706 "I may be confused by indentation. For example, if you are trying to define\
5258 "I may be confused by indentation. For example, if you are trying to define\
5707 \ a record type across multiple lines, I recommend using this format:"
5259 \ a record type across multiple lines, I recommend using this format:"
@@ -5712,8 +5264,9 @@ noteForRecordTypeIndentError =
5712 , "}"
5264 , "}"
5713 ]
5265 ]
5714 , D.reflow $
5266 , D.reflow $
5715− "Notice that each line starts with some indentation. Usually two or four spaces.\
5267+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
5716− \ This is the stylistic convention in the Elm ecosystem."
5268+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
5269+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
5717 ]
5270 ]
5718
5271
5719
5272
compiler/src/Reporting/Error/Type.hs+7−23
@@ -431,6 +431,10 @@ problemToHint problem =
431 ]
431 ]
432 ]
432 ]
433
433
434+ T.AnythingToList ->
435+ [ D.toSimpleHint "Did you forget to add [] around it?"
436+ ]
437+
434 T.ArityMismatch x y ->
438 T.ArityMismatch x y ->
435 [ D.toSimpleHint $
439 [ D.toSimpleHint $
436 if x < y then
440 if x < y then
@@ -559,31 +563,11 @@ badFlexSuper :: T.Direction -> T.Super -> T.Type -> [D.Doc]
559badFlexSuper direction super tipe =
563badFlexSuper direction super tipe =
560 case super of
564 case super of
561 T.Comparable ->
565 T.Comparable ->
562− case tipe of
563− T.Record _ _ ->
564− [ D.link "Hint"
565− "I do not know how to compare records. I can only compare ints, floats,\
566− \ chars, strings, lists of comparable values, and tuples of comparable values.\
567− \ Check out" "comparing-records" "for ideas on how to proceed."
568− ]
569−
570− T.Type _ name _ ->
571− [ D.toSimpleHint $
572− "I do not know how to compare `" ++ Name.toChars name ++ "` values. I can only\
573− \ compare ints, floats, chars, strings, lists of comparable values, and tuples\
566+ [ D.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable."
574− \ of comparable values."
575− , D.reflowLink
576− "Check out" "comparing-custom-types" "for ideas on how to proceed."
577− ]
578−
579− _ ->
580− [ D.toSimpleHint $
581− "I only know how to compare ints, floats, chars, strings, lists of\
582− \ comparable values, and tuples of comparable values."
583− ]
567+ ]
584
568
585 T.Appendable ->
569 T.Appendable ->
586− [ D.toSimpleHint "I only know how to append strings and lists."
570+ [ D.toSimpleHint "Only strings and lists are appendable."
587 ]
571 ]
588
572
589 T.CompAppend ->
573 T.CompAppend ->
compiler/src/Reporting/Render/Code.hs+24−65
@@ -7,8 +7,6 @@ module Reporting.Render.Code
7 , toPair
7 , toPair
8 , Next(..)
8 , Next(..)
9 , whatIsNext
9 , whatIsNext
10− , nextLineStartsWithKeyword
11− , nextLineStartsWithCloseCurly
12 )
10 )
13 where
11 where
14
12
@@ -122,7 +120,7 @@ makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end
122 spaces = replicate (fromIntegral c1 + width + 1) ' '
120 spaces = replicate (fromIntegral c1 + width + 1) ' '
123 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
121 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
124 in
122 in
125− Just (D.fromChars spaces <> D.red (D.fromChars zigzag))
123+ Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
126
124
127
125
128drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
126drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
@@ -148,7 +146,7 @@ addLineNumber addZigZag width start end n line =
148
146
149 spacer =
147 spacer =
150 if addZigZag && start <= n && n <= end then
148 if addZigZag && start <= n && n <= end then
151− D.red ">"
149+ D.dullred ">"
152 else
150 else
153 " "
151 " "
154 in
152 in
@@ -183,8 +181,8 @@ renderPair source@(Source sourceLines) region1 region2 =
183 OneLine $
181 OneLine $
184 D.vcat
182 D.vcat
185 [ D.fromChars lineNumber <> "| " <> D.fromChars line
183 [ D.fromChars lineNumber <> "| " <> D.fromChars line
186− , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>
184+ , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
187− D.fromChars spaces2 <> D.red (D.fromChars zigzag2)
185+ D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
188 ]
186 ]
189
187
190 else
188 else
@@ -201,8 +199,6 @@ data Next
201 = Keyword [Char]
199 = Keyword [Char]
202 | Operator [Char]
200 | Operator [Char]
203 | Close [Char] Char
201 | Close [Char] Char
204− | Upper Char [Char]
205− | Lower Char [Char]
206 | Other (Maybe Char)
202 | Other (Maybe Char)
207
203
208
204
@@ -213,34 +209,25 @@ whatIsNext (Source sourceLines) row col =
213 Other Nothing
209 Other Nothing
214
210
215 Just line ->
211 Just line ->
212+ let
216− case drop (fromIntegral col - 1) line of
213+ chars = drop (fromIntegral col - 1) line
217− [] ->
214+ keywords = map Name.toChars (Set.toList reservedWords)
218− Other Nothing
215+ in
219−
216+ case List.find (startsWithKeyword chars) keywords of
220− c:cs
217+ Just keyword ->
221− | Char.isUpper c -> Upper c (takeWhile isInner cs)
218+ Keyword keyword
222− | Char.isLower c -> detectKeywords c cs
219+
220+ Nothing ->
221+ case chars of
222+ [] ->
223+ Other Nothing
224+
225+ c:cs
223− | isSymbol c -> Operator (c : takeWhile isSymbol cs)
226+ | isSymbol c -> Operator (c : takeWhile isSymbol cs)
224− | c == ')' -> Close "parenthesis" ')'
227+ | c == ')' -> Close "parenthesis" ')'
225− | c == ']' -> Close "square bracket" ']'
228+ | c == ']' -> Close "square bracket" ']'
226− | c == '}' -> Close "curly brace" '}'
229+ | c == '}' -> Close "curly brace" '}'
227− | otherwise -> Other (Just c)
230+ | otherwise -> Other (Just c)
228−
229−
230−detectKeywords :: Char -> [Char] -> Next
231−detectKeywords c rest =
232− let
233− cs = takeWhile isInner rest
234− name = c : cs
235− in
236− if Set.member (Name.fromChars name) reservedWords
237− then Keyword name
238− else Lower c name
239−
240−
241−isInner :: Char -> Bool
242−isInner char =
243− Char.isAlphaNum char || char == '_'
244
231
245
232
246isSymbol :: Char -> Bool
233isSymbol :: Char -> Bool
@@ -257,32 +244,4 @@ startsWithKeyword restOfLine keyword =
257 True
244 True
258
245
259 c:_ ->
246 c:_ ->
260− not (isInner c)
247+ not (Char.isAlphaNum c || c == '_')
261−
262−
263−nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)
264−nextLineStartsWithKeyword keyword (Source sourceLines) row =
265− case List.lookup (row + 1) sourceLines of
266− Nothing ->
267− Nothing
268−
269− Just line ->
270− if startsWithKeyword (dropWhile (==' ') line) keyword then
271− Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
272− else
273− Nothing
274−
275−
276−nextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col)
277−nextLineStartsWithCloseCurly (Source sourceLines) row =
278− case List.lookup (row + 1) sourceLines of
279− Nothing ->
280− Nothing
281−
282− Just line ->
283− case dropWhile (==' ') line of
284− '}':_ ->
285− Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
286−
287− _ ->
288− Nothing
compiler/src/Reporting/Render/Type/Localizer.hs+5−5
@@ -112,9 +112,9 @@ toExposing exposing =
112 Only (foldr addType Set.empty exposedList)
112 Only (foldr addType Set.empty exposedList)
113
113
114
114
115−addType :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
115+addType :: A.Located Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
116−addType exposed types =
116+addType (A.At _ exposed) types =
117 case exposed of
117 case exposed of
118− Src.Lower _ -> types
118+ Src.Lower _ -> types
119− Src.Upper (A.At _ name) _ -> Set.insert name types
119+ Src.Upper name _ -> Set.insert name types
120− Src.Operator _ _ -> types
120+ Src.Operator _ -> types
compiler/src/Type/Error.hs+2−8
@@ -175,6 +175,7 @@ data Problem
175 | StringToFloat
175 | StringToFloat
176 | AnythingToBool
176 | AnythingToBool
177 | AnythingFromMaybe
177 | AnythingFromMaybe
178+ | AnythingToList
178 | ArityMismatch Int Int
179 | ArityMismatch Int Int
179 | BadFlexSuper Direction Super Name.Name Type
180 | BadFlexSuper Direction Super Name.Name Type
180 | BadRigidVar Name.Name Type
181 | BadRigidVar Name.Name Type
@@ -300,7 +301,7 @@ toDiff localizer ctx tipe1 tipe2 =
300 different
301 different
301 (toDoc localizer ctx t1)
302 (toDoc localizer ctx t1)
302 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])
303 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])
303− Bag.empty
304+ (Bag.one AnythingToList)
304
305
305 (Alias home1 name1 args1 t1, t2) ->
306 (Alias home1 name1 args1 t1, t2) ->
306 case diffAliasedRecord localizer t1 t2 of
307 case diffAliasedRecord localizer t1 t2 of
@@ -449,13 +450,6 @@ isSuper super tipe =
449 Appendable -> isString h n || isList h n
450 Appendable -> isString h n || isList h n
450 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)
451 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)
451
452
452− Tuple a b maybeC ->
453− case super of
454− Number -> False
455− Comparable -> isSuper super a && isSuper super b && maybe True (isSuper super) maybeC
456− Appendable -> False
457− CompAppend -> False
458−
459 _ ->
453 _ ->
460 False
454 False
461
455
compiler/src/Type/Unify.hs+8−5
@@ -391,13 +391,13 @@ unifyFlexSuperStructure context super flatType =
391
391
392 Comparable ->
392 Comparable ->
393 do comparableOccursCheck context
393 do comparableOccursCheck context
394− unifyComparableRecursive variable
395 merge context (Structure flatType)
394 merge context (Structure flatType)
395+ unifyComparableRecursive variable
396
396
397 CompAppend ->
397 CompAppend ->
398 do comparableOccursCheck context
398 do comparableOccursCheck context
399− unifyComparableRecursive variable
400 merge context (Structure flatType)
399 merge context (Structure flatType)
400+ unifyComparableRecursive variable
401
401
402 Tuple1 a b maybeC ->
402 Tuple1 a b maybeC ->
403 case super of
403 case super of
@@ -409,12 +409,15 @@ unifyFlexSuperStructure context super flatType =
409
409
410 Comparable ->
410 Comparable ->
411 do comparableOccursCheck context
411 do comparableOccursCheck context
412+ merge context (Structure flatType)
412 unifyComparableRecursive a
413 unifyComparableRecursive a
413 unifyComparableRecursive b
414 unifyComparableRecursive b
414 case maybeC of
415 case maybeC of
415− Nothing -> return ()
416+ Nothing ->
417+ return ()
418+
419+ Just c ->
416− Just c -> unifyComparableRecursive c
420+ unifyComparableRecursive c
417− merge context (Structure flatType)
418
421
419 CompAppend ->
422 CompAppend ->
420 mismatch
423 mismatch
docs/elm.json/application.md+2−2
@@ -8,7 +8,7 @@ This is a decent baseline for pretty much any applications made with Elm. You wi
8 "source-directories": [
8 "source-directories": [
9 "src"
9 "src"
10 ],
10 ],
11− "elm-version": "0.19.1",
11+ "elm-version": "0.19.0",
12 "dependencies": {
12 "dependencies": {
13 "direct": {
13 "direct": {
14 "elm/browser": "1.0.0",
14 "elm/browser": "1.0.0",
@@ -48,7 +48,7 @@ A list of directories where Elm code lives. Most projects just use `"src"` for e
48
48
49## `"elm-version"`
49## `"elm-version"`
50
50
51−The exact version of Elm this builds with. Should be `"0.19.1"` for most people!
51+The exact version of Elm this builds with. Should be `"0.19.0"` for most people!
52
52
53<br>
53<br>
54
54
docs/elm.json/package.md+1−1
@@ -49,7 +49,7 @@ A short summary that will appear on [`package.elm-lang.org`](https://package.elm
49
49
50## `"license"`
50## `"license"`
51
51
52−An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, and BSD-3-Clause is a good default. But you can see the full list of options [here](https://spdx.org/licenses/).
52+An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, but you can see the full list of options [here](https://spdx.org/licenses/).
53
53
54<br>
54<br>
55
55
docs/upgrade-instructions/0.19.1.mddeleted−60
@@ -1,60 +0,0 @@
1−# Upgrading to 0.19.1
2−
3−**There are no language changes**, so once you swap to `"elm-version": "0.19.1"` in your `elm.json`, most users should be able to proceed without any further code changes. **You may run into a handful of bugfixes though!** These cases are outlined below!
4−
5−
6−<br>
7−
8−## Improvements
9−
10−- Parse error message quality (like [this](https://github.com/elm/error-message-catalog/issues/255) and [this](https://github.com/elm/error-message-catalog/issues/225))
11−- Faster compilation, especially for incremental compiles
12−- Uses filelocks so that cached files are not corrupted when plugins run `elm make` multiple times on the same project at the same time. (Still worth avoiding that though!)
13−- More intuitive multiline declarations in REPL
14−- Various bug fixes (e.g. `--debug`, `x /= 0`, `type Height = Height Float` in `--optimize`)
15−
16−
17−<br>
18−
19−## Detectable Bug Fixes
20−
21−There are three known cases where code that compiled with 0.19.0 will not compile with 0.19.1 due to bug fixes:
22−
23−
24−### 1. Ambiguous Imports
25−
26−Say you have an import like this:
27−
28−```elm
29−import Html exposing (min)
30−import Regex exposing (never)
31−
32−x = min
33−y = never
34−```
35−
36−These should be reported as ambiguous usages since the names are also exposed by `Basics`, but there was a regression in 0.19.0 described [here](https://github.com/elm/compiler/issues/1945) such that they weren't caught in specific circumstances.
37−
38−The fix is to use a qualified name like `Html.min` or `Regex.never` to make it unambiguous.
39−
40−We found a couple instances of this in packages and have submitted PRs to the relevant authors in August 2019. You may run into this in your own code as well.
41−
42−For more details on why this is considered a regression, check out the details [here](https://github.com/elm/compiler/issues/1945#issuecomment-507871919) or try it in 0.18.0 to see how it worked before.
43−
44−
45−### 2. Tabs in Comments
46−
47−The 0.19.0 binaries did not catch tab characters in comments. The new parser is better at checking for tabs, so it will object when it finds these.
48−
49−Again, we found this in some packages and reached out to the relevant authors with PRs so patches would be published before the 0.19.1 release.
50−
51−
52−### 3. Port Module with no Ports
53−
54−If you have any files that start with:
55−
56−```elm
57−port module Main exposing (..)
58−```
59−
60−But they do not actually have any `port` declarations, the 0.19.1 binary will ask you to switch to a normal module declaration like `module Main exposing (..)`
elm.cabal+5−6
@@ -45,7 +45,6 @@ Executable elm
45 Hs-Source-Dirs:
45 Hs-Source-Dirs:
46 compiler/src
46 compiler/src
47 builder/src
47 builder/src
48− terminal/impl
49 terminal/src
48 terminal/src
50
49
51 other-extensions:
50 other-extensions:
@@ -65,11 +64,11 @@ Executable elm
65 Repl
64 Repl
66
65
67 -- terminal args
66 -- terminal args
68− Terminal
67+ Terminal.Args
69− Terminal.Chomp
68+ Terminal.Args.Chomp
70− Terminal.Error
69+ Terminal.Args.Error
71− Terminal.Helpers
70+ Terminal.Args.Helpers
72− Terminal.Internal
71+ Terminal.Args.Internal
73
72
74 -- from terminal/
73 -- from terminal/
75 Develop.Generate.Help
74 Develop.Generate.Help
hints/bad-recursion.md+29−26
@@ -5,12 +5,12 @@ There are two problems that will lead you here, both of them pretty tricky:
5
5
6 1. [**No Mutation**](#no-mutation) &mdash; Defining values in Elm is slightly different than defining values in languages like JavaScript.
6 1. [**No Mutation**](#no-mutation) &mdash; Defining values in Elm is slightly different than defining values in languages like JavaScript.
7
7
8− 2. [**Tricky Recursion**](#tricky-recursion) &mdash; Sometimes you need to define recursive values when creating generators, decoders, and parsers. A common case is a JSON decoder a discussion forums where a comment may have replies, which may have replies, which may have replies, etc.
8+ 2. [**Tricky Recursion**](#tricky-recursion) &mdash; Sometimes you need to define recursive values. A common case is JSON decoders for things like discussion forums, where a comment may have replies, which may have replies, etc.
9
9
10
10
11## No Mutation
11## No Mutation
12
12
13−Languages like JavaScript let you “reassign” variables. When you say `x = x + 1` it means: whatever `x` was pointing to, have it point to `x + 1` instead. This is called *mutating* a variable. All values are immutable in Elm, so reassigning variables does not make any sense! Okay, so what *should* `x = x + 1` mean in Elm?
13+Languages like JavaScript let you “reassign” variables. When you say `x = x + 1` it means: whatever `x` was pointing to, have it point to `x + 1` instead. This called *mutating* a variable. All values are immutable in Elm, so reassigning variables does not make any sense! Okay, so what *should* `x = x + 1` mean in Elm?
14
14
15Well, what does it mean with functions? In Elm, we write recursive functions like this:
15Well, what does it mean with functions? In Elm, we write recursive functions like this:
16
16
@@ -51,11 +51,10 @@ type alias Comment =
51 , responses : Responses
51 , responses : Responses
52 }
52 }
53
53
54−type Responses =
55− Responses (List Comment)
54+type Responses = Responses (List Comment)
56```
55```
57
56
58−You may have run into this definition in the [hints for recursive aliases](recursive-alias.md)! Anyway, once you have comments, you may want to turn them into JSON to send back to your server or to store in your database or whatever. So you will probably write some code like this:
57+You may have run into this definition in the [hints for recursive aliases](recursive-alias)! Anyway, once you have comments, you may want to turn them into JSON to send back to your server or to store in your database or whatever. So you will probably write some code like this:
59
58
60```elm
59```elm
61import Json.Decode as Decode exposing (Decoder)
60import Json.Decode as Decode exposing (Decoder)
@@ -92,42 +91,46 @@ decodeComment =
92-- SOLUTION
91-- SOLUTION
93decodeResponses : Decoder Responses
92decodeResponses : Decoder Responses
94decodeResponses =
93decodeResponses =
95− Decode.map Responses (Decode.list (Decode.lazy (\_ -> decodeComment)))
94+ Decode.map Responses (Decode.list (Decode.lazy (\\_ -> decodeComment)))
96```
95```
97
96
98−Notice that in `decodeResponses`, we hide `decodeComment` behind an anonymous function. Elm cannot evaluate an anonymous function until it is given arguments, so it allows us to delay evaluation until it is needed. If there are no comments, we will not need to expand it!
97+Notice that in `decodeResponses`, we hide `decodeComment` behind an anonymous function. Elm cannot evaluate an anonymous function until it is given arguments. So it allows us to delay evaluation until it is needed. If there are no comments, we will not need to expand it!
99
98
100−This saves us from expanding the value infinitely. Instead we only expand the value if we need to.
101
99
102−> **Note:** The same kind of logic can be applied to tasks, random value generators, and parsers. Use `lazy` or `andThen` to make sure a recursive value is only expanded if needed.
100+### Summary
103
101
102+**Situation:** You want a recursive JSON decoder, random value generator, or task. These are all cases where a *value* represents some sort of computation.
104
103
105−## Understanding “Bad Recursion”
104+**Solution:** put the recursion behind an anonymous function.
106
105
107−The compiler tries to detect bad recursion, but how does it know the difference between good and bad situations? Writing `factorial` is fine, but writing `x = x + 1` is not. One version of `decodeComment` was bad, but the other was fine. What is the rule?
106+You can always do this by defining `lazy` in terms of `andThen`. In the case of random value generators, it would look like this:
108−
109−**Elm will allow recursive definitions as long as there is at least one lambda before you get back to yourself.** So if we write `factorial` without any pretty syntax, it looks like this:
110
107
111```elm
108```elm
112−factorial =
109+import Random exposing (Generator, andThen)
113− \n -> if n <= 0 then 1 else n * factorial (n - 1)
110+import Random.Extra exposing (constant)
111+
112+lazy : (() -> Generator a) -> Generator a
113+lazy delayedGenerator =
114+ constant ()
115+ |> andThen delayedGenerator
114```
116```
115
117
116−There is technically a lambda between the definition and the use, so it is okay! The same is true with the good version of `decodeComment`. There is a lambda between the definition and the use. As long as there is a lambda before you get back to yourself, the compiler will let it through.
118+If you are in some situation where this will not work, I am curious to hear about it. I would recommend asking around in [the Elm slack](http://elmlang.herokuapp.com/) first, and opening an issue here if it seems to be the real deal!
117
119
118−**This rule is nice, but it does not catch everything.** It is pretty easy to write a definition where the recursion is hidden behind a lambda, but it still immediately expands forever:
119
120
120−```elm
121+## Defining “Bad” Recursion
121−x =
122− (\_ -> x) () + 1
123−```
124
122
125−This follows the rules, but it immediately expands until our program runs out of stack space. It leads to a runtime error as soon as you start your program. It is nice to fail fast, but why not have the compiler detect this as well? It turns out this is much harder than it sounds!
123+The compiler will yell at you for *bad* recursion, but how does it know the difference between good and bad situations? Writing `factorial` is fine, but writing `x = x + 1` is not. One version of `decodeComment` was bad, but the other was fine. What is the rule?
126
124
127−This is called [the halting problem](https://en.wikipedia.org/wiki/Halting_problem) in computer science. Computational theorists were asking:
125+**Elm will allow recursive definitions as long as there is at least one lambda before you get back to yourself.** So if we write `factorial` without any pretty syntax, it looks like this:
126+
127+```elm
128+factorial =
129+ \\n -> if n <= 0 then 1 else n * factorial (n - 1)
130+```
128
131
129−> Can we determine if a program will finish running (i.e. halt) or if it will continue to run forever?
132+There is technically a lambda between the definition and the use! The same is true with the good version of `decodeComment`. As long as there is a lambda before you get back to yourself, the compiler will let it through.
130
133
131−It turns out that Alan Turing wrote a proof in 1936 showing that (1) in some cases you just have to check by running the program and (2) this check will take forever for programs that do not halt!
134+This rule is nice, but it does not catch *everything*. Pathological cases like `x = (\\_ -> x) () + 1` can make it through. Why not rule these out as well though?! Well, because it is impossible! And not the normal kind of impossible where your cable bill is messed up and the fifth time you call it turns out it *can* be corrected. This is the &ldquo;we proved it with math, it’s called [the halting problem](https://en.wikipedia.org/wiki/Halting_problem)&rdquo; kind of impossible. Impossible [like this](https://www.youtube.com/watch?v=nlD9JYP8u5E).
132
135
133−**So we cannot solve the halting problem *in general*, but our simple rule about lambdas can detect the majority of bad cases *in practice*.**
136+Anyway, I just thought it was cool that we cannot solve the halting problem *in general*, but a simple rule about lambdas can detect the majority of bad cases *in practice*.
hints/comparing-custom-types.mddeleted−98
@@ -1,98 +0,0 @@
1−# Comparing Custom Types
2−
3−The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare custom types?
4−
5−This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
6−
7−
8−## Wrapped Types
9−
10−It is common to try to get some extra type safety by creating really simple custom types:
11−
12−```elm
13−type Id = Id Int
14−type Age = Age Int
15−
16−type Comment = Comment String
17−type Description = Description String
18−```
19−
20−By wrapping the primitive values like this, the type system can now help you make sure that you never mix up a `Id` and an `Age`. Those are different types! This trick is extra cool because it has no runtime cost in `--optimize` mode. The compiler can just use an `Int` or `String` directly when you use that flag!
21−
22−The problem arises when you want to use a `Id` as a key in a dictionary. This is a totally reasonable thing to do, but the current version of Elm cannot handle this scenario.
23−
24−Instead of creating a `Dict Id Info` type, one thing you can do is create a custom data structure like this:
25−
26−```elm
27−module User exposing (Id, Table, empty, get, add)
28−
29−import Dict exposing (Dict)
30−
31−
32−-- USER
33−
34−type Id = Id Int
35−
36−
37−-- TABLE
38−
39−type Table info =
40− Table Int (Dict Int info)
41−
42−empty : Table info
43−empty =
44− Table 0 Dict.empty
45−
46−get : Id -> Table info -> Maybe info
47−get (Id id) (Table _ dict) =
48− Dict.get id dict
49−
50−add : info -> Table info -> (Table info, Id)
51−add info (Table nextId dict) =
52− ( Table (nextId + 1) (Dict.insert nextId info dict)
53− , Id nextId
54− )
55−```
56−
57−There are a couple nice things about this approach:
58−
59−1. The only way to get a new `User.Id` is to `add` information to a `User.Table`.
60−2. All the operations on a `User.Table` are explicit. Does it make sense to remove users? To merge two tables together? Are there any special details to consider in those cases? This will always be captured explicitly in the interface of the `User` module.
61−3. If you ever want to switch the internal representation from `Dict` to `Array` or something else, it is no problem. All the changes will be within the `User` module.
62−
63−So while this approach is not as convenient as using a `Dict` directly, it has some benefits of its own that can be helpful in some cases.
64−
65−
66−## Enumerations to Ints
67−
68−Say you need to define a `trafficLightToInt` function:
69−
70−```elm
71−type TrafficLight = Green | Yellow | Red
72−
73−trafficLightToInt : TrafficLight -> Int
74−trafficLightToInt trafficLight =
75− ???
76−```
77−
78−We have heard that some people would prefer to use a dictionary for this sort of thing. That way you do not need to write the numbers yourself, they can be generated such that you never have a typo.
79−
80−I would recommend using a `case` expression though:
81−
82−```elm
83−type TrafficLight = Green | Yellow | Red
84−
85−trafficLightToInt : TrafficLight -> Int
86−trafficLightToInt trafficLight =
87− case trafficLight of
88− Green -> 1
89− Yellow -> 2
90− Red -> 3
91−```
92−
93−This is really straight-forward while avoiding questions like “is `Green` less than or greater than `Red`?”
94−
95−
96−## Something else?
97−
98−If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!
hints/comparing-records.mddeleted−85
@@ -1,85 +0,0 @@
1−# Comparing Records
2−
3−The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare records?
4−
5−This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
6−
7−
8−## Sorting Records
9−
10−Say we want a `view` function that can show a list of students sorted by different characteristics.
11−
12−We could create something like this:
13−
14−```elm
15−import Html exposing (..)
16−
17−type alias Student =
18− { name : String
19− , age : Int
20− , gpa : Float
21− }
22−
23−type Order = Name | Age | GPA
24−
25−viewStudents : Order -> List Student -> Html msg
26−viewStudents order students =
27− let
28− orderlyStudents =
29− case order of
30− Name -> List.sortBy .name students
31− Age -> List.sortBy .age students
32− GPA -> List.sortBy .gpa students
33− in
34− ul [] (List.map viewStudent orderlyStudents)
35−
36−viewStudent : Student -> Html msg
37−viewStudent student =
38− li [] [ text student.name ]
39−```
40−
41−If you are worried about the performance of changing the order or updating information about particular students, you can start using the [`Html.Lazy`](https://package.elm-lang.org/packages/elm/html/latest/Html-Lazy) and [`Html.Keyed`](https://package.elm-lang.org/packages/elm/html/latest/Html-Keyed) modules. The updated code would look something like this:
42−
43−```elm
44−import Html exposing (..)
45−import Html.Lazy exposing (lazy)
46−import Html.Keyed as Keyed
47−
48−type Order = Name | Age | GPA
49−
50−type alias Student =
51− { name : String
52− , age : Int
53− , gpa : Float
54− }
55−
56−viewStudents : Order -> List Student -> Html msg
57−viewStudents order students =
58− let
59− orderlyStudents =
60− case order of
61− Name -> List.sortBy .name students
62− Age -> List.sortBy .age students
63− GPA -> List.sortBy .gpa students
64− in
65− Keyed.ul [] (List.map viewKeyedStudent orderlyStudents)
66−
67−viewKeyedStudent : Student -> (String, Html msg)
68−viewKeyedStudent student =
69− ( student.name, lazy viewStudent student )
70−
71−viewStudent : Student -> Html msg
72−viewStudent student =
73− li [] [ text student.name ]
74−```
75−
76−By using `Keyed.ul` we help the renderer move the DOM nodes around based on their key. This makes it much cheaper to reorder a bunch of students. And by using `lazy` we help the renderer skip a bunch of work. If the `Student` is the same as last time, the render can skip over it.
77−
78−> **Note:** Some people are skeptical of having logic like this in `view` functions, but I think the alternative (maintaining sort order in your `Model`) has some serious downsides. Say a colleague is adding a message to `Add` students, but they do not know about the sort order rules needed for presentation. Bug! So in this alternate design, you must diligently test your `update` function to make sure that no message disturbs the sort order. This is bound to lead to bugs over time!
79−>
80−> With all the optimizations possible with `Html.Lazy` and `Html.Keyed`, I would always be inclined to work on optimizing my `view` functions rather than making my `update` functions more complicated and error prone.
81−
82−
83−## Something else?
84−
85−If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!
hints/implicit-casts.md+4−1
@@ -16,6 +16,9 @@ Languages that will add in implicit casts for addition include:
16
16
17These languages generally agree that an `Int` may be implicitly cast to a `Float` when necessary. So everyone is doing it, why not Elm?!
17These languages generally agree that an `Int` may be implicitly cast to a `Float` when necessary. So everyone is doing it, why not Elm?!
18
18
19+> **Note:** Ruby does not follow the trend. They implicitly cast a `Float` to an `Int`, truncating all the decimal points!
20+
21+
19## Type Inference + Implicit Casts
22## Type Inference + Implicit Casts
20
23
21Elm comes from the ML-family of languages. Languages in the ML-family that **never** do implicit casts include:
24Elm comes from the ML-family of languages. Languages in the ML-family that **never** do implicit casts include:
@@ -38,7 +41,7 @@ So for any ML-family language designed before Scala, it is safe to assume that i
38
41
39 2. Based on experience reports from Scala users, it seemed like the convenience was not worth the hidden cost. Yes, you can convert `n` in `(n + 1.5)` and everything is nice, but when you are in larger programs that are sparsely annotated, it can be quite difficult to figure out what is going on.
42 2. Based on experience reports from Scala users, it seemed like the convenience was not worth the hidden cost. Yes, you can convert `n` in `(n + 1.5)` and everything is nice, but when you are in larger programs that are sparsely annotated, it can be quite difficult to figure out what is going on.
40
43
41−This user data may be confounded by the fact that Scala allows quite extensive conversions, not just from `Int` to `Float`, but I think it is worth taking seriously nonetheless. So it is _possible_, but it has tradeoffs.
44+This user data may be confounded by the fact that Scala allows quite extensive conversions, not just from `Int` to `Float`, but I think it is worth taking seriously nonetheless. So it is _possible_, but it is has tradeoffs.
42
45
43
46
44## Conclusion
47## Conclusion
hints/import-cycles.md+1−1
@@ -55,7 +55,7 @@ type alias User =
55 }
55 }
56```
56```
57
57
58−Notice that the `Comment` type alias is defined in terms of the `User` type alias and vice versa. Having recursive type aliases like this does not work! That problem is described in depth [here](recursive-alias.md), but the quick takeaway is that one `type alias` needs to become a `type` to break the recursion. So let’s try again:
58+Notice that the `Comment` type alias is defined in terms of the `User` type alias and vice versa. Having recursive type aliases like this does not work! That problem is described in depth [here](recursive-alias), but the quick takeaway is that one `type alias` needs to become a `type` to break the recursion. So let’s try again:
59
59
60```elm
60```elm
61module BadCombination2 exposing (..)
61module BadCombination2 exposing (..)
hints/optimize.md+2−2
@@ -21,7 +21,7 @@ Putting those together, here is how I would optimize `src/Main.elm` with two ter
21
21
22```bash
22```bash
23elm make src/Main.elm --optimize --output=elm.js
23elm make src/Main.elm --optimize --output=elm.js
24−uglifyjs elm.js --compress "pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe" | uglifyjs --mangle --output elm.min.js
24+uglifyjs elm.js --compress "pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe" | uglifyjs --mangle --output=elm.min.js
25```
25```
26
26
27After this you will have an `elm.js` and a significantly smaller `elm.min.js` file!
27After this you will have an `elm.js` and a significantly smaller `elm.min.js` file!
@@ -46,7 +46,7 @@ min="elm.min.js"
46
46
47elm make --optimize --output=$js $@
47elm make --optimize --output=$js $@
48
48
49−uglifyjs $js --compress "pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe" | uglifyjs --mangle --output $min
49+uglifyjs $js --compress "pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe" | uglifyjs --mangle --output=$min
50
50
51echo "Initial size: $(cat $js | wc -c) bytes ($js)"
51echo "Initial size: $(cat $js | wc -c) bytes ($js)"
52echo "Minified size:$(cat $min | wc -c) bytes ($min)"
52echo "Minified size:$(cat $min | wc -c) bytes ($min)"
hints/recursive-alias.md+2−2
@@ -39,7 +39,7 @@ It is much easier to write down `Person` in a type, and then it will just expand
39
39
40## Recursive type aliases?
40## Recursive type aliases?
41
41
42−Okay, so let's say you have some type that may contain itself. In Elm, a common example of this is a comment that might have subcomments:
42+Okay, so lets say you have some type that may contain itself. In Elm, a common example of this is a comment that might have subcomments:
43
43
44```elm
44```elm
45type alias Comment =
45type alias Comment =
@@ -102,7 +102,7 @@ type Comment =
102 }
102 }
103```
103```
104
104
105−Now let's say you want to register an upvote on a comment:
105+Now lets say you want to register an upvote on a comment:
106
106
107```elm
107```elm
108upvote : Comment -> Comment
108upvote : Comment -> Comment
hints/type-annotations.md+3−1
@@ -8,7 +8,7 @@ This document is going to outline the various things that can go wrong and show
8
8
9## Annotation vs. Definition
9## Annotation vs. Definition
10
10
11−The most common issue is with user-defined type variables that are too general. So let's say you have defined a function like this:
11+The most common issue is with user-defined type variables that are too general. So lets say you have defined a function like this:
12
12
13```elm
13```elm
14addPair : (a, a) -> a
14addPair : (a, a) -> a
@@ -58,3 +58,5 @@ filter isOkay list =
58This case is very unfortunate because all the type annotations are correct, but there is a detail of how type inference works right now that **user-defined type variables are not shared between annotations**. This can lead to probably the worst type error messages we have because the problem here is that `a` in the outer annotation does not equal `a` in the inner annotation.
58This case is very unfortunate because all the type annotations are correct, but there is a detail of how type inference works right now that **user-defined type variables are not shared between annotations**. This can lead to probably the worst type error messages we have because the problem here is that `a` in the outer annotation does not equal `a` in the inner annotation.
59
59
60For now the best route is to leave off the inner annotation. It is unfortunate, and hopefully we will be able to do a nicer thing in future releases.
60For now the best route is to leave off the inner annotation. It is unfortunate, and hopefully we will be able to do a nicer thing in future releases.
61+
62+"""
installers/README.mddeleted−32
@@ -1,32 +0,0 @@
1−# Installing Elm
2−
3−The normal path is to work through [the guide](https://guide.elm-lang.org/) until you need to install, but you can skip to installation directly by going [here](https://guide.elm-lang.org/install/terminal.html).
4−
5−
6−<br/>
7−
8−## Installing Multiple Versions
9−
10−The secret is that Elm is just a single executable file. If you are developing a project in `~/Desktop/project/` you can download this file into that directory and run commands like `~/Desktop/project/elm make src/Main.elm` or `./elm make src/Main.elm`. You just run the local copy of the executable file!
11−
12−The instructions for [Mac][mac] and [Linux][lin] explain how to do this in more detail. You can follow the same steps on Windows, but you need to do each step by hand. (E.g. download the file through your browser rather than with a terminal command.)
13−
14−[mac]: https://github.com/elm/compiler/blob/master/installers/mac/README.md
15−[lin]: https://github.com/elm/compiler/blob/master/installers/linux/README.md
16−
17−<br/>
18−
19−## Installing Previous Versions
20−
21−The past binaries for Mac, Linux, and Windows are hosted [here](https://github.com/elm/compiler/releases).
22−
23−You can download the executable files directly and use them locally.
24−
25−
26−<br/>
27−
28−## Uninstall
29−
30−- [Mac](https://github.com/elm/compiler/blob/master/installers/mac/README.md#uninstall)
31−- [Linux](https://github.com/elm/compiler/blob/master/installers/linux/README.md#uninstall)
32−- [Windows](https://github.com/elm/compiler/blob/master/installers/win/README.md#uninstall)
installers/linux/Dockerfile+19−33
@@ -1,39 +1,25 @@
1−# Based initially on https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9
1+# Create: https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9
2−#
3−# Build Linux x64 binary from elm compiler top-level directory:
4−# $ docker build -t elm -f installers/linux/Dockerfile .
5−#
6−# Retrieve elm Linux binary:
7−# $ docker cp $(docker create elm):/usr/local/bin/elm DESTINATION_DIRECTORY
8−#
9−# Delete docker elm image:
10−# $ docker rmi elm
11−#
12−# Display all images:
13−# $ docker images -a
14−#
15−# Delete all unused docker images:
16−# $ docker system prune -a
2+# Delete: docker system prune -a ; docker images -a
17
3
18−# Use Alpine 3.11 with GHC 8.6.5
19−FROM alpine:3.11
4+FROM alpine:3.10
20
5
21−# Install packages required to build elm
6+# branch
22−RUN apk add --no-cache ghc cabal wget musl-dev zlib-dev zlib-static ncurses-dev ncurses-static
7+ARG branch=master
8+# commit or tag
9+ARG commit=HEAD
23
10
24−WORKDIR /elm
11+# Install required packages
12+RUN apk add --update ghc cabal git musl-dev zlib-dev ncurses-dev ncurses-static wget
25
13
26−# Import source code
14+# Checkout elm compiler
27−COPY builder builder
15+WORKDIR /tmp
28−COPY compiler compiler
16+RUN git clone -b $branch https://github.com/elm/compiler.git
29−COPY reactor reactor
30−COPY terminal terminal
31−COPY cabal.config elm.cabal LICENSE ./
32
17
33−# Build statically linked elm binary
18+# Build a statically linked elm binary
19+WORKDIR /tmp/compiler
20+RUN git checkout $commit
21+RUN rm worker/elm.cabal
34RUN cabal new-update
22RUN cabal new-update
35−RUN cabal new-build --ghc-option=-optl=-static --ghc-option=-split-sections
23+RUN cabal new-configure --disable-executable-dynamic --ghc-option=-optl=-static --ghc-option=-optl=-pthread
24+RUN cabal new-build
36−RUN cp ./dist-newstyle/build/x86_64-linux/ghc-*/elm-*/x/elm/build/elm/elm /usr/local/bin/elm
25+RUN strip -s ./dist-newstyle/build/x86_64-linux/ghc-8.4.3/elm-0.19.1/x/elm/build/elm/elm
37−
38−# Remove debug symbols to optimize the binary size
39−RUN strip -s /usr/local/bin/elm
installers/linux/README.mddeleted−93
@@ -1,93 +0,0 @@
1−# Install Instructions
2−
3−The pre-compiled binary for Linux works on a very wide range of distributions.
4−
5−It should be possible to install it by running the following commands in your terminal:
6−
7−```bash
8−# Move to your Desktop so you can see what is going on easier.
9−#
10−cd ~/Desktop/
11−
12−# Download the 0.19.1 binary for Linux.
13−#
14−# +-----------+----------------------+
15−# | FLAG | MEANING |
16−# +-----------+----------------------+
17−# | -L | follow redirects |
18−# | -o elm.gz | name the file elm.gz |
19−# +-----------+----------------------+
20−#
21−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz
22−
23−# There should now be a file named `elm.gz` on your Desktop.
24−#
25−# The downloaded file is compressed to make it faster to download.
26−# This next command decompresses it, replacing `elm.gz` with `elm`.
27−#
28−gunzip elm.gz
29−
30−# There should now be a file named `elm` on your Desktop!
31−#
32−# Every file has "permissions" about whether it can be read, written, or executed.
33−# So before we use this file, we need to mark this file as executable:
34−#
35−chmod +x elm
36−
37−# The `elm` file is now executable. That means running `~/Desktop/elm --help`
38−# should work. Saying `./elm --help` works the same.
39−#
40−# But we want to be able to say `elm --help` without specifying the full file
41−# path every time. We can do this by moving the `elm` binary to one of the
42−# directories listed in your `PATH` environment variable:
43−#
44−sudo mv elm /usr/local/bin/
45−
46−# Now it should be possible to run the `elm` binary just by saying its name!
47−#
48−elm --help
49−```
50−
51−<br/>
52−
53−## Wait, what is the `PATH` variable?
54−
55−When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.
56−
57−The `PATH` is the list of directories that get searched. You can see these directories by running:
58−
59−```bash
60−echo $PATH
61−```
62−
63−This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.
64−
65−When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.
66−
67−So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.
68−
69−So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.
70−
71−**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.
72−
73−
74−<br/>
75−
76−## Uninstall
77−
78−The following commands should remove everything:
79−
80−```bash
81−# Remove the `elm` executable.
82−#
83−sudo rm /usr/local/bin/elm
84−
85−# Remove any cached files. The files here reduce compile times when
86−# starting new projects and make it possible to work offline in more
87−# cases. No need to keep it around if you are uninstalling though!
88−#
89−rm -r ~/.elm/
90−```
91−
92−If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.
93−
installers/mac/Distribution.xml+3−5
@@ -1,6 +1,6 @@
1<?xml version="1.0" encoding="utf-8" standalone="no"?>
1<?xml version="1.0" encoding="utf-8" standalone="no"?>
2<installer-script minSpecVersion="1.000000" authoringTool="com.apple.PackageMaker" authoringToolVersion="3.0.6" authoringToolBuild="201">
2<installer-script minSpecVersion="1.000000" authoringTool="com.apple.PackageMaker" authoringToolVersion="3.0.6" authoringToolBuild="201">
3− <title>Elm</title>
3+ <title>Elm Platform</title>
4 <options customize="allow" allow-external-scripts="no"/>
4 <options customize="allow" allow-external-scripts="no"/>
5 <domains enable_localSystem="true"/>
5 <domains enable_localSystem="true"/>
6 <volume-check script="pm_volume_check();"/>
6 <volume-check script="pm_volume_check();"/>
@@ -10,7 +10,7 @@
10function pm_volume_check() {
10function pm_volume_check() {
11 if(!(my.target.systemVersion &amp;&amp; /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {
11 if(!(my.target.systemVersion &amp;&amp; /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {
12 my.result.title = 'Failure';
12 my.result.title = 'Failure';
13− my.result.message = 'This version of Elm requires Mac OS X 10.6 or later.';
13+ my.result.message = 'This version of Elm Platform requires Mac OS X 10.6 or later.';
14 my.result.type = 'Fatal';
14 my.result.type = 'Fatal';
15 return false;
15 return false;
16 }
16 }
@@ -18,15 +18,13 @@ function pm_volume_check() {
18}
18}
19
19
20</script>
20</script>
21− <!--
22 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>
21 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>
23− -->
24 <welcome mime-type="text/rtf" file="welcome.rtf" />
22 <welcome mime-type="text/rtf" file="welcome.rtf" />
25 <conclusion mime-type="text/rtf" file="conclusion.rtf" />
23 <conclusion mime-type="text/rtf" file="conclusion.rtf" />
26 <choices-outline>
24 <choices-outline>
27 <line choice="choice2"/>
25 <line choice="choice2"/>
28 </choices-outline>
26 </choices-outline>
29− <choice id="choice2" title="Elm">
27+ <choice id="choice2" title="Elm Platform ">
30 <pkg-ref id="org.elm-lang.binaries.pkg"/>
28 <pkg-ref id="org.elm-lang.binaries.pkg"/>
31 </choice>
29 </choice>
32 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>
30 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>
installers/mac/README.mddeleted−93
@@ -1,93 +0,0 @@
1−# Install Instructions
2−
3−The easiest way to install is to to use [the Mac installer](https://github.com/elm/compiler/releases/download/0.19.1/installer-for-mac.pkg)!
4−
5−But it is also possible to install by running the following commands in your terminal:
6−
7−```bash
8−# Move to your Desktop so you can see what is going on easier.
9−#
10−cd ~/Desktop/
11−
12−# Download the 0.19.1 binary for Linux.
13−#
14−# +-----------+----------------------+
15−# | FLAG | MEANING |
16−# +-----------+----------------------+
17−# | -L | follow redirects |
18−# | -o elm.gz | name the file elm.gz |
19−# +-----------+----------------------+
20−#
21−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-mac-64-bit.gz
22−
23−# There should now be a file named `elm.gz` on your Desktop.
24−#
25−# The downloaded file is compressed to make it faster to download.
26−# This next command decompresses it, replacing `elm.gz` with `elm`.
27−#
28−gunzip elm.gz
29−
30−# There should now be a file named `elm` on your Desktop!
31−#
32−# Every file has "permissions" about whether it can be read, written, or executed.
33−# So before we use this file, we need to mark this file as executable:
34−#
35−chmod +x elm
36−
37−# The `elm` file is now executable. That means running `~/Desktop/elm --help`
38−# should work. Saying `./elm --help` works the same.
39−#
40−# But we want to be able to say `elm --help` without specifying the full file
41−# path every time. We can do this by moving the `elm` binary to one of the
42−# directories listed in your `PATH` environment variable:
43−#
44−sudo mv elm /usr/local/bin/
45−
46−# Now it should be possible to run the `elm` binary just by saying its name!
47−#
48−elm --help
49−```
50−
51−<br/>
52−
53−## What is the `PATH` variable?
54−
55−When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.
56−
57−The `PATH` is the list of directories that get searched. You can see these directories by running:
58−
59−```bash
60−echo $PATH
61−```
62−
63−This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.
64−
65−When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.
66−
67−So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.
68−
69−So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.
70−
71−**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.
72−
73−
74−<br/>
75−
76−## Uninstall
77−
78−The following commands should remove everything:
79−
80−```bash
81−# Remove the `elm` executable.
82−#
83−sudo rm /usr/local/bin/elm
84−
85−# Remove any cached files. The files here reduce compile times when
86−# starting new projects and make it possible to work offline in more
87−# cases. No need to keep it around if you are uninstalling though!
88−#
89−rm -r ~/.elm/
90−```
91−
92−If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.
93−
installers/mac/Resources/en.lproj/background.pngnew file

Binary file not shown.

installers/mac/Resources/en.lproj/conclusion.rtf+6−13
@@ -1,16 +1,9 @@
1−{\rtf1\ansi\ansicpg1252\cocoartf2509
1+{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400
2−\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}
2+{\fonttbl\f0\fswiss\fcharset0 Helvetica;}
3{\colortbl;\red255\green255\blue255;}
3{\colortbl;\red255\green255\blue255;}
4−{\*\expandedcolortbl;;}
5−\paperw11900\paperh16840\margl1440\margr1440\vieww11180\viewh8400\viewkind0
4+\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0
6−\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0
5+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural
7
6
8−\f0\fs28 \cf0 Try opening the terminal and running commands like:\
7+\f0\fs26 \cf0 A bunch of useful programs were just placed in /usr/local/bin/\
9\
8\
10−
11−\f1 elm init\
12−elm make src/Main.elm --optimize\
13−elm repl
14−\f0 \
15−\
16−Check out {\field{\*\fldinst{HYPERLINK "https://guide.elm-lang.org/"}}{\fldrslt this tutorial}} for more advice!}
9+Check out {\field{\*\fldinst HYPERLINK "http://elm-lang.org/Get-Started.elm"}{\fldrslt this tutorial}} to learn how to use them!}
installers/mac/Resources/en.lproj/welcome.rtf+4−9
@@ -1,12 +1,7 @@
1−{\rtf1\ansi\ansicpg1252\cocoartf2509
1+{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400
2−\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}
2+{\fonttbl\f0\fswiss\fcharset0 Helvetica;}
3{\colortbl;\red255\green255\blue255;}
3{\colortbl;\red255\green255\blue255;}
4−{\*\expandedcolortbl;;}
5\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0
4\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0
6−\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural\partightenfactor0
5+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural
7
6
8−\f0\fs28 \cf0 Thank you for trying out Elm!\
7+\f0\fs28 \cf0 This package will install Elm on your machine.}
9−\
10−This installer makes
11−\f1 elm
12−\f0 available in your terminal.}
installers/mac/helper-scripts/elm-startup.sh+1−1
@@ -1,3 +1,3 @@
1#!/bin/sh
1#!/bin/sh
2
2
3−open 'http://guide.elm-lang.org'
3+open 'http://elm-lang.org'
installers/mac/make-installer.sh+3−30
@@ -29,8 +29,7 @@ cp $(pwd)/preinstall $pkg_scripts
29cp $(pwd)/postinstall $pkg_scripts
29cp $(pwd)/postinstall $pkg_scripts
30
30
31pkgbuild \
31pkgbuild \
32− --sign "Developer ID Installer: <NAME>" \
33− --identifier org.elm-lang.binary \
32+ --identifier org.elm-lang.binaries.pkg \
34 --install-location $usr_binaries \
33 --install-location $usr_binaries \
35 --scripts $pkg_scripts \
34 --scripts $pkg_scripts \
36 --filter 'Scripts.*' \
35 --filter 'Scripts.*' \
@@ -40,42 +39,16 @@ pkgbuild \
40
39
41#### BUNDLE ASSETS ####
40#### BUNDLE ASSETS ####
42
41
43−rm -f installer-for-mac.pkg
42+rm -f Elm.pkg
44
43
45productbuild \
44productbuild \
46− --sign "Developer ID Installer: <NAME>" \
47− --identifier org.elm-lang.installer \
48 --distribution Distribution.xml \
45 --distribution Distribution.xml \
49 --package-path . \
46 --package-path . \
50 --resources Resources \
47 --resources Resources \
51− installer-for-mac.pkg
48+ Elm.pkg
52
49
53
50
54#### CLEAN UP ####
51#### CLEAN UP ####
55
52
56rm binaries.pkg
53rm binaries.pkg
57rm -rf $pkg_root
54rm -rf $pkg_root
58−
59−
60−#### BEGIN NOTARIZATION ####
61−
62−xcrun altool \
63− --notarize-app \
64− --primary-bundle-id "org.elm-lang.installer" \
65− --username "<EMAIL>" \
66− --password "@keychain:Developer-altool" \
67− --file "installer-for-mac.pkg"
68−
69−# From https://scriptingosx.com/2019/09/notarize-a-command-line-tool/
70−#
71−#### Check on notarization:
72−#
73−# xcrun altool \
74−# --notarization-info "<RequestUUID>" \
75−# --username "<EMAIL>" \
76−# --password "@keychain:Developer-altool"
77−#
78−#
79−#### Staple Notarization:
80−#
81−# xcrun stapler staple installer-for-mac.pkg
installers/npm/PUBLISHING.md+141−29
@@ -1,59 +1,171 @@
1−# Publishing
1+# Publishing a new release
2
2
3−Here's how to update the `npm` installer.
3+A new version of Elm came out. Huzzah! Here's how to update the `npm` installer.
4
4
5+## 1. Create tarballs of binaries
5
6
6−## 1. GitHub Release
7+You can find a list of what binaries we'll need to tar up in `index.js`.
7
8
8−Create a [GitHub Release](https://github.com/elm/compiler/releases) with the following files:
9+For example:
9
10
10−1. `binary-for-mac-64-bit.gz`
11+```javascript
11−2. `binary-for-windows-64-bit.gz`
12+var root =
12−3. `binary-for-linux-64-bit.gz`
13+ "https://github.com/elm/compiler/releases/download/" +
14+ binVersion +
15+ "/binaries-for-";
13
16
14−Create each of these by running the `elm` executable for each platform through `gzip elm`.
17+module.exports = binwrap({
18+ binaries: ["elm"],
19+ urls: {
20+ "darwin-x64": root + "mac.tar.gz",
21+ "win32-x64": root + "windows.tar.gz",
22+ "win32-ia32": root + "windows.tar.gz",
23+ "linux-x64": root + "linux.tar.gz"
24+ }
25+});
26+```
27+
28+If this is the end of your `index.js`, you'll need to create these files:
15
29
30+1. `binaries-for-mac.tar.gz`
31+2. `binaries-for-windows.tar.gz`
32+3. `binaries-for-linux.tar.gz`
16
33
17−## 2. Try a beta release
34+Each of these tarballs should have **only the Elm binary** inside them - no
35+directories!
18
36
19−In `package.json`, bump the version to `"0.19.2-beta"`.
37+So create them by making a directory, putting all the binaries in it, `cd`-ing
38+into that directory, and then running something like this:
20
39
21−```bash
40+```shell
22−npm publish --tag beta
41+$ tar cvzf binaries-for-linux.tar.gz elm
23```
42```
24
43
25−To test that it works, run these commands:
44+Make sure each tarball contains all the binaries listed in that `binaries:` list
45+in `index.js`. (The Windows ones should have `.exe` at the end; `binwrap`
46+expects that they will, for Windows only.)
47+
48+## 2. Update the `bin/` binary wrappers
49+
50+Inside the npm installer's `bin/` directory, there should be a file for each of
51+the binaries that will be included in this release.
52+
53+Each of these must be executable! If you're not sure whether they are,
54+run `chmod +x` on them just to be sure.
55+
56+Their paths must also must all be listed in `package.json` in two places:
57+
58+1. The `"files":` field
59+2. The `"bin":` field
60+
61+If the executables are the same as they were for the last release, great!
62+You can proceed to the next step. If any binaries were removed, make sure to
63+remove them from these lists!
64+
65+## 3. Update `package.json` for a beta release
66+
67+In `package.json`, bump the version to the next applicable release, and add
68+a `"-beta"` suffix to it.
69+
70+For example, if it was on `"0.18.0"` you might bump it to `"0.19.0-beta"`.
71+The version number should match the release of Elm, such that if people do
72+`npm install elm@0.19.0@beta` they get what they would expect.
73+
74+## 4. Tag the beta release
75+
76+Commit this change and tag it with the name of the release **without** the
77+`-beta` suffix. (We will overwrite this tag later.)
78+
79+For example:
26
80
27−```bash
81+```shell
28−npm dist-tags ls elm
82+$ git tag 0.19.0
29−npm install elm@beta --ignore-scripts
83+$ git push origin 0.19.0
30```
84```
31
85
32−The `latest` tag should not be changed, and there should be an additional `beta` tag.
86+Now this tag should exist on GitHub, allowing us to upload binaries to it.
33
87
34−Try this on Windows, Linux, and Mac.
88+## 5. Upload binaries
35
89
90+Visit the [Create a New Release](https://github.com/elm-lang/elm-platform/releases/new)
91+page and use the `Tag version` dropdown to select the tag you just pushed. Give
92+it a title like `0.19.0`. Don't mention the `-beta` in it. The "beta" concept
93+is for `npm` only.
36
94
37−## 3. Publish final release
95+Upload the tarballs you created in step 1.
38
96
39−Remove the `-beta` suffix from the version in `package.json`. Then run:
97+## 6. Publish beta release
40
98
41−```bash
99+Run this to publish the beta release. The `--tag beta` is **crucial** here.
100+Without it, `npm` will by default publish a new top-level release, which would
101+mean that what you just published would become what everyone gets when they
102+`npm install -g elm` without any additional qualifiers.
103+
104+```shell
42−npm publish
105+$ npm publish --tag beta
43```
106```
44
107
108+Afterwards you should be able to do `npm info elm | less` and see something
109+like this in the JSON:
110+
111+```
112+'dist-tags': { latest: '0.18.0', beta: '0.19.0-beta' }
113+```
45
114
46−## 4. Tag the `latest-0.19.1` version
115+If you messed this up, and the `latest` tag now points to the beta you just
116+published, don't panic - it's fixable! `dist-tags` can always be modified after
117+the fact. Read up on `npm` [dist-tags](https://docs.npmjs.com/cli/dist-tag)
118+to learn how to fix things.
47
119
48−Many compiler releases have needed multiple `npm` publications. Maybe something does not work on Windows or some dependency becomes insecure. Normal `npm` problems.
120+## 7. Verify beta installer
49
121
50−The convention for each Elm release is to create a tag the latest one.
122+Make an empty directory and run `npm init` inside it.
51
123
52−```bash
124+Then run this:
53−npm dist-tag add elm@0.19.1-3 latest-0.19.1
125+
126+```shell
127+$ npm install elm@beta --ignore-scripts
54```
128```
55
129
56−That way people who want a specific version can point to `latest-0.19.1` or `latest-0.18.0` instead of knowing the particular names of all the various publications.
130+This should succeed with an exit code of `0`.
131+If it did, look in `node_modules/.bin/` for the binaries you expect.
132+They should be present, and they should also work as expected when you run them.
133+Because you installed them with `--ignore-scripts`, the first thing they should
134+do is to download themselves and then execute whatever command you requested
135+(e.g. `node_modules/.bin/elm make Main.elm`). If you run the same command a
136+second time, it should run faster because it doesn't have to download the binary
137+first.
138+
139+Now try it again with `--ignore-scripts` turned off:
140+
141+```shell
142+$ rm -r node_modules
143+$ npm install elm@beta --ignore-scripts=false
144+```
145+
146+This time it should download the binaries during the installation phase. Once
147+again you should be able to run the binaries from `node_modules/.bin/`, and
148+this time they should be fast from the first run because they're already
149+downloaded.
150+
151+## 8. Publish for real
152+
153+It's a good idea to ask others to try out the beta installer before doing this!
154+Especially on multiple operating systems.
155+
156+To publish the real version:
157+
158+1. Edit `package.json` to remove the `-beta` suffix from the version.
159+2. Commit that change and push it.
160+3. Use `git tag --force` to overwrite the previous tag (e.g. `0.19.0` - whatever you used before).
161+4. Force push the tag, e.g. `git push origin 0.19.0 --force-with-lease`.
162+5. `npm publish`
57
163
58−You can read more about dist-tags [here](https://docs.npmjs.com/cli/dist-tag).
164+You're done! Now whenever anyone does `npm install -g elm` they'll get the
165+version you just uploaded.
59
166
167+The reason we only used the `-beta` suffix for `npm` was so that when we ran
168+tests on the beta version, it was all against the same (non-beta) URLs we'd end
169+up using for the real version. This means there's no opportunity for us to
170+introduce some sort of mismatch between the beta that we verified and the real
171+version.
installers/npm/README.md+23−30
@@ -1,45 +1,38 @@
1−# Elm Installer
1+npm install elm [![Travis build Status](https://travis-ci.org/elm-lang/elm-platform.svg?branch=master)](http://travis-ci.org/elm-lang/elm-platform) [![AppVeyor build status](https://ci.appveyor.com/api/projects/status/6mcub79i04ianpm9/branch/master?svg=true)](https://ci.appveyor.com/project/rtfeldman/elm-platform/branch/master)
2+===============
2
3
3−[Elm](https://elm-lang.org) is a functional programming language that compiles to JavaScript.
4+Install the [Elm Platform](https://github.com/elm-lang/elm-platform) via [`npm`](https://www.npmjs.com).
4
5
5−Head over to [The Official Guide](https://guide.elm-lang.org/) to start learning Elm!
6+## Installing
6
7
8+Run this to get the binaries:
7
9
8−<br/>
10+```
9−
11+$ npm install -g elm
10−## What is this package for?
12+```
11−
12−**Normal installs** ❌
13−
14−Use the instructions [here](https://guide.elm-lang.org/install/elm.html) instead.
15−
16−**Multiple versions** ✅
17−
18−People using Elm at work may use different versions of Elm in different projects. They can run `npm install elm@latest-0.19.1` in each project and use the binary at `./node_modules/.bin/elm` for compilation.
19−
20−**Continuous integration** ⚠️
21−
22−This works, but there are usually faster and more reliable options:
23−
24−1. You can download `elm` directly from GitHub with [this script](https://github.com/elm/compiler/blob/master/installers/linux/README.md). This is all the `npm` installer does, but with extra HTTP requests to `npmjs.com` servers, making it slower and adding more failure points.
25−2. Many continuous integration have ways to cache files ([example](https://docs.travis-ci.com/user/caching/)) to make builds faster and more reliable.
26−
27−That said, it will definitely work to use the `npm` installer on CI if you prefer that option.
28
13
14+## Installing behind a proxy server
29
15
30−<br/>
16+If you are behind a proxy server, set the environment variable "HTTPS_PROXY".
31
17
32−## Install Locally
18+```
19+$ export HTTPS_PROXY=$YourProxyServer$
20+$ npm install -g elm
21+```
33
22
34−The following command should download the latest Elm 0.19.1 binary:
23+Or on Windows:
35
24
36```
25```
26+$ set HTTPS_PROXY=$YourProxyServer$
37−npm install elm@latest-0.19.1
27+$ npm install -g elm
38```
28```
39
29
40−You should be able to run `./node_modules/bin/elm --version` within your project and see `0.19.1`. Now you can compile with `./node_modules/bin/elm make src/Main.elm` and not disrupt other packages.
30+## Troubleshooting
41
31
42−Use `npm install elm@latest-0.19.0` or `npm install elm@latest-0.18.0` for earlier versions.
32+1. [Troubleshooting npm](https://github.com/npm/npm/wiki/Troubleshooting)
33+2. On Debian/Ubuntu systems, you may have to install the nodejs-legacy package: `apt-get install nodejs-legacy`.
34+3. If the installer says that it cannot find any usable binaries for your operating system and architecture, check the [Build from Source](https://github.com/elm-lang/elm-platform/blob/master/README.md#build-from-source) documentation.
43
35
44−**Note:** The `latest-X.Y.Z` convention is used in case we need to publish patches for the `npm` installer within a given Elm release. For example, say `npm` decides that some transitive dependency is not secure. Nothing is changing about Elm or the binaries, but we need to publish a new `npm` installer that fixes this issue.
36+## Getting Started
45
37
38+Once everything has installed successfully, head over to the [Get Started](http://elm-lang.org/Get-Started.elm) page!
installers/npm/bin/elm+17−42
@@ -1,54 +1,29 @@
1#!/usr/bin/env node
1#!/usr/bin/env node
2
2
3var child_process = require('child_process');
3var child_process = require('child_process');
4−var path = require('path');
4+var download = require('../download.js');
5var fs = require('fs');
5var fs = require('fs');
6
6
7
7
8−// Some npm users enable --ignore-scripts (a good security measure) so
8+// Some npm users enable --ignore-scripts (a good security measure)
9−// they do not run the post-install hook and install.js does not run.
10−// Instead they will run this script.
11//
9//
12−// On Mac and Linux, we download the elm executable into the exact same
10+// They do not run the post-install hook, so install.js does not run.
13−// location as this file. Since npm uses symlinks on these platforms,
14−// that means that the first run will invoke this file and subsequent
15−// runs will call the elm binary directly.
16//
11//
17−// On Windows, we must download a file named elm.exe for it to run properly.
12+// This file pretends to be the downloaded binary. It then downloads
18−// Instead of symlinks, npm creates two files:
13+// the real binary over itself. So in that case, the first run would
19−//
14+// also make an HTTPS request to fetch the real binary. From there,
20−// - node_modules/.bin/elm (a bash file)
15+// it calls the binary it downloaded on each run.
21−// - node_modules/.bin/elm.cmd (a batch file)
22−//
23−// Both files specifically invoke `node` to run the file listed at package.bin,
24−// so there is no way around instantiating node for no reason on Windows. So
25−// the existsSync check is needed so that it is not downloaded more than once.
26
16
27
17
28−// figure out where to put the binary (calls path.resolve() to get path separators right on Windows)
29−//
30−var binaryPath = path.resolve(__dirname, 'elm') + (process.platform === 'win32' ? '.exe' : '');
31−
32−// Run the command directly if possible, otherwise download and then run.
33−// This check is important for Windows where this file will be run all the time.
34−//
35−if (process.platform === 'win32')
36−{
37− fs.existsSync(binaryPath)
38− ? runCommand()
39− : require('../download.js')(runCommand);
40−}
41−else
42−{
43− require('../download.js')(runCommand);
44−}
45
18
19+// Make sure we get the right path even if we're executing from the symlinked
20+// node_modules/.bin/ executable
21+var pathToThisFile = fs.realpathSync(process.argv[1]);
46
22
47−function runCommand()
23+download(pathToThisFile, function() {
48−{
49− // Need double quotes and { shell: true } when there are spaces in the path on windows:
24+ // Need double quotes and { shell: true } when there are spaces in the path on windows:
50− // https://github.com/nodejs/node/issues/7367#issuecomment-229721296
25+ // https://github.com/nodejs/node/issues/7367#issuecomment-229721296
51− child_process
26+ child_process
52− .spawn('"' + binaryPath + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })
27+ .spawn('"' + pathToThisFile + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })
53− .on('exit', process.exit);
28+ .on('exit', process.exit);
54−}
29+});
installers/npm/download.js+68−68
@@ -1,7 +1,7 @@
1var fs = require('fs');
1var fs = require('fs');
2var package = require('./package.json');
2var package = require('./package.json');
3−var path = require('path');
3+var URL = require('url').URL;
4−var request = require('request');
4+var https = require('https');
5var zlib = require('zlib');
5var zlib = require('zlib');
6
6
7
7
@@ -12,72 +12,88 @@ var zlib = require('zlib');
12// called when --ignore-scripts is enabled. That's why install.js is so weird.
12// called when --ignore-scripts is enabled. That's why install.js is so weird.
13
13
14
14
15−module.exports = function(callback)
15+module.exports = function(destinationPath, callback)
16{
16{
17− // figure out URL of binary
18 var version = package.version.replace(/^(\d+\.\d+\.\d+).*$/, '$1'); // turn '1.2.3-alpha' into '1.2.3'
17 var version = package.version.replace(/^(\d+\.\d+\.\d+).*$/, '$1'); // turn '1.2.3-alpha' into '1.2.3'
18+ var os = { 'darwin': 'mac', 'win32': 'windows', 'linux': 'linux' }[process.platform];
19+ var arch = { 'x64': '64-bit', 'ia32': '32-bit' }[process.arch];
20+ var path = process.platform === 'win32' ? destinationPath + '.exe' : destinationPath;
21+ var url = 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + os + '-' + arch + '.gz';
19
22
20− var platform = {
23+ // check if exists for bin/elm running for the Nth time on Windows
21− darwin_x64: 'mac-64-bit',
24+ fs.existsSync(path)
22− darwin_arm64: 'mac-64-bit',
25+ ? callback()
23− win32_x64: 'windows-64-bit',
26+ : download(path, url, callback);
24− linux_x64: 'linux-64-bit'
27+};
25− }[process.platform + '_' + process.arch];
26
28
27− verifyPlatform(version, platform);
28
29
29− var url = 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + platform + '.gz';
30
30
31− reportDownload(version, url);
31+// DOWNLOAD
32
32
33− // figure out where to put the binary (calls path.resolve() to get path separators right on Windows)
34− var binaryPath = path.resolve(__dirname, package.bin.elm) + (process.platform === 'win32' ? '.exe' : '');
35
33
36− // set up handler for request failure
34+function download(destinationPath, url, callback)
37− function reportDownloadFailure(error)
35+{
38− {
36+ requestWithRedirects(url, 10,
37+ function(error) {
38+ exitFailure(url, 'I ran into trouble while fetching ' + url + '\n\n' + error);
39+ },
40+ function(response) {
41+ if (response.statusCode == 404)
42+ {
43+ exitFailure(url, 'I got a "404 Not Found" trying to download from the following URL:\n'
44+ + url
45+ + '\n\nThis may mean you are trying to install on an unsupported platform. (e.g. some 32-bit systems?)'
46+ );
47+ }
48+
49+ response.on('error', function() {
39− exitFailure(url,'Something went wrong while fetching the following URL:\n\n' + url + '\n\nIt is saying:\n\n' + error);
50+ exitFailure(url, 'Something went wrong while receiving the following URL:\n\n' + url);
40− }
51+ });
41−
52+
42− // set up decompression pipe
43− var gunzip = zlib.createGunzip().on('error', function(error) {
53+ var gunzip = zlib.createGunzip().on('error', function(error) {
44− exitFailure(url, 'I ran into trouble decompressing the downloaded binary. It is saying:\n\n' + error);
54+ exitFailure(url, 'I ran into trouble decompressing the downloaded binary. It is saying:\n\n' + error);
45− });
55+ });
46−
47− // set up file write pipe
48− var write = fs.createWriteStream(binaryPath, {
56+ var write = fs.createWriteStream(destinationPath, {
49− encoding: 'binary',
57+ encoding: 'binary',
50− mode: 0o755
58+ mode: 0o755
51− }).on('finish', callback).on('error', function(error) {
59+ }).on('finish', callback).on('error', function(error) {
52− exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);
60+ exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);
53− });
61+ });
54−
62+
55− // put it all together
56− request(url).on('error', reportDownloadFailure).pipe(gunzip).pipe(write);
63+ response.pipe(gunzip).pipe(write);
64+ }
65+ );
57}
66}
58
67
59
68
60
69
61−// VERIFY PLATFORM
70+// HANDLE REDIRECTS
62
71
63
72
64−function verifyPlatform(version, platform)
73+function requestWithRedirects(url, maxRedirects, failure, success)
65{
74{
66− if (platform) return;
75+ var req = https.request(url);
76+
77+ req.on('response', function(response) {
78+ // Check for redirects
79+
80+ var redirectUrl = new URL(response.headers['location'], new URL(url).origin).href;
81+
82+ if (typeof redirectUrl === 'string' && response.statusCode >= 300 && response.statusCode < 400)
83+ {
84+ return (maxRedirects <= 0)
85+ ? failure(new Error('followed 10 redirects and gave up'))
86+ : requestWithRedirects(redirectUrl, maxRedirects - 1, failure, success);
87+ }
88+ else
89+ {
90+ return success(response);
91+ }
92+ });
67
93
68− var situation = process.platform + '_' + process.arch;
94+ req.on('error', failure);
69− console.error(
95+
70− '-- ERROR -----------------------------------------------------------------------\n\n'
96+ req.end();
71− + 'I am detecting that your computer (' + situation + ') may not be compatible with any\n'
72− + 'of the official pre-built binaries.\n\n'
73− + 'I recommend against using the npm installer for your situation. Check out the\n'
74− + 'alternative installers at https://github.com/elm/compiler/releases/tag/' + version + '\n'
75− + 'to see if there is something that will work better for you.\n\n'
76− + 'From there I recommend asking for guidance on Slack or Discourse to find someone\n'
77− + 'who can help with your specific situation.\n\n'
78− + '--------------------------------------------------------------------------------\n'
79− );
80− process.exit(1);
81}
97}
82
98
83
99
@@ -96,19 +112,3 @@ function exitFailure(url, message)
96 );
112 );
97 process.exit(1);
113 process.exit(1);
98}
114}
99−
100−
101−
102−// REPORT DOWNLOAD
103−
104−
105−function reportDownload(version, url)
106−{
107− console.log(
108− '--------------------------------------------------------------------------------\n\n'
109− + 'Downloading Elm ' + version + ' from GitHub.'
110− + '\n\nNOTE: You can avoid npm entirely by downloading directly from:\n'
111− + url + '\nAll this package does is download that file and put it somewhere.\n\n'
112− + '--------------------------------------------------------------------------------\n'
113− );
114−}
installers/npm/install.js+7−1
@@ -1,4 +1,10 @@
1
1
2var download = require('./download.js');
2var download = require('./download.js');
3+var package = require('./package.json');
4+var path = require('path');
3
5
6+
7+// get slashes right for Windows
8+var targetPath = path.resolve(__dirname, Object.values(package.bin)[0]);
9+
4−download(function() {});
10+download(targetPath, function() {});
installers/npm/package.json+7−6
@@ -1,6 +1,6 @@
1{
1{
2 "name": "elm",
2 "name": "elm",
3− "version": "0.19.1-5",
3+ "version": "0.19.0-no-deps",
4 "description": "Installer for Elm: just downloads the binary into node_modules",
4 "description": "Installer for Elm: just downloads the binary into node_modules",
5 "preferGlobal": true,
5 "preferGlobal": true,
6 "license": "BSD-3-Clause",
6 "license": "BSD-3-Clause",
@@ -11,9 +11,9 @@
11 "homepage": "https://github.com/elm/compiler/tree/master/installers/npm",
11 "homepage": "https://github.com/elm/compiler/tree/master/installers/npm",
12 "bugs": "https://github.com/elm/compiler/issues",
12 "bugs": "https://github.com/elm/compiler/issues",
13 "author": {
13 "author": {
14− "name": "Evan Czaplicki",
14+ "name": "Richard Feldman",
15− "email": "evan@elm-lang.org",
15+ "email": "richard.t.feldman@gmail.com",
16− "url": "https://github.com/evancz"
16+ "url": "https://github.com/rtfeldman"
17 },
17 },
18 "engines": {
18 "engines": {
19 "node": ">=7.0.0"
19 "node": ">=7.0.0"
@@ -35,8 +35,9 @@
35 "install",
35 "install",
36 "installer"
36 "installer"
37 ],
37 ],
38+ "bin": {
38− "bin": { "elm": "bin/elm" },
39+ "elm": "bin/elm"
40+ },
39 "dependencies": {
41 "dependencies": {
40− "request": "^2.88.0"
41 }
42 }
42}
43}
installers/npm/troubleshooting.mddeleted−76
@@ -1,76 +0,0 @@
1−# Troubleshooting
2−
3−I very highly recommend asking for help on [the Elm slack](https://elmlang.herokuapp.com).
4−
5−There are a lot of things that can go wrong when installing software, and it can really help to have a second pair of eyes on your situation!
6−
7−This document goes through a couple options that may help you out.
8−
9−<br/>
10−
11−
12−## Can you skip npm entirely?
13−
14−The most reliable way to get Elm installed using the official installers for Mac and Windows [here][download].
15−
16−You can also download the binaries directly. On Linux, you could do it in the terminal like this:
17−
18−```bash
19−cd ~/Desktop/
20−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz
21−gunzip elm.gz # unzip the file
22−chmod +x elm # make the file executable
23−sudo mv elm /usr/local/bin/ # put the executable in a directory likely to be listed in your PATH variable
24−```
25−
26−If these exact commands do not work for you, you can try to do the same thing by hand.
27−
28−Read the section below on `PATH` variables if you are not sure what that is!
29−
30−[download]: https://github.com/elm/compiler/releases/tag/0.19.1
31−
32−<br/>
33−
34−
35−## Do you need to use npm for some reason?
36−
37−The company running npm has a list of common troubleshooting situations [here](https://npm.community/c/support/troubleshooting), but it may be better to just try to find your specific case on Stack Overflow. Often there are permissions issues where you may need to use `sudo` with some command.
38−
39−### Firewalls
40−
41−Some companies have a firewall.
42−
43−These companies usually have set the `HTTP_PROXY` or `HTTPS_PROXY` environment variable on your computer. This is more common with Windows computers.
44−
45−The result is that the request for `https://github.com/elm/compiler/releases/download/0.19.1/binary-for-windows-64-bit.gz` is being sent to a "proxy server" where they monitor traffic. Maybe they rule out certain domains, maybe they check data when it comes back from the actual URL, etc.
46−
47−It is probably best to ask someone about the situation on this, but you can test things out by temporarily using an alternate `HTTPS_PROXY` value with something like this:
48−
49−```
50−# Mac and Linux
51−HTTPS_PROXY=http://proxy.example.com npm install -g elm
52−
53−# Windows
54−set HTTPS_PROXY=http://proxy.example.com
55−npm install -g elm
56−```
57−
58−Check out [this document](https://www.npmjs.com/package/request#controlling-proxy-behaviour-using-environment-variables) for more information on how environment variables like `NO_PROXY`, `HTTP_PROXY`, and `HTTPS_PROXY` are handled by the npm.
59−
60−<br/>
61−
62−
63−## Do you know what a `PATH` variable is?
64−
65−When you run a command like `elm make src/Main.elm`, your computer starts by trying to find a file called `elm`.
66−
67−The `PATH` is a list of directories to search within. On Mac and Linux, you can see these directories by running:
68−
69−```
70−$ echo $PATH
71−/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/local/git/bin
72−```
73−
74−The are separated by `:` for some reason. So running `elm make src/Main.elm` starts by searching the `PATH` for files named `elm`. On my computer, it finds `/usr/local/bin/elm` and then can actually run the command.
75−
76−Is `elm` in one of the directories listed in your `PATH` variable? I recommend asking for help if you are in this scenario and unsure how to proceed.
installers/win/Nsisfile.nsi+15−15
@@ -75,7 +75,7 @@ Function un.onInit
75FunctionEnd
75FunctionEnd
76
76
77Function LaunchLink
77Function LaunchLink
78− ExecShell "open" "https://guide.elm-lang.org"
78+ ExecShell "open" "https://elm-lang.org/get-started"
79FunctionEnd
79FunctionEnd
80
80
81;--------------------------------
81;--------------------------------
@@ -135,20 +135,20 @@ SectionEnd
135
135
136SectionGroup "Update system settings" SecGr
136SectionGroup "Update system settings" SecGr
137
137
138−;Section "Associate with .elm files" SecAssoc
138+Section "Associate with .elm files" SecAssoc
139−;
139+
140−; SectionIn 1
140+ SectionIn 1
141−;
141+
142−; ; File associations
142+ ; File associations
143−; WriteRegStr HKCR ".elm" "" "elm"
143+ WriteRegStr HKCR ".elm" "" "elm"
144−; WriteRegStr HKCR "elm" "" "Elm Source File"
144+ WriteRegStr HKCR "elm" "" "Elm Source File"
145−; WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"
145+ WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"
146−; WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'
146+ ;WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'
147−;
147+
148−; ;Remember that we registered associations
148+ ;Remember that we registered associations
149−; WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1
149+ WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1
150−;
150+
151−;SectionEnd
151+SectionEnd
152
152
153Section "Update the PATH environment variable" SecPath
153Section "Update the PATH environment variable" SecPath
154
154
installers/win/README.md+3−18
@@ -1,24 +1,9 @@
1−# Installing on Windows
2−
3−The installer for Windows is available [here](https://guide.elm-lang.org/install.html).
4−
5−
6−<br/>
7−
8−## Uninstall
9−
10−First run the `C:\Program Files (x86)\Elm\0.19\uninstall.exe` file. This will remove Elm stuff from your `PATH`.
11−
12−Then remove the whole `C:\Users\<username>\AppData\Roaming\elm` directory. Elm caches some packages and build artifacts to reduce compile times and to help you work offline. Getting rid of this directory will clear that information out!
13−
14−<br/>
15−
16−## Building the Windows installer
1+# Building Windows installer
17
2
18You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.
3You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.
19
4
20Once everything is installed, run something like this command:
5Once everything is installed, run something like this command:
21
6
22− make_installer.cmd 0.19.0
7+ make_installer.cmd 0.19
23
8
24−It will build an installer called `Elm-0.19.0-setup.exe`.
9+It will build an installer called `Elm-0.19-setup.exe`.
installers/win/file.iconew file

Binary file not shown.

installers/win/inst.dat+2−1
@@ -2,5 +2,6 @@ SetOutPath "$INSTDIR\bin"
2File "${FILES_SOURCE_PATH}\bin\elm.exe"
2File "${FILES_SOURCE_PATH}\bin\elm.exe"
3
3
4SetOutPath "$INSTDIR"
4SetOutPath "$INSTDIR"
5+File "file.ico"
5File "updatepath.vbs"
6File "updatepath.vbs"
6−File "removefrompath.vbs"
7+File "removefrompath.vbs"
installers/win/logo.ico

Binary file not shown.

installers/win/uninst.dat+2−1
@@ -1,6 +1,7 @@
1Delete "$INSTDIR\bin\elm.exe"
1Delete "$INSTDIR\bin\elm.exe"
2RmDir "$INSTDIR\bin"
2RmDir "$INSTDIR\bin"
3
3
4+Delete "$INSTDIR\file.ico"
4Delete "$INSTDIR\updatepath.vbs"
5Delete "$INSTDIR\updatepath.vbs"
5Delete "$INSTDIR\removefrompath.vbs"
6Delete "$INSTDIR\removefrompath.vbs"
6−RmDir "$INSTDIR"
7+RmDir "$INSTDIR"
installers/win/welcome.bmp

Binary file not shown.

roadmap.mddeleted−29
@@ -1,29 +0,0 @@
1−# Roadmap
2−
3−If you like what you see now, that's pretty much what Elm is going to be for a while.
4−
5−I'm currently doing some exploratory work with compiler techniques and targets, but it is still too early to tell which parts of that might work out. I know many readers take "exploring X" as a promise that "X will definitely happen", so I want to be careful in setting expectations low since there is still so much uncertainty in the work. So while there is no real news to share at this point, I can give some expectations about future stability of Elm:
6−
7−**If this exploratory work goes well**, even in the wildest version of success, I wouldn't expect the language or core packages to change very much. Maybe two or three years down the line it could reveal something that'd be good to fix up, but I don't really foresee notable changes right now.
8−
9−**If this exploratory work does not work out**, I have some more conservative projects that are good ideas that I want to circle back to at some point. Things like:
10−
11−- add a constrained type variable `eq` to get rid of the runtime error for `(==)` on functions
12−- try to integrate `elm test` so it can run only tests that changed
13−- try to get `elm format` using the latest parsing infrastructure so it's not a perf bottleneck during development anymore
14−- do another round on perf because I have one last idea that can squeeze out a bit more speed
15−
16−These are all nice quality of life things, but with 0.19.0 and 0.19.1 taking so long, I got pretty burnt out on "incremental improvements that are good ideas, but take a very long time and aren't very exciting to non-Elm users." Without getting too into the details, I really needed to change things up before returning to these particular ideas.
17−
18−If someone has a security issue from the compiler or core libraries, please DM me about it on the Elm Slack. Outside of security issues, I think capacity for more discretionary changes will increase once the lessons from the compiler explorations become more clear. Hopefully the discussion [here](https://discourse.elm-lang.org/t/costs-funding-in-open-source-languages/5722) clarifies the thinking on these capacity questions a bit.
19−
20−<br>
21−<br>
22−
23−**Taking a step back**, I have found that working in this looser style has produced a high baseline of quality, and I think that is an important part of Elm. For example, all the error message work in Elm began as a project to implement the `--report=json` flag. That work happened to reveal some cool ideas on improving error messages, and if I had been using a rigid roadmap, I might have skipped those ideas to meet the publicly-stated arbitrary deadline. We'd have a clearer roadmap, but error messages no different than other type-inferred languages.
24−
25−So I think having more flexibility in planning is a competitive advantage for Elm in certain ways, but it is obviously a trade off that does not work for everyone. If someone needs more certainty, I generally recommend looking into other languages to see if they have a balance that works better for their needs. For example, languages made by big corporations are generally "less risky" on things like this, but I think you see the fruits of that kind of process in the design decisions as well. Trade offs!
26−
27−Anyway, like I said at the beginning, if you like what you see now, that's what it's going to be for a while. Even in the best case scenario with my current explorations!
28−
29−I hope this is helpful information, and I hope you have a good experience with Elm, even if you ultimately find a different language that works better for you!
terminal/src/Develop.hs+2−5
@@ -159,9 +159,9 @@ compile path =
159 Just root ->
159 Just root ->
160 BW.withScope $ \scope -> Stuff.withRootLock root $ Task.run $
160 BW.withScope $ \scope -> Stuff.withRootLock root $ Task.run $
161 do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
161 do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
162− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])
162+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromMains Reporting.silent root details (NE.List path [])
163 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts
163 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts
164− let (NE.List name _) = Build.getRootNames artifacts
164+ let (NE.List name _) = Build.getMainNames artifacts
165 return $ Html.sandwich name javascript
165 return $ Html.sandwich name javascript
166
166
167
167
@@ -218,7 +218,6 @@ mimeTypeDict =
218 , ".m3u" ==> "audio/x-mpegurl"
218 , ".m3u" ==> "audio/x-mpegurl"
219 , ".mov" ==> "video/quicktime"
219 , ".mov" ==> "video/quicktime"
220 , ".mp3" ==> "audio/mpeg"
220 , ".mp3" ==> "audio/mpeg"
221− , ".mp4" ==> "video/mp4"
222 , ".mpeg" ==> "video/mpeg"
221 , ".mpeg" ==> "video/mpeg"
223 , ".mpg" ==> "video/mpeg"
222 , ".mpg" ==> "video/mpeg"
224 , ".ogg" ==> "application/ogg"
223 , ".ogg" ==> "application/ogg"
@@ -242,8 +241,6 @@ mimeTypeDict =
242 , ".txt" ==> "text/plain"
241 , ".txt" ==> "text/plain"
243 , ".wav" ==> "audio/x-wav"
242 , ".wav" ==> "audio/x-wav"
244 , ".wax" ==> "audio/x-ms-wax"
243 , ".wax" ==> "audio/x-ms-wax"
245− , ".webm" ==> "video/webm"
246− , ".webp" ==> "image/webp"
247 , ".wma" ==> "audio/x-ms-wma"
244 , ".wma" ==> "audio/x-ms-wma"
248 , ".wmv" ==> "video/x-ms-wmv"
245 , ".wmv" ==> "video/x-ms-wmv"
249 , ".woff" ==> "font/woff"
246 , ".woff" ==> "font/woff"
terminal/src/Develop/StaticFiles/Build.hs+3−3
@@ -42,13 +42,13 @@ buildReactorFrontEnd =
42 do root <- Dir.getCurrentDirectory
42 do root <- Dir.getCurrentDirectory
43 runTaskUnsafe $
43 runTaskUnsafe $
44 do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
44 do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
45− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details paths
45+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromMains Reporting.silent root details mains
46 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts
46 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts
47 return (LBS.toStrict (B.toLazyByteString javascript))
47 return (LBS.toStrict (B.toLazyByteString javascript))
48
48
49
49
50−paths :: NE.List FilePath
50+mains :: NE.List FilePath
51−paths =
51+mains =
52 NE.List
52 NE.List
53 ("src" </> "NotFound.elm")
53 ("src" </> "NotFound.elm")
54 [ "src" </> "Errors.elm"
54 [ "src" </> "Errors.elm"
terminal/src/Init.hs+1−1
@@ -90,7 +90,7 @@ init =
90 in
90 in
91 do Dir.createDirectoryIfMissing True "src"
91 do Dir.createDirectoryIfMissing True "src"
92 Outline.write "." $ Outline.App $
92 Outline.write "." $ Outline.App $
93− Outline.AppOutline V.compiler (NE.List (Outline.RelativeSrcDir "src") []) directs indirects Map.empty Map.empty
93+ Outline.AppOutline V.compiler (NE.List "src" []) directs indirects Map.empty Map.empty
94 putStrLn "Okay, I created it. Now read that link!"
94 putStrLn "Okay, I created it. Now read that link!"
95 return (Right ())
95 return (Right ())
96
96
terminal/src/Main.hs+20−20
@@ -12,8 +12,8 @@ import Text.PrettyPrint.ANSI.Leijen ((<>))
12import Text.Read (readMaybe)
12import Text.Read (readMaybe)
13
13
14import qualified Elm.Version as V
14import qualified Elm.Version as V
15−import Terminal
15+import Terminal.Args
16−import Terminal.Helpers
16+import Terminal.Args.Helpers
17
17
18import qualified Bump
18import qualified Bump
19import qualified Develop
19import qualified Develop
@@ -31,7 +31,7 @@ import qualified Repl
31
31
32main :: IO ()
32main :: IO ()
33main =
33main =
34− Terminal.app intro outro
34+ complex intro outro
35 [ repl
35 [ repl
36 , init
36 , init
37 , reactor
37 , reactor
@@ -72,7 +72,7 @@ outro =
72-- INIT
72-- INIT
73
73
74
74
75−init :: Terminal.Command
75+init :: Interface
76init =
76init =
77 let
77 let
78 summary =
78 summary =
@@ -87,14 +87,14 @@ init =
87 "It will ask permission to create an elm.json file, the one thing common\
87 "It will ask permission to create an elm.json file, the one thing common\
88 \ to all Elm projects. It also provides a link explaining what to do from there."
88 \ to all Elm projects. It also provides a link explaining what to do from there."
89 in
89 in
90− Terminal.Command "init" (Common summary) details example noArgs noFlags Init.run
90+ Interface "init" (Common summary) details example noArgs noFlags Init.run
91
91
92
92
93
93
94-- REPL
94-- REPL
95
95
96
96
97−repl :: Terminal.Command
97+repl :: Interface
98repl =
98repl =
99 let
99 let
100 summary =
100 summary =
@@ -115,7 +115,7 @@ repl =
115 |-- flag "interpreter" interpreter "Path to a alternate JS interpreter, like node or nodejs."
115 |-- flag "interpreter" interpreter "Path to a alternate JS interpreter, like node or nodejs."
116 |-- onOff "no-colors" "Turn off the colors in the REPL. This can help if you are having trouble reading the values. Some terminals use a custom color scheme that diverges significantly from the standard ANSI colors, so another path may be to pick a more standard color scheme."
116 |-- onOff "no-colors" "Turn off the colors in the REPL. This can help if you are having trouble reading the values. Some terminals use a custom color scheme that diverges significantly from the standard ANSI colors, so another path may be to pick a more standard color scheme."
117 in
117 in
118− Terminal.Command "repl" (Common summary) details example noArgs replFlags Repl.run
118+ Interface "repl" (Common summary) details example noArgs replFlags Repl.run
119
119
120
120
121interpreter :: Parser String
121interpreter :: Parser String
@@ -133,7 +133,7 @@ interpreter =
133-- REACTOR
133-- REACTOR
134
134
135
135
136−reactor :: Terminal.Command
136+reactor :: Interface
137reactor =
137reactor =
138 let
138 let
139 summary =
139 summary =
@@ -154,7 +154,7 @@ reactor =
154 flags Develop.Flags
154 flags Develop.Flags
155 |-- flag "port" port_ "The port of the server (default: 8000)"
155 |-- flag "port" port_ "The port of the server (default: 8000)"
156 in
156 in
157− Terminal.Command "reactor" (Common summary) details example noArgs reactorFlags Develop.run
157+ Interface "reactor" (Common summary) details example noArgs reactorFlags Develop.run
158
158
159
159
160port_ :: Parser Int
160port_ :: Parser Int
@@ -172,7 +172,7 @@ port_ =
172-- MAKE
172-- MAKE
173
173
174
174
175−make :: Terminal.Command
175+make :: Interface
176make =
176make =
177 let
177 let
178 details =
178 details =
@@ -196,14 +196,14 @@ make =
196 |-- flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!"
196 |-- flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!"
197 |-- flag "docs" Make.docsFile "Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly."
197 |-- flag "docs" Make.docsFile "Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly."
198 in
198 in
199− Terminal.Command "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run
199+ Interface "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run
200
200
201
201
202
202
203-- INSTALL
203-- INSTALL
204
204
205
205
206−install :: Terminal.Command
206+install :: Interface
207install =
207install =
208 let
208 let
209 details =
209 details =
@@ -232,14 +232,14 @@ install =
232 , require1 Install.Install package
232 , require1 Install.Install package
233 ]
233 ]
234 in
234 in
235− Terminal.Command "install" Uncommon details example installArgs noFlags Install.run
235+ Interface "install" Uncommon details example installArgs noFlags Install.run
236
236
237
237
238
238
239-- PUBLISH
239-- PUBLISH
240
240
241
241
242−publish :: Terminal.Command
242+publish :: Interface
243publish =
243publish =
244 let
244 let
245 details =
245 details =
@@ -266,17 +266,17 @@ publish =
266 \ it ends up as an experiment on GitHub only. Point is, try to be\
266 \ it ends up as an experiment on GitHub only. Point is, try to be\
267 \ respectful of the community and package ecosystem!"
267 \ respectful of the community and package ecosystem!"
268 , reflow
268 , reflow
269− "Check out <https://package.elm-lang.org/help/design-guidelines> for guidance on how to create great packages!"
269+ "Check out https://package.elm-lang.org/help/design-guidelines for guidance on how to create great packages!"
270 ]
270 ]
271 in
271 in
272− Terminal.Command "publish" Uncommon details example noArgs noFlags Publish.run
272+ Interface "publish" Uncommon details example noArgs noFlags Publish.run
273
273
274
274
275
275
276-- BUMP
276-- BUMP
277
277
278
278
279−bump :: Terminal.Command
279+bump :: Interface
280bump =
280bump =
281 let
281 let
282 details =
282 details =
@@ -289,14 +289,14 @@ bump =
289 \ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\
289 \ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\
290 \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!"
290 \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!"
291 in
291 in
292− Terminal.Command "bump" Uncommon details example noArgs noFlags Bump.run
292+ Interface "bump" Uncommon details example noArgs noFlags Bump.run
293
293
294
294
295
295
296-- DIFF
296-- DIFF
297
297
298
298
299−diff :: Terminal.Command
299+diff :: Interface
300diff =
300diff =
301 let
301 let
302 details =
302 details =
@@ -321,7 +321,7 @@ diff =
321 , require3 Diff.GlobalInquiry package version version
321 , require3 Diff.GlobalInquiry package version version
322 ]
322 ]
323 in
323 in
324− Terminal.Command "diff" Uncommon details example diffArgs noFlags Diff.run
324+ Interface "diff" Uncommon details example diffArgs noFlags Diff.run
325
325
326
326
327
327
terminal/src/Make.hs+16−16
@@ -29,7 +29,7 @@ import qualified Reporting
29import qualified Reporting.Exit as Exit
29import qualified Reporting.Exit as Exit
30import qualified Reporting.Task as Task
30import qualified Reporting.Task as Task
31import qualified Stuff
31import qualified Stuff
32−import Terminal (Parser(..))
32+import Terminal.Args (Parser(..))
33
33
34
34
35
35
@@ -107,7 +107,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
107 case getNoMains artifacts of
107 case getNoMains artifacts of
108 [] ->
108 [] ->
109 do builder <- toBuilder root details desiredMode artifacts
109 do builder <- toBuilder root details desiredMode artifacts
110− generate style target builder (Build.getRootNames artifacts)
110+ generate style target builder (Build.getMainNames artifacts)
111
111
112 name:names ->
112 name:names ->
113 Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)
113 Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)
@@ -166,7 +166,7 @@ buildExposed style root details maybeDocs exposed =
166buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts
166buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts
167buildPaths style root details paths =
167buildPaths style root details paths =
168 Task.eio Exit.MakeCannotBuild $
168 Task.eio Exit.MakeCannotBuild $
169− Build.fromPaths style root details paths
169+ Build.fromMains style root details paths
170
170
171
171
172
172
@@ -174,13 +174,13 @@ buildPaths style root details paths =
174
174
175
175
176getMains :: Build.Artifacts -> [ModuleName.Raw]
176getMains :: Build.Artifacts -> [ModuleName.Raw]
177−getMains (Build.Artifacts _ _ roots modules) =
177+getMains (Build.Artifacts _ _ mains modules) =
178− Maybe.mapMaybe (getMain modules) (NE.toList roots)
178+ Maybe.mapMaybe (getMain modules) (NE.toList mains)
179
179
180
180
181−getMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw
181+getMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw
182−getMain modules root =
182+getMain modules main =
183− case root of
183+ case main of
184 Build.Inside name ->
184 Build.Inside name ->
185 if any (isMain name) modules
185 if any (isMain name) modules
186 then Just name
186 then Just name
@@ -207,9 +207,9 @@ isMain targetName modul =
207
207
208
208
209hasOneMain :: Build.Artifacts -> Task ModuleName.Raw
209hasOneMain :: Build.Artifacts -> Task ModuleName.Raw
210−hasOneMain (Build.Artifacts _ _ roots modules) =
210+hasOneMain (Build.Artifacts _ _ mains modules) =
211− case roots of
211+ case mains of
212− NE.List root [] -> Task.mio Exit.MakeNoMain (return $ getMain modules root)
212+ NE.List main [] -> Task.mio Exit.MakeNoMain (return $ getMain modules main)
213 NE.List _ (_:_) -> Task.throw Exit.MakeMultipleFilesIntoHtml
213 NE.List _ (_:_) -> Task.throw Exit.MakeMultipleFilesIntoHtml
214
214
215
215
@@ -218,13 +218,13 @@ hasOneMain (Build.Artifacts _ _ roots modules) =
218
218
219
219
220getNoMains :: Build.Artifacts -> [ModuleName.Raw]
220getNoMains :: Build.Artifacts -> [ModuleName.Raw]
221−getNoMains (Build.Artifacts _ _ roots modules) =
221+getNoMains (Build.Artifacts _ _ mains modules) =
222− Maybe.mapMaybe (getNoMain modules) (NE.toList roots)
222+ Maybe.mapMaybe (getNoMain modules) (NE.toList mains)
223
223
224
224
225−getNoMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw
225+getNoMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw
226−getNoMain modules root =
226+getNoMain modules main =
227− case root of
227+ case main of
228 Build.Inside name ->
228 Build.Inside name ->
229 if any (isMain name) modules
229 if any (isMain name) modules
230 then Nothing
230 then Nothing
terminal/src/Publish.hs+5
@@ -380,6 +380,11 @@ verifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.Kno
380
380
381register :: Http.Manager -> Pkg.Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish ()
381register :: Http.Manager -> Pkg.Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish ()
382register manager pkg vsn docs commitHash sha =
382register manager pkg vsn docs commitHash sha =
383+ if True then
384+ Task.io $ putStrLn $
385+ "Publishing is disabled in the 0.19.1-alpha-4 release.\n\
386+ \Publish with 0.19.0 for now.\n"
387+ else
383 let
388 let
384 url =
389 url =
385 Website.route "/register"
390 Website.route "/register"
terminal/src/Repl.hs+3−30
@@ -3,16 +3,6 @@
3module Repl
3module Repl
4 ( Flags(..)
4 ( Flags(..)
5 , run
5 , run
6− --
7− , Lines(..)
8− , Input(..)
9− , Prefill(..)
10− , CategorizedInput(..)
11− , categorize
12− --
13− , State(..)
14− , Output(..)
15− , toByteString
16 )
6 )
17 where
7 where
18
8
@@ -179,9 +169,9 @@ read =
179 Nothing ->
169 Nothing ->
180 return Exit
170 return Exit
181
171
182− Just chars ->
172+ Just line ->
183 let
173 let
184− lines = Lines (stripLegacyBackslash chars) []
174+ lines = Lines line []
185 in
175 in
186 case categorize lines of
176 case categorize lines of
187 Done input -> return input
177 Done input -> return input
@@ -197,30 +187,13 @@ readMore previousLines prefill =
197
187
198 Just chars ->
188 Just chars ->
199 let
189 let
200− lines = addLine (stripLegacyBackslash chars) previousLines
190+ lines = addLine chars previousLines
201 in
191 in
202 case categorize lines of
192 case categorize lines of
203 Done input -> return input
193 Done input -> return input
204 Continue p -> readMore lines p
194 Continue p -> readMore lines p
205
195
206
196
207−-- For compatibility with 0.19.0 such that readers of "Programming Elm" by @jfairbank
208−-- can get through the REPL section successfully.
209−--
210−-- TODO: remove stripLegacyBackslash in next MAJOR release
211−--
212−stripLegacyBackslash :: [Char] -> [Char]
213−stripLegacyBackslash chars =
214− case chars of
215− [] ->
216− []
217−
218− _:_ ->
219− if last chars == '\\'
220− then init chars
221− else chars
222−
223−
224data Prefill
197data Prefill
225 = Indent
198 = Indent
226 | DefStart N.Name
199 | DefStart N.Name
terminal/impl/Terminal.hs → terminal/src/Terminal/Args.hsrenamed+27−30
@@ -1,7 +1,8 @@
1−module Terminal
1+module Terminal.Args
2− ( app
2+ ( simple
3− , Command(..)
3+ , Interface(..)
4 , Summary(..)
4 , Summary(..)
5+ , complex
5 , Flags, noFlags, flags, (|--)
6 , Flags, noFlags, flags, (|--)
6 , Flag, flag, onOff
7 , Flag, flag, onOff
7 , Parser(..)
8 , Parser(..)
@@ -25,22 +26,22 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P
25import qualified Text.Read as Read
26import qualified Text.Read as Read
26
27
27import qualified Elm.Version as V
28import qualified Elm.Version as V
28−import Terminal.Internal
29+import Terminal.Args.Internal
29−import qualified Terminal.Chomp as Chomp
30+import qualified Terminal.Args.Chomp as Chomp
30−import qualified Terminal.Error as Error
31+import qualified Terminal.Args.Error as Error
31
32
32
33
33
34
34−-- COMMAND
35+-- GET
35
36
36
37
37−_command :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()
38+simple :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()
38−_command details example args_ flags_ callback =
39+simple details example args_ flags_ callback =
39 do setLocaleEncoding utf8
40 do setLocaleEncoding utf8
40 argStrings <- Env.getArgs
41 argStrings <- Env.getArgs
41 case argStrings of
42 case argStrings of
42 ["--version"] ->
43 ["--version"] ->
43− do hPutStrLn stdout (V.toChars V.compiler)
44+ do hPutStrLn stdout (V.toChars V.compiler ++ "-alpha-4")
44 Exit.exitSuccess
45 Exit.exitSuccess
45
46
46 chunks ->
47 chunks ->
@@ -56,38 +57,34 @@ _command details example args_ flags_ callback =
56 Error.exitWithError err
57 Error.exitWithError err
57
58
58
59
59−
60−-- APP
61−
62−
63−app :: P.Doc -> P.Doc -> [Command] -> IO ()
60+complex :: P.Doc -> P.Doc -> [Interface] -> IO ()
64−app intro outro commands =
61+complex intro outro interfaces =
65 do setLocaleEncoding utf8
62 do setLocaleEncoding utf8
66 argStrings <- Env.getArgs
63 argStrings <- Env.getArgs
67 case argStrings of
64 case argStrings of
68 [] ->
65 [] ->
69− Error.exitWithOverview intro outro commands
66+ Error.exitWithOverview intro outro interfaces
70
67
71 ["--help"] ->
68 ["--help"] ->
72− Error.exitWithOverview intro outro commands
69+ Error.exitWithOverview intro outro interfaces
73
70
74 ["--version"] ->
71 ["--version"] ->
75− do hPutStrLn stdout (V.toChars V.compiler)
72+ do hPutStrLn stdout (V.toChars V.compiler ++ "-alpha-4")
76 Exit.exitSuccess
73 Exit.exitSuccess
77
74
78 command : chunks ->
75 command : chunks ->
79− do case List.find (\cmd -> toName cmd == command) commands of
76+ do case List.find (\iface -> toName iface == command) interfaces of
80 Nothing ->
77 Nothing ->
81− Error.exitWithUnknown command (map toName commands)
78+ Error.exitWithUnknown command (map toName interfaces)
82
79
83− Just (Command _ _ details example args_ flags_ callback) ->
80+ Just (Interface _ _ details example args_ flags_ callback) ->
84 if elem "--help" chunks then
81 if elem "--help" chunks then
85 Error.exitWithHelp (Just command) details example args_ flags_
82 Error.exitWithHelp (Just command) details example args_ flags_
86
83
87 else
84 else
88 case snd $ Chomp.chomp Nothing chunks args_ flags_ of
85 case snd $ Chomp.chomp Nothing chunks args_ flags_ of
89− Right (argsValue, flagsValue) ->
86+ Right (argsValue, flagValue) ->
90− callback argsValue flagsValue
87+ callback argsValue flagValue
91
88
92 Left err ->
89 Left err ->
93 Error.exitWithError err
90 Error.exitWithError err
@@ -162,21 +159,21 @@ findIndex index point chunks =
162 findIndex (index + 1) point cs
159 findIndex (index + 1) point cs
163
160
164
161
165−_complexSuggest :: [Command] -> Int -> [String] -> IO [String]
162+_complexSuggest :: [Interface] -> Int -> [String] -> IO [String]
166−_complexSuggest commands index strings =
163+_complexSuggest interfaces index strings =
167 case strings of
164 case strings of
168 [] ->
165 [] ->
169− return (map toName commands)
166+ return (map toName interfaces)
170
167
171 command : chunks ->
168 command : chunks ->
172 if index == 1 then
169 if index == 1 then
173− return (filter (List.isPrefixOf command) (map toName commands))
170+ return (filter (List.isPrefixOf command) (map toName interfaces))
174 else
171 else
175− case List.find (\cmd -> toName cmd == command) commands of
172+ case List.find (\iface -> toName iface == command) interfaces of
176 Nothing ->
173 Nothing ->
177 return []
174 return []
178
175
179− Just (Command _ _ _ _ args_ flags_ _) ->
176+ Just (Interface _ _ _ _ args_ flags_ _) ->
180 fst $ Chomp.chomp (Just (index-1)) chunks args_ flags_
177 fst $ Chomp.chomp (Just (index-1)) chunks args_ flags_
181
178
182
179
terminal/impl/Terminal/Chomp.hs → terminal/src/Terminal/Args/Chomp.hsrenamed+5−4
@@ -1,5 +1,6 @@
1−{-# LANGUAGE GADTs, Rank2Types #-}
1+{-# LANGUAGE GADTs #-}
2+{-# LANGUAGE Rank2Types #-}
2−module Terminal.Chomp
3+module Terminal.Args.Chomp
3 ( chomp
4 ( chomp
4 )
5 )
5 where
6 where
@@ -7,8 +8,8 @@ module Terminal.Chomp
7
8
8import qualified Data.List as List
9import qualified Data.List as List
9
10
10−import Terminal.Error
11+import Terminal.Args.Error
11−import Terminal.Internal
12+import Terminal.Args.Internal
12
13
13
14
14
15
terminal/impl/Terminal/Error.hs → terminal/src/Terminal/Args/Error.hsrenamed+13−12
@@ -1,5 +1,6 @@
1+{-# LANGUAGE GADTs #-}
1−{-# LANGUAGE GADTs, OverloadedStrings #-}
2+{-# LANGUAGE OverloadedStrings #-}
2−module Terminal.Error
3+module Terminal.Args.Error
3 ( Error(..)
4 ( Error(..)
4 , ArgError(..)
5 , ArgError(..)
5 , FlagError(..)
6 , FlagError(..)
@@ -23,7 +24,7 @@ import System.IO (hPutStrLn, stderr)
23import qualified Text.PrettyPrint.ANSI.Leijen as P
24import qualified Text.PrettyPrint.ANSI.Leijen as P
24
25
25import Reporting.Suggest as Suggest
26import Reporting.Suggest as Suggest
26−import Terminal.Internal
27+import Terminal.Args.Internal
27
28
28
29
29
30
@@ -186,22 +187,22 @@ flagsToDocs flags docs =
186-- OVERVIEW
187-- OVERVIEW
187
188
188
189
189−exitWithOverview :: P.Doc -> P.Doc -> [Command] -> IO a
190+exitWithOverview :: P.Doc -> P.Doc -> [Interface] -> IO a
190−exitWithOverview intro outro commands =
191+exitWithOverview intro outro interfaces =
191 do exeName <- getExeName
192 do exeName <- getExeName
192 exitSuccess
193 exitSuccess
193 [ intro
194 [ intro
194 , "The most common commands are:"
195 , "The most common commands are:"
195− , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) commands
196+ , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) interfaces
196 , "There are a bunch of other commands as well though. Here is a full list:"
197 , "There are a bunch of other commands as well though. Here is a full list:"
197− , P.indent 4 $ P.dullcyan $ toCommandList exeName commands
198+ , P.indent 4 $ P.dullcyan $ toCommandList exeName interfaces
198 , "Adding the --help flag gives a bunch of additional details about each one."
199 , "Adding the --help flag gives a bunch of additional details about each one."
199 , outro
200 , outro
200 ]
201 ]
201
202
202
203
203−toSummary :: String -> Command -> Maybe P.Doc
204+toSummary :: String -> Interface -> Maybe P.Doc
204−toSummary exeName (Command name summary _ _ (Args args) _ _) =
205+toSummary exeName (Interface name summary _ _ (Args args) _ _) =
205 case summary of
206 case summary of
206 Uncommon ->
207 Uncommon ->
207 Nothing
208 Nothing
@@ -214,10 +215,10 @@ toSummary exeName (Command name summary _ _ (Args args) _ _) =
214 ]
215 ]
215
216
216
217
217−toCommandList :: String -> [Command] -> P.Doc
218+toCommandList :: String -> [Interface] -> P.Doc
218−toCommandList exeName commands =
219+toCommandList exeName interfaces =
219 let
220 let
220− names = map toName commands
221+ names = map toName interfaces
221 width = maximum (map length names)
222 width = maximum (map length names)
222
223
223 toExample name =
224 toExample name =
terminal/impl/Terminal/Helpers.hs → terminal/src/Terminal/Args/Helpers.hsrenamed+2−2
@@ -1,5 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−module Terminal.Helpers
2+module Terminal.Args.Helpers
3 ( version
3 ( version
4 , elmFile
4 , elmFile
5 , package
5 , package
@@ -14,7 +14,7 @@ import qualified Data.Map as Map
14import qualified Data.Utf8 as Utf8
14import qualified Data.Utf8 as Utf8
15import qualified System.FilePath as FP
15import qualified System.FilePath as FP
16
16
17−import Terminal (Parser(..))
17+import Terminal.Args (Parser(..))
18import qualified Deps.Registry as Registry
18import qualified Deps.Registry as Registry
19import qualified Elm.Package as Pkg
19import qualified Elm.Package as Pkg
20import qualified Elm.Version as V
20import qualified Elm.Version as V
terminal/impl/Terminal/Internal.hs → terminal/src/Terminal/Args/Internal.hsrenamed+8−8
@@ -1,6 +1,6 @@
1{-# LANGUAGE GADTs #-}
1{-# LANGUAGE GADTs #-}
2−module Terminal.Internal
2+module Terminal.Args.Internal
3− ( Command(..)
3+ ( Interface(..)
4 , toName
4 , toName
5 , Summary(..)
5 , Summary(..)
6 , Flags(..)
6 , Flags(..)
@@ -17,11 +17,11 @@ import Text.PrettyPrint.ANSI.Leijen (Doc)
17
17
18
18
19
19
20−-- COMMAND
20+-- INTERFACE
21
21
22
22
23−data Command where
23+data Interface where
24− Command
24+ Interface
25 :: String
25 :: String
26 -> Summary
26 -> Summary
27 -> String
27 -> String
@@ -29,11 +29,11 @@ data Command where
29 -> Args args
29 -> Args args
30 -> Flags flags
30 -> Flags flags
31 -> (args -> flags -> IO ())
31 -> (args -> flags -> IO ())
32− -> Command
32+ -> Interface
33
33
34
34
35−toName :: Command -> String
35+toName :: Interface -> String
36−toName (Command name _ _ _ _ _ _) =
36+toName (Interface name _ _ _ _ _ _) =
37 name
37 name
38
38
39
39
docs/upgrade-instructions/0.16.md → upgrade-docs/0.16.mdrenamed

The content is the same.

docs/upgrade-instructions/0.17.md → upgrade-docs/0.17.mdrenamed

The content is the same.

docs/upgrade-instructions/0.18.md → upgrade-docs/0.18.mdrenamed

The content is the same.

docs/upgrade-instructions/0.19.0.md → upgrade-docs/0.19.mdrenamed

The content is the same.

docs/upgrade-instructions/earlier.md → upgrade-docs/earlier.mdrenamed

The content is the same.

worker/elm.cabal−13
@@ -43,18 +43,11 @@ Executable worker
43 src
43 src
44 ../compiler/src
44 ../compiler/src
45 ../builder/src
45 ../builder/src
46− ../terminal/src
47
46
48 Main-Is:
47 Main-Is:
49 Main.hs
48 Main.hs
50
49
51 other-modules:
50 other-modules:
52− Artifacts
53− Cors
54− Endpoint.Compile
55− Endpoint.Quotes
56− Endpoint.Repl
57−
58 AST.Canonical
51 AST.Canonical
59 AST.Optimized
52 AST.Optimized
60 AST.Source
53 AST.Source
@@ -134,7 +127,6 @@ Executable worker
134 Parse.Type
127 Parse.Type
135 Parse.Variable
128 Parse.Variable
136 Paths_elm
129 Paths_elm
137− Repl
138 Reporting
130 Reporting
139 Reporting.Annotation
131 Reporting.Annotation
140 Reporting.Doc
132 Reporting.Doc
@@ -170,11 +162,9 @@ Executable worker
170 Type.UnionFind
162 Type.UnionFind
171
163
172 Build-depends:
164 Build-depends:
173− aeson,
174 ansi-terminal >= 0.8 && < 0.9,
165 ansi-terminal >= 0.8 && < 0.9,
175 ansi-wl-pprint >= 0.6.8 && < 0.7,
166 ansi-wl-pprint >= 0.6.8 && < 0.7,
176 base >=4.11 && <5,
167 base >=4.11 && <5,
177− base64-bytestring,
178 binary >= 0.8 && < 0.9,
168 binary >= 0.8 && < 0.9,
179 bytestring >= 0.9 && < 0.11,
169 bytestring >= 0.9 && < 0.11,
180 containers >= 0.5.8.2 && < 0.6,
170 containers >= 0.5.8.2 && < 0.6,
@@ -183,7 +173,6 @@ Executable worker
183 filelock,
173 filelock,
184 filepath >= 1 && < 2.0,
174 filepath >= 1 && < 2.0,
185 ghc-prim >= 0.5.2,
175 ghc-prim >= 0.5.2,
186− haskeline,
187 HTTP >= 4000.2.5 && < 4000.4,
176 HTTP >= 4000.2.5 && < 4000.4,
188 http-client >= 0.6 && < 0.7,
177 http-client >= 0.6 && < 0.7,
189 http-client-tls >= 0.3 && < 0.4,
178 http-client-tls >= 0.3 && < 0.4,
@@ -194,8 +183,6 @@ Executable worker
194 network >= 2.4 && < 2.7,
183 network >= 2.4 && < 2.7,
195 network-uri,
184 network-uri,
196 parsec,
185 parsec,
197− process,
198− random,
199 raw-strings-qq,
186 raw-strings-qq,
200 scientific,
187 scientific,
201 SHA,
188 SHA,
worker/elm.json+8−3
@@ -8,13 +8,18 @@
8 "direct": {
8 "direct": {
9 "elm/browser": "1.0.1",
9 "elm/browser": "1.0.1",
10 "elm/core": "1.0.2",
10 "elm/core": "1.0.2",
11+ "elm/file": "1.0.5",
11 "elm/html": "1.0.0",
12 "elm/html": "1.0.0",
13+ "elm/http": "2.0.0",
12 "elm/json": "1.1.3",
14 "elm/json": "1.1.3",
13− "elm/project-metadata-utils": "1.0.0"
15+ "elm/random": "1.0.0",
16+ "elm/svg": "1.0.1",
17+ "elm/time": "1.0.0",
18+ "elm-explorations/linear-algebra": "1.0.3",
19+ "elm-explorations/webgl": "1.1.0"
14 },
20 },
15 "indirect": {
21 "indirect": {
16− "elm/parser": "1.1.0",
22+ "elm/bytes": "1.0.8",
17− "elm/time": "1.0.0",
18 "elm/url": "1.0.0",
23 "elm/url": "1.0.0",
19 "elm/virtual-dom": "1.0.2"
24 "elm/virtual-dom": "1.0.2"
20 }
25 }
worker/outlines/compile/elm.jsondeleted−32
@@ -1,32 +0,0 @@
1−{
2− "type": "application",
3− "source-directories": [
4− "../../src"
5− ],
6− "elm-version": "0.19.1",
7− "dependencies": {
8− "direct": {
9− "elm/browser": "1.0.1",
10− "elm/core": "1.0.2",
11− "elm/file": "1.0.5",
12− "elm/html": "1.0.0",
13− "elm/http": "2.0.0",
14− "elm/json": "1.1.3",
15− "elm/random": "1.0.0",
16− "elm/svg": "1.0.1",
17− "elm/time": "1.0.0",
18− "elm-explorations/linear-algebra": "1.0.3",
19− "elm-explorations/webgl": "1.1.0",
20− "evancz/elm-playground": "1.0.2"
21− },
22− "indirect": {
23− "elm/bytes": "1.0.8",
24− "elm/url": "1.0.0",
25− "elm/virtual-dom": "1.0.2"
26− }
27− },
28− "test-dependencies": {
29− "direct": {},
30− "indirect": {}
31− }
32−}
worker/outlines/repl/elm.jsondeleted−19
@@ -1,19 +0,0 @@
1−{
2− "type": "application",
3− "source-directories": [
4− "../../src"
5− ],
6− "elm-version": "0.19.1",
7− "dependencies": {
8− "direct": {
9− "elm/core": "1.0.2"
10− },
11− "indirect": {
12− "elm/json": "1.1.3"
13− }
14− },
15− "test-dependencies": {
16− "direct": {},
17− "indirect": {}
18− }
19−}
worker/src/Artifacts.hsdeleted−155
@@ -1,155 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Artifacts
3− ( Artifacts(..)
4− , loadCompile
5− , loadRepl
6− , toDepsInfo
7− )
8− where
9−
10−
11−import Control.Concurrent (readMVar)
12−import Control.Monad (liftM2)
13−import qualified Data.ByteString as BS
14−import qualified Data.ByteString.Builder as B
15−import qualified Data.ByteString.Lazy as LBS
16−import qualified Data.Map as Map
17−import qualified Data.Name as N
18−import qualified Data.OneOrMore as OneOrMore
19−import qualified System.Directory as Dir
20−import System.FilePath ((</>))
21−
22−import qualified AST.Canonical as Can
23−import qualified AST.Optimized as Opt
24−import qualified BackgroundWriter as BW
25−import qualified Elm.Details as Details
26−import qualified Elm.Interface as I
27−import qualified Elm.ModuleName as ModuleName
28−import qualified Elm.Package as Pkg
29−import Json.Encode ((==>))
30−import qualified Json.Encode as E
31−import qualified Json.String as Json
32−import qualified Reporting
33−
34−
35−
36−-- ARTIFACTS
37−
38−
39−data Artifacts =
40− Artifacts
41− { _ifaces :: Map.Map ModuleName.Raw I.Interface
42− , _graph :: Opt.GlobalGraph
43− }
44−
45−
46−loadCompile :: IO Artifacts
47−loadCompile =
48− load ("outlines" </> "compile")
49−
50−
51−loadRepl :: IO Artifacts
52−loadRepl =
53− load ("outlines" </> "repl")
54−
55−
56−
57−-- LOAD
58−
59−
60−load :: FilePath -> IO Artifacts
61−load dir =
62− BW.withScope $ \scope ->
63− do putStrLn $ "Loading " ++ dir </> "elm.json"
64− style <- Reporting.terminal
65− root <- fmap (</> dir) Dir.getCurrentDirectory
66− result <- Details.load style scope root
67− case result of
68− Left _ ->
69− error $ "Ran into some problem loading elm.json\nTry running `elm make` in: " ++ dir
70−
71− Right details ->
72− do omvar <- Details.loadObjects root details
73− imvar <- Details.loadInterfaces root details
74− mdeps <- readMVar imvar
75− mobjs <- readMVar omvar
76− case liftM2 (,) mdeps mobjs of
77− Nothing ->
78− error $ "Ran into some weird problem loading elm.json\nTry running `elm make` in: " ++ dir
79−
80− Just (deps, objs) ->
81− return $ Artifacts (toInterfaces deps) objs
82−
83−
84−toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface
85−toInterfaces deps =
86− Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $
87− Map.elems (Map.mapMaybeWithKey getPublic deps)
88−
89−
90−getPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface)
91−getPublic (ModuleName.Canonical _ name) dep =
92− case dep of
93− I.Public iface -> Just (name, OneOrMore.one iface)
94− I.Private _ _ _ -> Nothing
95−
96−
97−toUnique :: OneOrMore.OneOrMore a -> Maybe a
98−toUnique oneOrMore =
99− case oneOrMore of
100− OneOrMore.One value -> Just value
101− OneOrMore.More _ _ -> Nothing
102−
103−
104−
105−-- TO DEPS INFO
106−
107−
108−toDepsInfo :: Artifacts -> BS.ByteString
109−toDepsInfo (Artifacts ifaces _) =
110− LBS.toStrict $ B.toLazyByteString $ E.encodeUgly $ encode ifaces
111−
112−
113−
114−-- ENCODE
115−
116−
117−encode :: Map.Map ModuleName.Raw I.Interface -> E.Value
118−encode ifaces =
119− E.dict Json.fromName encodeInterface ifaces
120−
121−
122−encodeInterface :: I.Interface -> E.Value
123−encodeInterface (I.Interface pkg values unions aliases binops) =
124− E.object
125− [ "pkg" ==> E.chars (Pkg.toChars pkg)
126− , "ops" ==> E.list E.name (Map.keys binops)
127− , "values" ==> E.list E.name (Map.keys values)
128− , "aliases" ==> E.list E.name (Map.keys (Map.filter isPublicAlias aliases))
129− , "types" ==> E.dict Json.fromName (E.list E.name) (Map.mapMaybe toPublicUnion unions)
130− ]
131−
132−
133−isPublicAlias :: I.Alias -> Bool
134−isPublicAlias alias =
135− case alias of
136− I.PublicAlias _ -> True
137− I.PrivateAlias _ -> False
138−
139−
140−toPublicUnion :: I.Union -> Maybe [N.Name]
141−toPublicUnion union =
142− case union of
143− I.OpenUnion (Can.Union _ variants _ _) ->
144− Just (map getVariantName variants)
145−
146− I.ClosedUnion _ ->
147− Just []
148−
149− I.PrivateUnion _ ->
150− Nothing
151−
152−
153−getVariantName :: Can.Ctor -> N.Name
154−getVariantName (Can.Ctor name _ _ _) =
155− name
worker/src/Cors.hsdeleted−48
@@ -1,48 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Cors
3− ( allow
4− )
5− where
6−
7−
8−import qualified Data.HashSet as HashSet
9−import Network.URI (parseURI)
10−import Snap.Core (Snap, Method, method)
11−import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins), applyCORS, mkOriginSet)
12−
13−
14−
15−-- ALLOW
16−
17−
18−allow :: Method -> [String] -> Snap () -> Snap ()
19−allow method_ origins snap =
20− applyCORS (toOptions method_ origins) $ method method_ $
21− snap
22−
23−
24−
25−-- TO OPTIONS
26−
27−
28−toOptions :: (Monad m) => Method -> [String] -> CORSOptions m
29−toOptions method_ origins =
30− let
31− allowedOrigins = toOriginList origins
32− allowedMethods = HashSet.singleton (HashableMethod method_)
33− in
34− CORSOptions
35− { corsAllowOrigin = return allowedOrigins
36− , corsAllowCredentials = return True
37− , corsExposeHeaders = return HashSet.empty
38− , corsAllowedMethods = return allowedMethods
39− , corsAllowedHeaders = return
40− }
41−
42−
43−toOriginList :: [String] -> OriginList
44−toOriginList origins =
45− Origins $ mkOriginSet $
46− case traverse parseURI origins of
47− Just uris -> uris
48− Nothing -> error "invalid entry given to toOriginList list"
worker/src/Endpoint/Compile.hsdeleted−323
@@ -1,323 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
3−module Endpoint.Compile
4− ( endpoint_V1
5− , endpoint_V2
6− , loadErrorJS
7− )
8− where
9−
10−
11−import qualified Data.ByteString as B
12−import qualified Data.ByteString.Builder as B
13−import qualified Data.ByteString.Lazy as LBS
14−import qualified Data.Map as Map
15−import qualified Data.Map.Utils as Map
16−import qualified Data.Name as N
17−import qualified Data.NonEmptyList as NE
18−import Snap.Core
19−import Snap.Util.FileUploads
20−import qualified System.Directory as Dir
21−import qualified System.IO.Streams as Stream
22−import Text.RawString.QQ (r)
23−
24−import qualified Artifacts as A
25−import qualified Cors
26−
27−import qualified AST.Source as Src
28−import qualified AST.Canonical as Can
29−import qualified AST.Optimized as Opt
30−import qualified BackgroundWriter as BW
31−import qualified Build
32−import qualified Compile
33−import qualified Elm.Details as Details
34−import qualified Elm.Interface as I
35−import qualified Elm.ModuleName as ModuleName
36−import qualified Elm.Package as Pkg
37−import qualified File
38−import qualified Generate
39−import qualified Generate.Html as Html
40−import qualified Generate.JavaScript as JS
41−import qualified Generate.Mode as Mode
42−import qualified Json.Encode as Encode
43−import qualified Parse.Module as Parse
44−import qualified Reporting
45−import qualified Reporting.Annotation as A
46−import Reporting.Doc ((<>))
47−import qualified Reporting.Doc as D
48−import qualified Reporting.Error as Error
49−import qualified Reporting.Error.Import as Import
50−import qualified Reporting.Exit as Exit
51−import qualified Reporting.Exit.Help as Help
52−import qualified Reporting.Task as Task
53−
54−
55−
56−-- ALLOWED ORIGINS
57−
58−
59−allowedOrigins :: [String]
60−allowedOrigins =
61− [ "https://elm-lang.org"
62− , "https://package.elm-lang.org"
63− ]
64−
65−
66−
67−-- ENDPOINT (V1)
68−
69−
70−endpoint_V1 :: A.Artifacts -> Snap ()
71−endpoint_V1 artifacts =
72− endpoint artifacts $ \result ->
73− case result of
74− Ok name js -> writeBuilder $ Html.sandwich name js
75− Err report -> writeBuilder $ renderProblem_V1 report
76−
77−
78−
79−-- ENDPOINT (V2)
80−
81−
82−endpoint_V2 :: A.Artifacts -> Snap ()
83−endpoint_V2 artifacts =
84− endpoint artifacts $ \result ->
85− case result of
86− Ok name js -> writeBuilder $ renderSuccess_V2 name js
87− Err report -> writeBuilder $ renderProblem_V2 report
88−
89−
90−
91−-- ENDPOINT
92−
93−
94−data Result
95− = Ok N.Name B.Builder
96− | Err Help.Report
97−
98−
99−endpoint :: A.Artifacts -> (Result -> Snap ()) -> Snap ()
100−endpoint artifacts callback =
101− Cors.allow POST allowedOrigins $
102− do result <- foldMultipart defaultUploadPolicy ignoreFile 0
103− case result of
104− ([("code",source)], 0) ->
105− do modifyResponse $ setContentType "text/html; charset=utf-8"
106− callback $
107− case compile artifacts source of
108− Success name js -> Ok name js
109− NoMain -> Err noMain
110− BadInput name err -> Err $ Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []
111−
112− _ ->
113− do modifyResponse $ setResponseStatus 400 "Bad Request"
114− modifyResponse $ setContentType "text/html; charset=utf-8"
115− writeBS
116− "<p>Unexpected request format. This should not be possible!</p>\
117− \<p>Please report this\
118− \ <a href=\"https://github.com/elm/compiler/issues\">here</a>\
119− \ along with the URL and your browser version.</p>"
120−
121−
122−ignoreFile :: PartInfo -> Stream.InputStream B.ByteString -> Int -> IO Int
123−ignoreFile _ _ count =
124− return (count + 1)
125−
126−
127−
128−-- COMPILE
129−
130−
131−data Outcome
132− = Success N.Name B.Builder
133− | NoMain
134− | BadInput ModuleName.Raw Error.Error
135−
136−
137−compile :: A.Artifacts -> B.ByteString -> Outcome
138−compile (A.Artifacts interfaces objects) source =
139− case Parse.fromByteString Parse.Application source of
140− Left err ->
141− BadInput N._Main (Error.BadSyntax err)
142−
143− Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
144− case checkImports interfaces imports of
145− Left err ->
146− BadInput (Src.getName modul) (Error.BadImports err)
147−
148− Right ifaces ->
149− case Compile.compile Pkg.dummyName ifaces modul of
150− Left err ->
151− BadInput (Src.getName modul) err
152−
153− Right (Compile.Artifacts canModule _ locals) ->
154− case locals of
155− Opt.LocalGraph Nothing _ _ ->
156− NoMain
157−
158− Opt.LocalGraph (Just main_) _ _ ->
159− let
160− mode = Mode.Dev Nothing
161− home = Can._name canModule
162− name = ModuleName._module home
163− mains = Map.singleton home main_
164− graph = Opt.addLocalGraph locals objects
165− in
166− Success name $ JS.generate mode graph mains
167−
168−
169−checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
170−checkImports interfaces imports =
171− let
172− importDict = Map.fromValues Src.getImportName imports
173− missing = Map.difference importDict interfaces
174− in
175− case Map.elems missing of
176− [] ->
177− Right (Map.intersection interfaces importDict)
178−
179− i:is ->
180− let
181− unimported =
182− Map.keysSet (Map.difference interfaces importDict)
183−
184− toError (Src.Import (A.At region name) _ _) =
185− Import.Error region name unimported Import.NotFound
186− in
187− Left (fmap toError (NE.List i is))
188−
189−
190−
191−-- RENDER PROBLEM (V1)
192−
193−
194−renderProblem_V1 :: Help.Report -> B.Builder
195−renderProblem_V1 report =
196− [r|<!DOCTYPE HTML>
197−<html>
198−<head>
199− <meta charset="UTF-8">
200− <style>body { padding: 0; margin: 0; background-color: black; }</style>
201− <script src="https://worker.elm-lang.org/compile/errors.js"></script>
202−</head>
203−<body>
204− <script>
205− var app = Elm.Errors.init({flags:|] <> Encode.encodeUgly (Exit.toJson report) <> [r|});
206− app.ports.jumpTo.subscribe(function(region) {
207− window.parent.postMessage(JSON.stringify(region), "*");
208− });
209− </script>
210−</body>
211−</html>|]
212−
213−
214−
215−-- RENDER SUCCESS (V2)
216−
217−
218−renderSuccess_V2 :: N.Name -> B.Builder -> B.Builder
219−renderSuccess_V2 moduleName javascript =
220− let name = N.toBuilder moduleName in
221− [r|<!DOCTYPE HTML>
222−<html>
223−<head>
224− <meta charset="UTF-8">
225− <title>|] <> name <> [r|</title>
226− <style>body { padding: 0; margin: 0; }</style>
227−</head>
228−
229−<body>
230−
231−<pre id="elm"></pre>
232−
233−<script>
234−window.parent.postMessage("SUCCESS", "*");
235−
236−try {
237−|] <> javascript <> [r|
238−
239− var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
240−}
241−catch (e)
242−{
243− // display initialization errors (e.g. bad flags, infinite recursion)
244− var header = document.createElement("h1");
245− header.style.fontFamily = "monospace";
246− header.innerText = "Initialization Error";
247− var pre = document.getElementById("elm");
248− document.body.insertBefore(header, pre);
249− pre.innerText = e;
250− throw e;
251−}
252−</script>
253−
254−</body>
255−</html>|]
256−
257−
258−
259−-- RENDER PROBLEM (V2)
260−
261−
262−renderProblem_V2 :: Help.Report -> B.Builder
263−renderProblem_V2 report =
264− [r|<!DOCTYPE HTML>
265−<html>
266−<head>
267− <meta charset="UTF-8">
268− <style>body { padding: 0; margin: 0; display: none; }</style>
269−</head>
270−<body>
271− <script>
272− var errors = |] <> Encode.encodeUgly (Exit.toJson report) <> [r|;
273− window.parent.postMessage(JSON.stringify(errors), "*");
274− </script>
275−</body>
276−</html>|]
277−
278−
279−
280−-- NO MAIN
281−
282−
283−noMain :: Help.Report
284−noMain =
285− Help.report "NO MAIN" Nothing
286− (
287− "Without a `main` value, I do not know what to show on screen!"
288− )
289− [ D.reflow $
290− "Adding a `main` value can be as brief as:"
291− , D.vcat
292− [ D.fillSep [D.cyan "import","Html"]
293− , ""
294− , D.fillSep [D.green "main","="]
295− , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
296− ]
297− , D.reflow $
298− "Try adding something like that!"
299− , D.toSimpleNote $
300− "I recommend looking through https://guide.elm-lang.org for more advice on\
301− \ how to fill in `main` values."
302− ]
303−
304−
305−
306−-- LOAD ERROR JS
307−
308−
309−loadErrorJS :: IO B.ByteString
310−loadErrorJS =
311− let
312− run work =
313− do result <- work
314− case result of
315− Right a -> return a
316− Left _ -> error "problem building src/Errors.elm"
317− in
318− BW.withScope $ \scope ->
319− do root <- Dir.getCurrentDirectory
320− details <- run $ Details.load Reporting.silent scope root
321− artifacts <- run $ Build.fromPaths Reporting.silent root details (NE.List "src/Errors.elm" [])
322− javascript <- run $ Task.run $ Generate.prod root details artifacts
323− return $ LBS.toStrict $ B.toLazyByteString javascript
worker/src/Endpoint/Quotes.hsdeleted−114
@@ -1,114 +0,0 @@
1−{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
2−module Endpoint.Quotes
3− ( endpoint
4− )
5− where
6−
7−
8−import Control.Monad.IO.Class (liftIO)
9−import qualified Data.ByteString as BS
10−import GHC.Int (Int(I#))
11−import GHC.Prim
12−import GHC.ST (ST(ST), runST)
13−import qualified System.Random as Random
14−
15−import Snap.Core
16−
17−
18−
19−-- ENDPOINT
20−
21−
22−endpoint :: Snap ()
23−endpoint =
24− do modifyResponse
25− $ setContentType "application/json"
26− . setHeader "Access-Control-Allow-Origin" "*"
27− writeBS =<< liftIO getQuote
28−
29−
30−getQuote :: IO BS.ByteString
31−getQuote =
32− let
33− (Quotes sa#) = quotes
34− in
35− do (I# i#) <- Random.randomRIO (0, I# (sizeofSmallArray# sa# -# 1#))
36− case indexSmallArray# sa# i# of
37− (# json #) ->
38− return json
39−
40−
41−
42−-- QUOTES
43−
44−
45−data Quotes =
46− Quotes (SmallArray# BS.ByteString)
47−
48−
49−quotes :: Quotes
50−quotes =
51− let
52− !(I# len#) = length quoteList
53− in
54− runST $ ST $ \s ->
55− case newSmallArray# len# "" s of
56− (# s, sma# #) ->
57− case quotesHelp# sma# quoteList s of
58− s ->
59− case unsafeFreezeSmallArray# sma# s of
60− (# s, sa# #) ->
61− (# s, Quotes sa# #)
62−
63−
64−quotesHelp# :: SmallMutableArray# s a -> [a] -> State# s -> State# s
65−quotesHelp# sma# =
66− go 0#
67− where
68− go i# list s =
69− case list of
70− [] ->
71− s
72−
73− x:xs ->
74− case writeSmallArray# sma# i# x s of
75− s ->
76− go (i# +# 1#) xs s
77−
78−
79−quoteList :: [BS.ByteString]
80−quoteList =
81− [ "{\"source\":\"Civilization and its Discontents\",\"author\":\"Sigmund Freud\",\"year\":1902,\"quote\":\"The enormous expansion of communications, due to the world-wide telegraph and telephone networks, has entirely transformed the conditions of trade and commerce. Everything is done in haste, at fever pitch. The night is used for travel, the day for business; even \\u201Choliday trips\\u201D put a strain on the nervous system. Great political, industrial and financial crises carry this excitement into far wider areas of the population than ever before. Interest in political life has become universal: tempers are inflamed by political, religious and social struggles, party politics, electioneering and the immense growth of trade-unionism; people are forced to engage in constant mental activity and robbed of the time the need for relaxation, sleep and rest.\"}"
82− , "{\"source\":\"A Preface to Politics\",\"author\":\"Walter Lippmann\",\"year\":1913,\"quote\":\"The Economic Man\\u2014that lazy abstraction\\u2014is still paraded in the lecture room.\"}"
83− , "{\"source\":\"Letters from a Stoic\",\"author\":\"Seneca\",\"year\":54,\"quote\":\"You ask me to say what you should consider it particularly important to avoid. My answer is this: a mass crowd. It is something to which you cannot entrust yourself yet without risk. I at any rate am ready to confess my own frailty in this respect. I never come back home with quite the same moral character as I went out with.\"}"
84− , "{\"source\":\"Letters from a Stoic\",\"author\":\"Seneca\",\"year\":54,\"quote\":\"December used to be a month but it is now a year\"}"
85− , "{\"source\":\"Letters from a Stoic\",\"author\":\"Seneca\",\"year\":54,\"quote\":\"But nothing is as ruinous to the character as sitting away one\\u2019s time at a show - for it is then, through the medium of entertainment, that vices creep into one with more than usual ease.\"}"
86− , "{\"source\":\"Letters from a Stoic\",\"author\":\"Seneca\",\"year\":54,\"quote\":\"All this hurrying from place to place won\\u2019t bring you any relief, for you\\u2019re travelling in the company of your own emotions, followed by your troubles all the way. If only they were really following you! They\\u2019d be farther away from you: as it is they\\u2019re not at your back, but on it! That\\u2019s why they weigh you down with just the same uncomfortable chafing wherever you are. It\\u2019s medicine, not a particular part of the world, that a person needs if he\\u2019s ill. Suppose someone has broken his leg or dislocated a joint; he doesn\\u2019t get into a carriage or board a ship: he calls in a doctor to have the fracture set or the dislocation reduced. Well then, when a person\\u2019s spirit is wrenched or broken at so many points, do you imagine that it can be put right by a change of scenery, that that sort of trouble isn\\u2019t so serious that it can\\u2019t be cured by an outing?\"}"
87− , "{\"source\":\"Progress and Poverty\",\"author\":\"Henry George\",\"year\":1879,\"quote\":\"The present century has been marked by a prodigious increase in wealth-producing power. The utilization of steam and electricity, the introduction of improved processes and laborsaving machinery, the greater subdivision and grander scale of production, the wonderful facilitation of exchanges, have multiplied enormously the effectiveness of labor. At the beginning of this marvelous era it was natural to expect, and it was expected, that laborsaving inventions would lighten the toil and improve the condition of the laborer; that the enormous increase in the power of producing wealth would make real poverty a thing of the past.\"}"
88− , "{\"source\":\"Imperialism\",\"author\":\"John Hobson\",\"year\":1902,\"quote\":\"Although the new Imperialism has been bad business for the nation, it has been good business for certain classes and certain trades within the nation. The vast expenditure on armaments, the costly wars, the grave risks and embarrassments of foreign policy, the stoppage of political and social reforms within Great Britain, though fraught with great injury to the nation, have served well the present business interests of certain industries and professions.\"}"
89− , "{\"source\":\"Neo-Colonialism\",\"author\":\"Kwame Nkrumah\",\"year\":1965,\"quote\":\"The essence of neo-colonialism is that the State which is subject to it is, in theory, independent and has all the outward trappings of international sovereignty. In reality its economic system and thus its political policy is directed from the outside. The methods and form of this direction can take various shapes. For example, in an extreme case the troops of the imperial power may garrison the territory of the neo-colonial State and control the government of it. More often, however, neo-colonialist control is exercised through economic or monetary means. The neo-colonial State may be obliged to take the manufactured products of the imperialist power to the exclusion of competing products from elsewhere. Control over government policy in the neo-colonial State may be secured by payments towards the cost of running the State, by the provision of civil servants in positions where they can dictate policy, and by monetary control over foreign exchange through the imposition of a banking system controlled by the imperial power.\"}"
90− , "{\"source\":\"Neo-Colonialism\",\"author\":\"Kwame Nkrumah\",\"year\":1965,\"quote\":\"In the end the situation arises that the only type of aid which the neo-colonialist masters consider as safe is \\u2018military aid\\u2019. Once a neo-colonialist territory is brought to such a state of economic chaos and misery that revolt actually breaks out then, and only then, is there no limit to the generosity of the neo-colonial overlord, provided, of course, that the funds supplied are utilised exclusively for military purposes. Military aid in fact marks the last stage of neo-colonialism and its effect is self-destructive. Sooner or later the weapons supplied pass into the hands of the opponents of the neo-colonialist regime and the war itself increases the social misery which originally provoked it.\"}"
91− , "{\"source\":\"Barnyard in your Backyard\",\"author\":\"Gail Damerow\",\"year\":2002,\"quote\":\"Wild jungle fowl, the ancestors of modern chickens, met their nutritional needs by consuming a variety of plants and insects. Given enough room to roam, some of today\\u2019s breeds remain active foragers.\"}"
92− , "{\"source\":\"Barnyard in your Backyard\",\"author\":\"Gail Damerow\",\"year\":2002,\"quote\":\"Another way to reduce the cost of feed is to let your chickens roam on a lawn or in a pasture for part of the day. By eating plants, seeds, and insects, they will balance their diet and eat less of the expensive commercial stuff. Take care not to put your chickens on grass or around buildings that have been sprayed with toxins.\"}"
93− , "{\"source\":\"Co-operation in Danish Agriculture\",\"author\":\"Harald Faber\",\"year\":1918,\"quote\":\"A plan for improving the butter made from the milk from peasant farms by collecting the milk to be worked at one place was submitted to the Royal Agricultural Society of Denmark as early as 1852, and it pointed out that this could be done on co-operative lines, the peasants being the owners of the factory and sharing the proceeds.\"}"
94− , "{\"source\":\"Co-operation in Danish Agriculture\",\"author\":\"Harald Faber\",\"year\":1918,\"quote\":\"It was the Danish peasants themselves who found a practical way of developing the dairy industry, and they found this by applying the co-operative principles introduced by the Rochdale weavers. They received no support and only lukewarm sympathy from large farmers and estate owners, until later on when the co-operative dairies were doing so well that even owners of estates with two to three hundred cows found it to their advantage to close their private dairies and to join co-operative dairies.\"}"
95− , "{\"source\":\"Beekeeping: A Practical Guide\",\"author\":\"Richard Bonney\",\"year\":1993,\"quote\":\"How many of you have been in a classroom or a training program where the instructor says at the outset, \\u201CLook at the person on your right; now look at the person on your left. One of you won\\u2019t be here next year.\\u201D Beekeeping is like that. Furthermore, not all beekeepers are truly beekeepers. Some are beehavers.\"}"
96− , "{\"source\":\"The Rodale Book of Composting\",\"author\":\"Deborah Martin and Grace Gershuny\",\"year\":1992,\"quote\":\"Earthworms. If bacteria are the champion microscopic decomposers, then the heavyweight champion is doubtless the earthworm. Pages of praise have been written to the earthworm, ever since it became known that this creature spends most of its time tilling and enriching the soil.\"}"
97− , "{\"source\":\"War is a Racket\",\"author\":\"General Smedley Butler\",\"year\":1935,\"quote\":\"There are 40,000,000 men under arms in the world today, and our statesmen and diplomats have the temerity to say that war is not in the making. Hell\\u2019s bells! Are these 40,000,000 men being trained to be dancers?\"}"
98− , "{\"source\":\"Root Cellaring\",\"author\":\"Mike and Nancy Bubel\",\"year\":1991,\"quote\":\"What is not so widely acknowledged is that the soil in which your plants grow can influence the keeping quality of the vegetables you harvest. According to studies reported in E. P. Shirakov\\u2019s \\u201CPractical Course in Storage and Processing of Fruits and Vegetables\\u201D, abundant potash in the soil promotes long storage life of fruits and vegetables grown on that soil.\"}"
99− , "{\"source\":\"Angora Goats the Northern Way\",\"author\":\"Susan Black Drummond\",\"year\":1985,\"quote\":\"Because of its long wearing qualities and resistance to soil, mohair was once a major upholstery fabric in this country, and was the seat cover material in many cars and in British Railroad seats. The synthetic fiber craze put an end to mohair use as upholstery fabric here.\"}"
100− , "{\"source\":\"Making a Newspaper\",\"author\":\"John Given\",\"year\":1912,\"quote\":\"Yellow journalism originated through a desire to gain readers and advertisers, and it produced results. Its original disciples have readers by the hundred thousand and they have about all the advertising that they can well handle.\"}"
101− , "{\"source\":\"Making a Newspaper\",\"author\":\"John Given\",\"year\":1912,\"quote\":\"With the adding of every new train and the improvement of every new time-table, the building of every new trolley road, and the establishment of every new mail route, the big city papers are enabled to reach out further, and, wherever they reach, the local papers suffer [...] There is not a paper published in any city between New York and Boston that has not in the last ten years been hurt by the papers of these two cities.\"}"
102− , "{\"source\":\"Muscles: Testing and Function (4th Edition)\",\"author\":\"Florence Kendall, Elizabeth McCreary, Patricia Provance\",\"year\":1993,\"quote\":\"The mechanics of the low back is inseparable from that of the overall posture but especially that of the pelvis and the lower extremities. Pain manifested in the leg may be due to an underlying problem in the back. Conversely, the symptoms appearing in the low back may be due to underlying faulty mechanics of the feet, legs, or pelvis.\"}"
103− , "{\"source\":\"Farmers of Forty Centuries\",\"author\":\"F. H. King\",\"year\":1911,\"quote\":\"The Sikiang is one of the great rivers of China and indeed of the world. Its width at Wuchow at low water was nearly a mile and our steamer anchored in twenty-four feet of water to a floating dock made fast by huge iron chains reaching three hundred feet up the slop to the city proper, thus providing for a rise of twenty-six feet in the river at its flood stage during the rainy season.\"}"
104− , "{\"source\":\"How to Grow More Vegetables\",\"author\":\"John Jeavons\",\"year\":1974,\"quote\":\"If you are having trouble with birds eating the berries in your berry patch, you could erect a wren house in the middle of it. Wrens are insectivores, and they will not bother the berries. But they will attack any bird, however large, that comes near their nest.\"}"
105− , "{\"source\":\"Confidence Men and Painted Women\",\"author\":\"Karen Halttunen\",\"year\":1982,\"quote\":\"Even one\\u2019s neighbor next door, as a visitor to Pittsburgh commented in 1818, might be a stranger: \\u201CA next door neighbor is, with them, frequently unknown, and months and years pass, without their exchanging with each other the ordinary compliments of friendship and goodwill.\\u201D\"}"
106− , "{\"source\":\"Secondhand Time\",\"author\":\"Svetlana Alexievich\",\"year\":2016,\"quote\":\"I couldn\\u2019t understand what was going on. I remember seeing Gaidar on TV saying, \\u201Clearn how to sell... The market will save us...\\u201D You buy a bottle of mineral water on one corner and sell it on another\\u2014that\\u2019s business. The people listened, bewildered. I would come home, lock the door, and weep.\"}"
107− , "{\"source\":\"Hiroshima\",\"author\":\"John Hersey\",\"year\":1985,\"quote\":\"At exactly fifteen minutes past eight in the morning, on August 6, 1945, Japanese time, at the moment when the atomic bomb flashed above Hiroshima, Miss Toshiko Sasaki, a clerk in the personnel department of the East Asia Tin Works, had just sat down at her place in the plant office and was turning her head to speak to the girl at the next desk.\"}"
108− , "{\"source\":\"The Orphan\",\"author\":\"Maxim Gorky\",\"year\":1899,\"quote\":\"On a foggy and rainy day, by the cemetery gate, a small group of people standing in a muddy puddle were bargaining with the cabman. \\u201CFifteen kopeks!\\u201D The tall and heavy-set priest exclaimed in a deep bass, in response to the cabman\\u2019s shouts asking for twenty-five kopecks.\"}"
109− , "{\"source\":\"Shah of Shahs\",\"author\":\"Ryszard Kapuściński\",\"year\":1982,\"quote\":\"This plane flies out of Teheran every day and lands at Munich at noon. Waiting limousines carry the passengers to elegant restaurants for lunch. After lunch they all fly back to Teheran in the same airplane and eat their suppers at home. Hardly an expensive entertainment, the jaunt costs only two thousand dollars a head. For people in the Shah\\u2019s favor, such a sum is nothing.\"}"
110− , "{\"source\":\"Introduction to Fortran IV\",\"author\":\"Paul Chirlian\",\"year\":1973,\"quote\":\"There are many programming languages that can be used. We shall discuss a language that is almost universally used, and which is particularly applicable to mathematical and scientific computations. This language is FORTRAN IV.\"}"
111− ]
112−
113−
114−
worker/src/Endpoint/Repl.hsdeleted−244
@@ -1,244 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Endpoint.Repl
4− ( endpoint
5− )
6− where
7−
8−
9−import Data.Aeson ((.:))
10−import qualified Data.Aeson as Aeson
11−import qualified Data.Aeson.Types as Aeson
12−import qualified Data.ByteString as BS
13−import qualified Data.ByteString.Builder as B
14−import qualified Data.ByteString.Lazy as LBS
15−import Data.Map ((!))
16−import qualified Data.Map as Map
17−import qualified Data.Map.Utils as Map
18−import qualified Data.Name as N
19−import qualified Data.NonEmptyList as NE
20−import Snap.Core
21−
22−import qualified Artifacts as A
23−import qualified Cors
24−
25−import qualified AST.Source as Src
26−import qualified AST.Canonical as Can
27−import qualified AST.Optimized as Opt
28−import qualified Compile
29−import qualified Elm.Interface as I
30−import qualified Elm.ModuleName as ModuleName
31−import qualified Elm.Package as Pkg
32−import qualified File
33−import qualified Generate.JavaScript as JS
34−import qualified Json.Encode as Encode
35−import qualified Parse.Module as Parse
36−import qualified Repl
37−import qualified Reporting.Annotation as A
38−import qualified Reporting.Error as Error
39−import qualified Reporting.Error.Import as Import
40−import qualified Reporting.Exit as Exit
41−import qualified Reporting.Exit.Help as Help
42−import qualified Reporting.Render.Type.Localizer as L
43−
44−
45−
46−-- ALLOWED ORIGINS
47−
48−
49−allowedOrigins :: [String]
50−allowedOrigins =
51− [ "https://guide.elm-lang.org"
52− , "https://guide.elm-lang.jp"
53− , "http://localhost:8007"
54− ]
55−
56−
57−
58−-- ENDPOINT
59−
60−
61−endpoint :: A.Artifacts -> Snap ()
62−endpoint artifacts =
63− Cors.allow POST allowedOrigins $
64− do body <- readRequestBody (64 * 1024)
65− case decodeBody body of
66− Just (state, entry) ->
67− serveOutcome (toOutcome artifacts state entry)
68−
69− Nothing ->
70− do modifyResponse $ setResponseStatus 400 "Bad Request"
71− modifyResponse $ setContentType "text/html; charset=utf-8"
72− writeBS "Received unexpected JSON body."
73−
74−
75−
76−-- TO OUTCOME
77−
78−
79−data Outcome
80− = NewImport N.Name
81− | NewType N.Name
82− | NewWork B.Builder
83− --
84− | Skip
85− | Indent
86− | DefStart N.Name
87− --
88− | NoPorts
89− | InvalidCommand
90− | Failure BS.ByteString Error.Error
91−
92−
93−toOutcome :: A.Artifacts -> Repl.State -> String -> Outcome
94−toOutcome artifacts state entry =
95− case reverse (lines entry) of
96− [] ->
97− Skip
98−
99− prev : rev ->
100− case Repl.categorize (Repl.Lines prev rev) of
101− Repl.Done input ->
102− case input of
103− Repl.Import name src -> compile artifacts state (ImportEntry name src)
104− Repl.Type name src -> compile artifacts state (TypeEntry name src)
105− Repl.Decl name src -> compile artifacts state (DeclEntry name src)
106− Repl.Expr src -> compile artifacts state (ExprEntry src)
107− Repl.Port -> NoPorts
108− Repl.Skip -> Skip
109− Repl.Reset -> InvalidCommand
110− Repl.Exit -> InvalidCommand
111− Repl.Help _ -> InvalidCommand
112−
113− Repl.Continue prefill ->
114− case prefill of
115− Repl.Indent -> Indent
116− Repl.DefStart name -> DefStart name
117−
118−
119−
120−-- SERVE OUTCOME
121−
122−
123−serveOutcome :: Outcome -> Snap ()
124−serveOutcome outcome =
125− let
126− serveString = serveBuilder "text/plain"
127− in
128− case outcome of
129− NewImport name -> serveString $ "add-import:" <> N.toBuilder name
130− NewType name -> serveString $ "add-type:" <> N.toBuilder name
131− NewWork js -> serveBuilder "application/javascript" js
132− Skip -> serveString $ "skip"
133− Indent -> serveString $ "indent"
134− DefStart name -> serveString $ "def-start:" <> N.toBuilder name
135− NoPorts -> serveString $ "no-ports"
136− InvalidCommand -> serveString $ "invalid-command"
137− Failure source err ->
138− serveBuilder "application/json" $ Encode.encodeUgly $ Exit.toJson $
139− Help.compilerReport "/" (Error.Module N.replModule "/repl" File.zeroTime source err) []
140−
141−
142−serveBuilder :: BS.ByteString -> B.Builder -> Snap ()
143−serveBuilder mime builder =
144− do modifyResponse (setContentType mime)
145− writeBuilder builder
146−
147−
148−
149−-- COMPILE
150−
151−
152−data EntryType
153− = ImportEntry N.Name BS.ByteString
154− | TypeEntry N.Name BS.ByteString
155− | DeclEntry N.Name BS.ByteString
156− | ExprEntry BS.ByteString
157−
158−
159−compile :: A.Artifacts -> Repl.State -> EntryType -> Outcome
160−compile (A.Artifacts interfaces objects) state@(Repl.State imports types decls) entryType =
161− let
162− source =
163− case entryType of
164− ImportEntry name src -> Repl.toByteString (state { Repl._imports = Map.insert name (B.byteString src) imports }) Repl.OutputNothing
165− TypeEntry name src -> Repl.toByteString (state { Repl._types = Map.insert name (B.byteString src) types }) Repl.OutputNothing
166− DeclEntry name src -> Repl.toByteString (state { Repl._decls = Map.insert name (B.byteString src) decls }) (Repl.OutputDecl name)
167− ExprEntry src -> Repl.toByteString state (Repl.OutputExpr src)
168− in
169− case
170− do modul <- mapLeft Error.BadSyntax $ Parse.fromByteString Parse.Application source
171− ifaces <- mapLeft Error.BadImports $ checkImports interfaces (Src._imports modul)
172− artifacts <- Compile.compile Pkg.dummyName ifaces modul
173− return ( modul, artifacts, objects )
174− of
175− Left err ->
176− Failure source err
177−
178− Right info ->
179− case entryType of
180− ImportEntry name _ -> NewImport name
181− TypeEntry name _ -> NewType name
182− DeclEntry name _ -> NewWork (toJavaScript info (Just name))
183− ExprEntry _ -> NewWork (toJavaScript info Nothing)
184−
185−
186−toJavaScript :: (Src.Module, Compile.Artifacts, Opt.GlobalGraph) -> Maybe N.Name -> B.Builder
187−toJavaScript (modul, Compile.Artifacts canModule types locals, objects) maybeName =
188− let
189− localizer = L.fromModule modul
190− graph = Opt.addLocalGraph locals objects
191− home = Can._name canModule
192− tipe = types ! maybe N.replValueToPrint id maybeName
193− in
194− JS.generateForReplEndpoint localizer graph home maybeName tipe
195−
196−
197−mapLeft :: (x -> y) -> Either x a -> Either y a
198−mapLeft func result =
199− either (Left . func) Right result
200−
201−
202−checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
203−checkImports interfaces imports =
204− let
205− importDict = Map.fromValues Src.getImportName imports
206− missing = Map.difference importDict interfaces
207− in
208− case Map.elems missing of
209− [] ->
210− Right (Map.intersection interfaces importDict)
211−
212− i:is ->
213− let
214− unimported =
215− Map.keysSet (Map.difference interfaces importDict)
216−
217− toError (Src.Import (A.At region name) _ _) =
218− Import.Error region name unimported Import.NotFound
219− in
220− Left (fmap toError (NE.List i is))
221−
222−
223−
224−-- DECODE BODY
225−
226−
227−decodeBody :: LBS.ByteString -> Maybe ( Repl.State, String )
228−decodeBody body =
229− Aeson.parseMaybe decodeBodyHelp =<< Aeson.decode' body
230−
231−
232−decodeBodyHelp :: Aeson.Object -> Aeson.Parser ( Repl.State, String )
233−decodeBodyHelp obj =
234− let
235− get key =
236− do dict <- obj .: key
237− let f (k,v) = (N.fromChars k, B.stringUtf8 v)
238− return $ Map.fromList $ map f $ Map.toList dict
239− in
240− do imports <- get "imports"
241− types <- get "types"
242− decls <- get "decls"
243− entry <- obj .: "entry"
244− return ( Repl.State imports types decls, entry )
worker/src/Errors.elmdeleted−217
@@ -1,217 +0,0 @@
1−port module Errors exposing (main)
2−
3−
4−import Browser
5−import Char
6−import Html exposing (..)
7−import Html.Attributes exposing (..)
8−import Html.Events exposing (onClick)
9−import String
10−import Json.Decode as D
11−import Elm.Error as Error
12−
13−
14−
15−-- PORTS
16−
17−
18−port jumpTo : Error.Region -> Cmd msg
19−
20−
21−
22−-- MAIN
23−
24−
25−main =
26− Browser.document
27− { init = \flags -> (D.decodeValue Error.decoder flags, Cmd.none)
28− , update = \region result -> (result, jumpTo region)
29− , view = view
30− , subscriptions = \_ -> Sub.none
31− }
32−
33−
34−type alias Msg = Error.Region
35−
36−
37−
38−-- VIEW
39−
40−
41−view : Result D.Error Error.Error -> Browser.Document Msg
42−view result =
43− { title = "Problem!"
44− , body =
45− case result of
46− Err err ->
47− [ text (D.errorToString err) ]
48−
49− Ok error ->
50− [ viewError error ]
51− }
52−
53−
54−viewError : Error.Error -> Html Msg
55−viewError error =
56− div
57− [ style "width" "calc(100% - 4em)"
58− , style "min-height" "calc(100% - 4em)"
59− , style "font-family" "monospace"
60− , style "white-space" "pre-wrap"
61− , style "background-color" "black"
62− , style "color" "rgb(233,235,235)"
63− , style "padding" "2em"
64− ]
65− (viewErrorHelp error)
66−
67−
68−viewErrorHelp : Error.Error -> List (Html Msg)
69−viewErrorHelp error =
70− case error of
71− Error.GeneralProblem { title, message } ->
72− viewHeader title Nothing :: viewMessage message
73−
74− Error.ModuleProblems badModules ->
75− viewBadModules badModules
76−
77−
78−
79−-- VIEW HEADER
80−
81−
82−viewHeader : String -> Maybe Error.Region -> Html Msg
83−viewHeader title maybeRegion =
84− case maybeRegion of
85− Nothing ->
86− span [ style "color" "rgb(51,187,200)" ]
87− [ text <| "-- " ++ title ++ " "
88− , text <| String.repeat (76 - String.length title) "-"
89− , text <| "\n\n"
90− ]
91−
92− Just region ->
93− span [ style "color" "rgb(51,187,200)" ]
94− [ text <| "-- " ++ title ++ " "
95− , text <| String.repeat (60 - String.length title) "-"
96− , text " "
97− , span
98− [ style "cursor" "pointer"
99− , style "text-decoration" "underline"
100− , onClick region
101− ]
102− [ text "Jump To Problem"
103− ]
104− , text <| "\n\n"
105− ]
106−
107−
108−
109−-- VIEW BAD MODULES
110−
111−
112−viewBadModules : List Error.BadModule -> List (Html Msg)
113−viewBadModules badModules =
114− case badModules of
115− [] ->
116− []
117−
118− [badModule] ->
119− [viewBadModule badModule]
120−
121− a :: b :: cs ->
122− viewBadModule a :: viewSeparator a.name b.name :: viewBadModules (b :: cs)
123−
124−
125−viewBadModule : Error.BadModule -> Html Msg
126−viewBadModule { problems } =
127− span [] (List.map viewProblem problems)
128−
129−
130−viewProblem : Error.Problem -> Html Msg
131−viewProblem problem =
132− span [] (viewHeader problem.title (Just problem.region) :: viewMessage problem.message)
133−
134−
135−viewSeparator : String -> String -> Html msg
136−viewSeparator before after =
137− span [ style "color" "rgb(211,56,211)" ]
138− [ text <|
139− String.padLeft 80 ' ' (before ++ " ↑ ") ++ "\n" ++
140− "====o======================================================================o====\n" ++
141− " ↓ " ++ after ++ "\n\n\n"
142− ]
143−
144−
145−
146−-- VIEW MESSAGE
147−
148−
149−viewMessage : List Error.Chunk -> List (Html msg)
150−viewMessage chunks =
151− case chunks of
152− [] ->
153− [ text "\n\n\n" ]
154−
155− chunk :: others ->
156− let
157− htmlChunk =
158− case chunk of
159− Error.Unstyled string ->
160− text string
161−
162− Error.Styled style string ->
163− span (styleToAttrs style) [ text string ]
164− in
165− htmlChunk :: viewMessage others
166−
167−
168−styleToAttrs : Error.Style -> List (Attribute msg)
169−styleToAttrs { bold, underline, color } =
170− addBold bold <| addUnderline underline <| addColor color []
171−
172−
173−addBold : Bool -> List (Attribute msg) -> List (Attribute msg)
174−addBold bool attrs =
175− if bool then
176− style "font-weight" "bold" :: attrs
177− else
178− attrs
179−
180−
181−addUnderline : Bool -> List (Attribute msg) -> List (Attribute msg)
182−addUnderline bool attrs =
183− if bool then
184− style "text-decoration" "underline" :: attrs
185− else
186− attrs
187−
188−
189−addColor : Maybe Error.Color -> List (Attribute msg) -> List (Attribute msg)
190−addColor maybeColor attrs =
191− case maybeColor of
192− Nothing ->
193− attrs
194−
195− Just color ->
196− style "color" (colorToCss color) :: attrs
197−
198−
199−colorToCss : Error.Color -> String
200−colorToCss color =
201− case color of
202− Error.Red -> "rgb(194,54,33)"
203− Error.RED -> "rgb(252,57,31)"
204− Error.Magenta -> "rgb(211,56,211)"
205− Error.MAGENTA -> "rgb(249,53,248)"
206− Error.Yellow -> "rgb(173,173,39)"
207− Error.YELLOW -> "rgb(234,236,35)"
208− Error.Green -> "rgb(37,188,36)"
209− Error.GREEN -> "rgb(49,231,34)"
210− Error.Cyan -> "rgb(51,187,200)"
211− Error.CYAN -> "rgb(20,240,240)"
212− Error.Blue -> "rgb(73,46,225)"
213− Error.BLUE -> "rgb(88,51,255)"
214− Error.White -> "rgb(203,204,205)"
215− Error.WHITE -> "rgb(233,235,235)"
216− Error.Black -> "rgb(0,0,0)"
217− Error.BLACK -> "rgb(129,131,131)"
worker/src/Main.hs+264−35
@@ -1,21 +1,54 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
3module Main
3module Main
4 ( main
4 ( main
5 )
5 )
6 where
6 where
7
7
8
8
9−import Control.Monad (msum)
9+import Control.Concurrent (readMVar)
10+import Control.Monad (liftM2, msum)
10−import qualified Data.ByteString as BS
11+import qualified Data.ByteString as B
12+import qualified Data.ByteString.Builder as B
13+import qualified Data.ByteString.Lazy as LBS
14+import qualified Data.HashSet as HashSet
15+import qualified Data.Map as Map
16+import qualified Data.Map.Utils as Map
17+import qualified Data.Name as N
18+import qualified Data.NonEmptyList as NE
19+import qualified Data.OneOrMore as OneOrMore
20+import Network.URI (parseURI)
11import Snap.Core
21import Snap.Core
12import Snap.Http.Server
22import Snap.Http.Server
23+import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins), applyCORS, mkOriginSet)
24+import Snap.Util.FileUploads
25+import qualified System.Directory as Dir
26+import qualified System.IO.Streams as Stream
27+import Text.RawString.QQ (r)
13
28
14−import qualified Artifacts
29+import qualified AST.Source as Src
15−import qualified Cors
30+import qualified AST.Canonical as Can
16−import qualified Endpoint.Compile as Compile
31+import qualified AST.Optimized as Opt
32+import qualified BackgroundWriter as BW
33+import qualified Build
34+import qualified Compile
35+import qualified Elm.Details as Details
36+import qualified Elm.Interface as I
37+import qualified Elm.ModuleName as ModuleName
38+import qualified Elm.Package as Pkg
39+import qualified File
40+import qualified Generate
41+import qualified Generate.Html as Html
42+import qualified Generate.JavaScript as Generate
17−import qualified Endpoint.Quotes as Quotes
43+import qualified Generate.Mode as Mode
18−import qualified Endpoint.Repl as Repl
44+import qualified Json.Encode as Encode
45+import qualified Parse.Module as Parse
46+import qualified Reporting
47+import qualified Reporting.Annotation as A
48+import qualified Reporting.Error as Error
49+import qualified Reporting.Error.Import as Import
50+import qualified Reporting.Exit as Exit
51+import qualified Reporting.Task as Task
19
52
20
53
21
54
@@ -24,50 +57,246 @@ import qualified Endpoint.Repl as Repl
24
57
25main :: IO ()
58main :: IO ()
26main =
59main =
27− do rArtifacts <- Artifacts.loadRepl
60+ do artifacts <- loadArtifacts
28− cArtifacts <- Artifacts.loadCompile
61+ errorJS <- compileErrorViewer
29− errorJS <- Compile.loadErrorJS
30− let depsInfo = Artifacts.toDepsInfo cArtifacts
31−
32 httpServe config $ msum $
62 httpServe config $ msum $
33− [ ifTop $ status
63+ [ path "compile" $ compile artifacts
34− , path "repl" $ Repl.endpoint rArtifacts
35− , path "compile" $ Compile.endpoint_V1 cArtifacts
36− , path "compile/v2" $ Compile.endpoint_V2 cArtifacts
37− , path "compile/errors.js" $ serveJavaScript errorJS
64+ , path "compile/errors.js" $ writeBS errorJS
38− , path "compile/deps-info.json" $ serveDepsInfo depsInfo
39− , path "quotes" $ Quotes.endpoint
40 , notFound
65 , notFound
41 ]
66 ]
42
67
43
68
44config :: Config Snap a
69config :: Config Snap a
45config =
70config =
71+ defaultConfig
72+ |> setPort 8000
46− setPort 8000 $ setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ defaultConfig
73+ |> setAccessLog ConfigNoLog
74+ |> setErrorLog ConfigNoLog
75+
76+
77+(|>) :: a -> (a -> b) -> b
78+(|>) value func =
79+ func value
80+
47
81
48
82
49−status :: Snap ()
83+-- NOT FOUND
50−status =
51− do modifyResponse $ setContentType "text/plain"
52− writeBuilder "Status: OK"
53
84
54
85
55notFound :: Snap ()
86notFound :: Snap ()
56notFound =
87notFound =
57 do modifyResponse $ setResponseStatus 404 "Not Found"
88 do modifyResponse $ setResponseStatus 404 "Not Found"
58 modifyResponse $ setContentType "text/html; charset=utf-8"
89 modifyResponse $ setContentType "text/html; charset=utf-8"
59− writeBuilder "Not Found"
90+ writeBS "Not Found"
91+
92+
93+
94+-- COMPILE ENDPOINT
95+
96+
97+compile :: Artifacts -> Snap ()
98+compile artifacts =
99+ applyCORS corsOptions $ method POST $
100+ do result <- foldMultipart defaultUploadPolicy ignoreFile 0
101+ case result of
102+ ([("code",source)], 0) ->
103+ do modifyResponse $ setContentType "text/html; charset=utf-8"
104+ case compileToBuilder artifacts source of
105+ Right builder -> writeBuilder builder
106+ Left exit -> writeBuilder (exitToHtmlBuilder exit)
107+
108+ _ ->
109+ do modifyResponse $ setResponseStatus 400 "Bad Request"
110+ modifyResponse $ setContentType "text/html; charset=utf-8"
111+ writeBS
112+ "<p>Unexpected request format. This should not be possible!</p>\
113+ \<p>Please report this\
114+ \ <a href=\"https://github.com/elm/compiler/issues\">here</a>\
115+ \ along with the URL and your browser version.</p>"
116+
117+
118+ignoreFile :: PartInfo -> Stream.InputStream B.ByteString -> Int -> IO Int
119+ignoreFile _ _ count =
120+ return (count + 1)
121+
122+
123+exitToHtmlBuilder :: Exit.Worker -> B.Builder
124+exitToHtmlBuilder exit =
125+ let
126+ json =
127+ Encode.encodeUgly $ Exit.toJson $ Exit.workerToReport exit
128+ in
129+ [r|<!DOCTYPE HTML>
130+<html>
131+<head>
132+ <meta charset="UTF-8">
133+ <style>body { padding: 0; margin: 0; background-color: black; }</style>
134+ <script src="https://worker.elm-lang.org/compile/errors.js"></script>
135+</head>
136+<body>
137+ <script>Elm.Errors.init({flags:|] <> json <> [r|});</script>
138+</body>
139+</html>|]
140+
141+
142+
143+-- COMPILE TO BUILDER
144+
145+
146+compileToBuilder :: Artifacts -> B.ByteString -> Either Exit.Worker B.Builder
147+compileToBuilder (Artifacts interfaces objects) source =
148+ case Parse.fromByteString Pkg.dummyName source of
149+ Left err ->
150+ Left $ toInputError N._Main source (Error.BadSyntax err)
151+
152+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
153+ case checkImports interfaces imports of
154+ Left err ->
155+ Left $ toInputError (Src.getName modul) source (Error.BadImports err)
156+
157+ Right ifaces ->
158+ case Compile.compile Pkg.dummyName ifaces modul of
159+ Left err ->
160+ Left $ toInputError (Src.getName modul) source err
161+
162+ Right (Compile.Artifacts canModule _ locals) ->
163+ case locals of
164+ Opt.LocalGraph Nothing _ _ ->
165+ Left Exit.WorkerNoMain
166+
167+ Opt.LocalGraph (Just main_) _ _ ->
168+ let
169+ mode = Mode.Dev Nothing
170+ home = Can._name canModule
171+ name = ModuleName._module home
172+ mains = Map.singleton home main_
173+ graph = Opt.addLocalGraph locals objects
174+ in
175+ Right $ Html.sandwich name $ Generate.generate mode graph mains
176+
177+
178+checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
179+checkImports interfaces imports =
180+ let
181+ importDict = Map.fromValues Src.getImportName imports
182+ missing = Map.difference importDict interfaces
183+ in
184+ case Map.elems missing of
185+ [] ->
186+ Right (Map.intersection interfaces importDict)
187+
188+ i:is ->
189+ let
190+ unimported = Map.keysSet (Map.difference interfaces importDict)
191+ toError (Src.Import (A.At region name) _ _) =
192+ Import.Error region name unimported Import.NotFound
193+ in
194+ Left (fmap toError (NE.List i is))
195+
196+
197+toInputError :: ModuleName.Raw -> B.ByteString -> Error.Error -> Exit.Worker
198+toInputError name source err =
199+ Exit.WorkerInputError $
200+ Error.Module name "/try" File.zeroTime source err
201+
202+
203+
204+-- COMPILE ERROR VIEWER
205+
206+
207+compileErrorViewer :: IO B.ByteString
208+compileErrorViewer =
209+ let
210+ run work =
211+ do result <- work
212+ case result of
213+ Right a -> return a
214+ Left _ -> error "problem building reactor/src/Errors.elm"
215+ in
216+ Dir.withCurrentDirectory "../reactor" $ BW.withScope $ \scope ->
217+ do let root = "."
218+ details <- run $ Details.load Reporting.silent scope root
219+ artifacts <- run $ Build.fromMains Reporting.silent root details (NE.List "src/Errors.elm" [])
220+ javascript <- run $ Task.run $ Generate.prod root details artifacts
221+ return $ LBS.toStrict $ B.toLazyByteString javascript
222+
223+
224+
225+-- CORS OPTIONS
226+
227+
228+corsOptions :: (Monad m) => CORSOptions m
229+corsOptions =
230+ let
231+ allowedOrigins = toOriginList [ "https://elm-lang.org", "https://package.elm-lang.org" ]
232+ allowedMethods = HashSet.singleton (HashableMethod POST)
233+ in
234+ CORSOptions
235+ { corsAllowOrigin = return allowedOrigins
236+ , corsAllowCredentials = return True
237+ , corsExposeHeaders = return HashSet.empty
238+ , corsAllowedMethods = return allowedMethods
239+ , corsAllowedHeaders = return
240+ }
241+
242+
243+toOriginList :: [String] -> OriginList
244+toOriginList origins =
245+ Origins $ mkOriginSet $
246+ case traverse parseURI origins of
247+ Just uris -> uris
248+ Nothing -> error "invalid entry given to toOriginList list"
249+
250+
251+
252+-- ARTIFACTS
253+
254+
255+data Artifacts =
256+ Artifacts
257+ { _ifaces :: Map.Map ModuleName.Raw I.Interface
258+ , _graph :: Opt.GlobalGraph
259+ }
260+
261+
262+loadArtifacts :: IO Artifacts
263+loadArtifacts =
264+ BW.withScope $ \scope ->
265+ do style <- Reporting.terminal
266+ root <- Dir.getCurrentDirectory
267+ result <- Details.load style scope root
268+ case result of
269+ Left _ ->
270+ error "Ran into some problem loading elm.json details"
271+
272+ Right details ->
273+ do omvar <- Details.loadObjects root details
274+ imvar <- Details.loadInterfaces root details
275+ mdeps <- readMVar imvar
276+ mobjs <- readMVar omvar
277+ case liftM2 (,) mdeps mobjs of
278+ Nothing ->
279+ error "Ran into some weird problem loading elm.json details"
280+
281+ Just (deps, objs) ->
282+ return $ Artifacts (toInterfaces deps) objs
283+
60
284
285+toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface
286+toInterfaces deps =
287+ Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $
288+ Map.elems (Map.mapMaybeWithKey getPublic deps)
61
289
62−serveJavaScript :: BS.ByteString -> Snap ()
63−serveJavaScript javascript =
64− do modifyResponse $ setContentType "application/javascript"
65− writeBS javascript
66
290
291+getPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface)
292+getPublic (ModuleName.Canonical _ name) dep =
293+ case dep of
294+ I.Public iface -> Just (name, OneOrMore.one iface)
295+ I.Private _ _ _ -> Nothing
67
296
68−serveDepsInfo :: BS.ByteString -> Snap ()
69−serveDepsInfo json =
70− Cors.allow GET ["https://elm-lang.org"] $
71− do modifyResponse $ setContentType "application/json"
72− writeBS json
73
297
298+toUnique :: OneOrMore.OneOrMore a -> Maybe a
299+toUnique oneOrMore =
300+ case oneOrMore of
301+ OneOrMore.One value -> Just value
302+ OneOrMore.More _ _ -> Nothing