on master help sign in
115 files changed+4160−1844
since splitsnapshots
unifiedsplit
.github/CONTRIBUTING.md+18−20 .github/PULL_REQUEST_TEMPLATE.md+18 .github/workflows/set-issue-expectations.yml+21 .github/workflows/set-pull-expectations.yml+19 .gitignore+1 .travis.yml+28 ContributorAgreement.pdf LICENSE+6−25 README.md+10−5 builder/src/Build.hs+230−195 builder/src/Elm/Details.hs+2−2 builder/src/Elm/Outline.hs+96−12 builder/src/Generate.hs+6−6 builder/src/Http.hs+1−1 builder/src/Reporting.hs+2−2 builder/src/Reporting/Exit.hs+44−60 builder/src/Reporting/Exit/Help.hs+5−5 builder/src/Stuff.hs+1−1 compiler/src/AST/Source.hs+5−5 compiler/src/AST/Utils/Type.hs−1 compiler/src/Canonicalize/Environment.hs+50−20 compiler/src/Canonicalize/Environment/Dups.hs+1−1 compiler/src/Canonicalize/Environment/Foreign.hs+49−37 compiler/src/Canonicalize/Environment/Local.hs+5−5 compiler/src/Canonicalize/Expression.hs+6−7 compiler/src/Canonicalize/Module.hs+7−7 compiler/src/Canonicalize/Pattern.hs+3−2 compiler/src/Data/Name.hs+1−1 compiler/src/Data/Utf8.hs+3−1 compiler/src/Elm/Compiler/Imports.hs+3−3 compiler/src/Elm/Kernel.hs+6−6 compiler/src/Elm/ModuleName.hs+2−6 compiler/src/Generate/Html.hs+4−8 compiler/src/Generate/JavaScript.hs+45−10 compiler/src/Optimize/Port.hs+1−1 compiler/src/Parse/Module.hs+81−35 compiler/src/Parse/Pattern.hs+1−1 compiler/src/Parse/Variable.hs+2−2 compiler/src/Reporting/Error.hs+20−16 compiler/src/Reporting/Error/Canonicalize.hs+21−16 compiler/src/Reporting/Error/Import.hs+1−1 compiler/src/Reporting/Error/Json.hs+16−4 compiler/src/Reporting/Error/Pattern.hs+2−2 compiler/src/Reporting/Error/Syntax.hs+963−516 compiler/src/Reporting/Error/Type.hs+23−7 compiler/src/Reporting/Render/Code.hs+65−24 compiler/src/Reporting/Render/Type/Localizer.hs+5−5 compiler/src/Type/Error.hs+8−2 compiler/src/Type/Unify.hs+5−8 docs/elm.json/application.md+2−2 docs/elm.json/package.md+1−1 upgrade-docs/0.16.md → docs/upgrade-instructions/0.16.md upgrade-docs/0.17.md → docs/upgrade-instructions/0.17.md upgrade-docs/0.18.md → docs/upgrade-instructions/0.18.md upgrade-docs/0.19.md → docs/upgrade-instructions/0.19.0.md docs/upgrade-instructions/0.19.1.md+60 upgrade-docs/earlier.md → docs/upgrade-instructions/earlier.md elm.cabal+6−5 hints/bad-recursion.md+26−29 hints/comparing-custom-types.md+98 hints/comparing-records.md+85 hints/implicit-casts.md+1−4 hints/import-cycles.md+1−1 hints/optimize.md+2−2 hints/recursive-alias.md+2−2 hints/type-annotations.md+1−3 installers/README.md+32 installers/linux/Dockerfile+33−18 installers/linux/README.md+93 installers/mac/Distribution.xml+5−3 installers/mac/README.md+93 installers/mac/Resources/en.lproj/background.png installers/mac/Resources/en.lproj/conclusion.rtf+13−6 installers/mac/Resources/en.lproj/welcome.rtf+9−4 installers/mac/helper-scripts/elm-startup.sh+1−1 installers/mac/make-installer.sh+30−3 installers/npm/PUBLISHING.md+29−141 installers/npm/README.md+30−23 installers/npm/bin/elm+42−17 installers/npm/download.js+68−68 installers/npm/install.js+1−7 installers/npm/package.json+6−7 installers/npm/troubleshooting.md+76 installers/win/Nsisfile.nsi+15−15 installers/win/README.md+18−3 installers/win/file.ico installers/win/inst.dat+1−2 installers/win/logo.ico installers/win/uninst.dat+1−2 installers/win/welcome.bmp roadmap.md+29 terminal/src/Terminal/Args.hs → terminal/impl/Terminal.hs+30−27 terminal/src/Terminal/Args/Chomp.hs → terminal/impl/Terminal/Chomp.hs+4−5 terminal/src/Terminal/Args/Error.hs → terminal/impl/Terminal/Error.hs+12−13 terminal/src/Terminal/Args/Helpers.hs → terminal/impl/Terminal/Helpers.hs+2−2 terminal/src/Terminal/Args/Internal.hs → terminal/impl/Terminal/Internal.hs+8−8 terminal/src/Develop.hs+5−2 terminal/src/Develop/Generate/Index.hs+1−1 terminal/src/Develop/StaticFiles/Build.hs+3−3 terminal/src/Init.hs+1−1 terminal/src/Main.hs+20−20 terminal/src/Make.hs+17−17 terminal/src/Publish.hs+2−7 terminal/src/Repl.hs+30−3 worker/elm.cabal+13 worker/elm.json+3−8 worker/outlines/compile/elm.json+32 worker/outlines/repl/elm.json+19 worker/src/Artifacts.hs+155 worker/src/Cors.hs+48 worker/src/Endpoint/Compile.hs+323 worker/src/Endpoint/Quotes.hs+114 worker/src/Endpoint/Repl.hs+244 worker/src/Errors.elm+217 worker/src/Main.hs+35−264
.github/CONTRIBUTING.md+18−20
@@ -4,10 +4,15 @@ Thanks helping with the development of Elm! This document describes the basic
44standards for opening pull requests and making the review process as smooth as
55possible.
66
7−## Licensing
87
9−You need to sign the [contributor agreement](ContributorAgreement.pdf)
10−and send it to <info@elm-lang.org> before opening your pull request.
8+## Expectations
9+
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+
1116
1217## Style Guide
1318
@@ -17,27 +22,20 @@ and send it to <info@elm-lang.org> before opening your pull request.
1722[haskell]: https://gist.github.com/evancz/0a1f3717c92fe71702be
1823[js]: https://google.github.io/styleguide/javascriptguide.xml
1924
20−## Branches
2125
22− * [The master branch][master] is the home of the next release of the compiler
23− so new features and improvements get merged there. Most pull requests
24− should target this branch!
26+## Branches
2527
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.
28+[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
30+should target this branch!
2931
3032[master]: http://github.com/elm-lang/elm/tree/master
31−[stable]: http://github.com/elm-lang/elm/tree/stable
3233
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.
3734
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.
35+## Licensing
36+
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+
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.
40+
4241
43−[website]: https://github.com/elm-lang/elm-lang.org
.github/PULL_REQUEST_TEMPLATE.mdnew file+18
@@ -0,0 +1,18 @@
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.ymlnew file+21
@@ -0,0 +1,21 @@
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.ymlnew file+19
@@ -0,0 +1,19 @@
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,3 +5,4 @@ cabal-dev
55cabal.sandbox.config
66.DS_Store
77*~
8+travis.log
.travis.ymlnew file+28
@@ -0,0 +1,28 @@
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.pdfdeleted

Binary file not shown.

LICENSE+6−25
@@ -1,30 +1,11 @@
1−Copyright (c) 2012-present, Evan Czaplicki
1+Copyright 2012-present Evan Czaplicki
22
3−All rights reserved.
3+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
44
5−Redistribution and use in source and binary forms, with or without
6−modification, are permitted provided that the following conditions are met:
5+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
76
8− * Redistributions of source code must retain the above copyright
9− notice, this list of conditions and the following disclaimer.
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.
108
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.
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.
1510
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.
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.
README.md+10−5
@@ -1,17 +1,22 @@
1−# The Elm Compiler
1+# Elm
22
3−Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/).
3+A delightful language for reliable webapps.
44
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>
59
610## Install
711
8−Follow [these instructions][installer]!
12+✨ [Install](https://guide.elm-lang.org/install/elm.html) ✨
913
10− [installer]: https://guide.elm-lang.org/install.html
14+For multiple versions, previous versions, and uninstallation, see the instructions [here](https://github.com/elm/compiler/blob/master/installers/README.md).
1115
16+<br>
1217
1318## Help
1419
1520If you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!
1621
17−[slack]: http://elmlang.herokuapp.com/
22+[slack]: http://elmlang.herokuapp.com/
builder/src/Build.hs+230−195
@@ -2,15 +2,15 @@
22{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}
33module Build
44 ( fromExposed
5− , fromMains
5+ , fromPaths
66 , fromRepl
77 , Artifacts(..)
8− , Main(..)
8+ , Root(..)
99 , Module(..)
1010 , CachedInterface(..)
1111 , ReplArtifacts(..)
1212 , DocsGoal(..)
13− , getMainNames
13+ , getRootNames
1414 )
1515 where
1616
@@ -42,6 +42,7 @@ import qualified Elm.Details as Details
4242import qualified Elm.Docs as Docs
4343import qualified Elm.Interface as I
4444import qualified Elm.ModuleName as ModuleName
45+import qualified Elm.Outline as Outline
4546import qualified Elm.Package as Pkg
4647import qualified File
4748import qualified Json.Encode as E
@@ -49,6 +50,7 @@ import qualified Parse.Module as Parse
4950import qualified Reporting
5051import qualified Reporting.Annotation as A
5152import qualified Reporting.Error as Error
53+import qualified Reporting.Error.Docs as EDocs
5254import qualified Reporting.Error.Syntax as Syntax
5355import qualified Reporting.Error.Import as Import
5456import qualified Reporting.Exit as Exit
@@ -64,22 +66,47 @@ data Env =
6466 Env
6567 { _key :: Reporting.BKey
6668 , _root :: FilePath
67− , _pkg :: Pkg.Name
68− , _srcDirs :: [FilePath]
69+ , _project :: Parse.ProjectType
70+ , _srcDirs :: [AbsoluteSrcDir]
6971 , _buildID :: Details.BuildID
7072 , _locals :: Map.Map ModuleName.Raw Details.Local
7173 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign
7274 }
7375
7476
75−makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env
77+makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env
7678makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =
7779 case validOutline of
78− Details.ValidApp srcDirs ->
79− Env key root Pkg.dummyName (NE.toList srcDirs) buildID locals foreigns
80+ Details.ValidApp givenSrcDirs ->
81+ do srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)
82+ return $ Env key root Parse.Application srcDirs buildID locals foreigns
8083
8184 Details.ValidPkg pkg _ _ ->
82− Env key root pkg ["src"] buildID locals foreigns
85+ do srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")
86+ return $ Env key root (Parse.Package pkg) [srcDir] 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
83110
84111
85112
@@ -110,7 +137,7 @@ forkWithKey func dict =
110137fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)
111138fromExposed style root details docsGoal exposed@(NE.List e es) =
112139 Reporting.trackBuild style $ \key ->
113− do let env = makeEnv key root details
140+ do env <- makeEnv key root details
114141 dmvar <- Details.loadInterfaces root details
115142
116143 -- crawl
@@ -133,18 +160,18 @@ fromExposed style root details docsGoal exposed@(NE.List e es) =
133160 putMVar rmvar resultMVars
134161 results <- traverse readMVar resultMVars
135162 writeDetails root details results
136− finalizeExposed docsGoal exposed results
163+ finalizeExposed root docsGoal exposed results
137164
138165
139166
140−-- FROM MAINS
167+-- FROM PATHS
141168
142169
143170data Artifacts =
144171 Artifacts
145172 { _name :: Pkg.Name
146173 , _deps :: Dependencies
147− , _mains :: NE.List Main
174+ , _roots :: NE.List Root
148175 , _modules :: [Module]
149176 }
150177
@@ -158,25 +185,25 @@ type Dependencies =
158185 Map.Map ModuleName.Canonical I.DependencyInterface
159186
160187
161−fromMains :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
162−fromMains style root details paths =
188+fromPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
189+fromPaths style root details paths =
163190 Reporting.trackBuild style $ \key ->
164− do let env = makeEnv key root details
191+ do env <- makeEnv key root details
165192
166− elmains <- findMains env paths
167− case elmains of
193+ elroots <- findRoots env paths
194+ case elroots of
168195 Left problem ->
169196 return (Left (Exit.BuildProjectProblem problem))
170197
171− Right lmains ->
198+ Right lroots ->
172199 do -- crawl
173200 dmvar <- Details.loadInterfaces root details
174201 smvar <- newMVar Map.empty
175− smainMVars <- traverse (fork . crawlMain env smvar) lmains
176− smains <- traverse readMVar smainMVars
202+ srootMVars <- traverse (fork . crawlRoot env smvar) lroots
203+ sroots <- traverse readMVar srootMVars
177204 statuses <- traverse readMVar =<< readMVar smvar
178205
179− midpoint <- checkMainsMidpoint dmvar statuses smains
206+ midpoint <- checkMidpointAndRoots dmvar statuses sroots
180207 case midpoint of
181208 Left problem ->
182209 return (Left (Exit.BuildProjectProblem problem))
@@ -186,24 +213,24 @@ fromMains style root details paths =
186213 rmvar <- newEmptyMVar
187214 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
188215 putMVar rmvar resultsMVars
189− rmainMVars <- traverse (fork . checkMain env resultsMVars) smains
216+ rrootMVars <- traverse (fork . checkRoot env resultsMVars) sroots
190217 results <- traverse readMVar resultsMVars
191218 writeDetails root details results
192− toArtifacts env foreigns results <$> traverse readMVar rmainMVars
219+ toArtifacts env foreigns results <$> traverse readMVar rrootMVars
193220
194221
195222
196−-- GET MAIN NAMES
223+-- GET ROOT NAMES
197224
198225
199−getMainNames :: Artifacts -> NE.List ModuleName.Raw
200−getMainNames (Artifacts _ _ mains _) =
201− fmap getMainName mains
226+getRootNames :: Artifacts -> NE.List ModuleName.Raw
227+getRootNames (Artifacts _ _ roots _) =
228+ fmap getRootName roots
202229
203230
204−getMainName :: Main -> ModuleName.Raw
205−getMainName main =
206− case main of
231+getRootName :: Root -> ModuleName.Raw
232+getRootName root =
233+ case root of
207234 Inside name -> name
208235 Outside name _ _ -> name
209236
@@ -239,11 +266,10 @@ crawlDeps env mvar deps blockedValue =
239266
240267
241268crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status
242−crawlModule env@(Env _ root pkg srcDirs buildID locals foreigns) mvar docsNeed name =
269+crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name =
243270 do let fileName = ModuleName.toFilePath name <.> "elm"
244− let inRoot path = File.exists (root </> path)
245271
246− paths <- filterM inRoot (map (</> fileName) srcDirs)
272+ paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)
247273
248274 case paths of
249275 [path] ->
@@ -263,7 +289,7 @@ crawlModule env@(Env _ root pkg srcDirs buildID locals foreigns) mvar docsNeed n
263289 else crawlDeps env mvar deps (SCached local)
264290
265291 p1:p2:ps ->
266− return $ SBadImport $ Import.AmbiguousLocal p1 p2 ps
292+ return $ SBadImport $ Import.AmbiguousLocal (FP.makeRelative root p1) (FP.makeRelative root p2) (map (FP.makeRelative root) ps)
267293
268294 [] ->
269295 case Map.lookup name foreigns of
@@ -276,7 +302,7 @@ crawlModule env@(Env _ root pkg srcDirs buildID locals foreigns) mvar docsNeed n
276302 return $ SBadImport $ Import.AmbiguousForeign dep d ds
277303
278304 Nothing ->
279− if Name.isKernel name && Pkg.isKernel pkg then
305+ if Name.isKernel name && Parse.isKernel projectType then
280306 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
281307 return $ if exists then SKernel else SBadImport Import.NotFound
282308 else
@@ -284,10 +310,10 @@ crawlModule env@(Env _ root pkg srcDirs buildID locals foreigns) mvar docsNeed n
284310
285311
286312crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> File.Time -> Details.BuildID -> IO Status
287−crawlFile env@(Env _ root pkg _ buildID _ _) mvar docsNeed expectedName path time lastChange =
313+crawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName path time lastChange =
288314 do source <- File.readUtf8 (root </> path)
289315
290− case Parse.fromByteString pkg source of
316+ case Parse.fromByteString projectType source of
291317 Left err ->
292318 return $ SBadSyntax path time source err
293319
@@ -338,7 +364,7 @@ data CachedInterface
338364
339365
340366checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result
341−checkModule env@(Env _ root pkg _ _ _ _) foreigns resultsMVar name status =
367+checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name status =
342368 case status of
343369 SCached local@(Details.Local path time deps hasMain lastChange lastCompile) ->
344370 do results <- readMVar resultsMVar
@@ -346,7 +372,7 @@ checkModule env@(Env _ root pkg _ _ _ _) foreigns resultsMVar name status =
346372 case depsStatus of
347373 DepsChange ifaces ->
348374 do source <- File.readUtf8 path
349− case Parse.fromByteString pkg source of
375+ case Parse.fromByteString projectType source of
350376 Right modul -> compile env (DocsNeed False) local source ifaces modul
351377 Left err ->
352378 return $ RProblem $
@@ -362,7 +388,7 @@ checkModule env@(Env _ root pkg _ _ _ _) foreigns resultsMVar name status =
362388 DepsNotFound problems ->
363389 do source <- File.readUtf8 path
364390 return $ RProblem $ Error.Module name path time source $
365− case Parse.fromByteString pkg source of
391+ case Parse.fromByteString projectType source of
366392 Right (Src.Module _ _ _ imports _ _ _ _ _) ->
367393 Error.BadImports (toImportErrors env results imports problems)
368394
@@ -559,11 +585,11 @@ checkMidpoint dmvar statuses =
559585 return (Left (Exit.BP_Cycle name names))
560586
561587
562−checkMainsMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List MainStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
563−checkMainsMidpoint dmvar statuses smains =
588+checkMidpointAndRoots :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List RootStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
589+checkMidpointAndRoots dmvar statuses sroots =
564590 case checkForCycles statuses of
565591 Nothing ->
566− case checkUniqueMains statuses smains of
592+ case checkUniqueRoots statuses sroots of
567593 Nothing ->
568594 do maybeForeigns <- readMVar dmvar
569595 case maybeForeigns of
@@ -625,14 +651,14 @@ addToGraph name status graph =
625651
626652
627653
628−-- CHECK UNIQUE MAINS
654+-- CHECK UNIQUE ROOTS
629655
630656
631−checkUniqueMains :: Map.Map ModuleName.Raw Status -> NE.List MainStatus -> Maybe Exit.BuildProjectProblem
632−checkUniqueMains insides smains =
657+checkUniqueRoots :: Map.Map ModuleName.Raw Status -> NE.List RootStatus -> Maybe Exit.BuildProjectProblem
658+checkUniqueRoots insides sroots =
633659 let
634660 outsidesDict =
635− Map.fromListWith OneOrMore.more (Maybe.mapMaybe mainStatusToNamePathPair (NE.toList smains))
661+ Map.fromListWith OneOrMore.more (Maybe.mapMaybe rootStatusToNamePathPair (NE.toList sroots))
636662 in
637663 case Map.traverseWithKey checkOutside outsidesDict of
638664 Left problem ->
@@ -644,9 +670,9 @@ checkUniqueMains insides smains =
644670 Left problem -> Just problem
645671
646672
647−mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
648−mainStatusToNamePathPair smain =
649− case smain of
673+rootStatusToNamePathPair :: RootStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
674+rootStatusToNamePathPair sroot =
675+ case sroot of
650676 SInside _ -> Nothing
651677 SOutsideOk (Details.Local path _ _ _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
652678 SOutsideErr _ -> Nothing
@@ -656,14 +682,14 @@ checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.Bu
656682checkOutside name paths =
657683 case OneOrMore.destruct NE.List paths of
658684 NE.List p [] -> Right p
659− NE.List p1 (p2:_) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
685+ NE.List p1 (p2:_) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
660686
661687
662688checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
663689checkInside name p1 status =
664690 case status of
665− SCached (Details.Local p2 _ _ _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
666− SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
691+ SCached (Details.Local p2 _ _ _ _ _) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
692+ SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_RootNameDuplicate name p1 p2)
667693 SBadImport _ -> Right ()
668694 SBadSyntax _ _ _ _ -> Right ()
669695 SForeign _ -> Right ()
@@ -675,34 +701,49 @@ checkInside name p1 status =
675701
676702
677703compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
678−compile (Env key root pkg _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =
704+compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =
705+ let
706+ pkg = projectTypeToPkg projectType
707+ in
679708 case Compile.compile pkg ifaces modul of
680709 Right (Compile.Artifacts canonical annotations objects) ->
681− do let name = Src.getName modul
682− let iface = I.fromModule pkg canonical annotations
683− let docs = makeDocs docsNeed canonical
684− let elmi = Stuff.elmi root name
685− File.writeBinary (Stuff.elmo root name) objects
686− maybeOldi <- File.readBinary elmi
687− case maybeOldi of
688− Just oldi | oldi == iface ->
689− do -- iface should be fully forced by equality check
690− Reporting.report key Reporting.BDone
691− let local = Details.Local path time deps main lastChange buildID
692− return (RSame local iface objects docs)
693−
694− _ ->
695− do -- iface may be lazy still
696− File.writeBinary elmi iface
697− Reporting.report key Reporting.BDone
698− let local = Details.Local path time deps main buildID buildID
699− return (RNew local iface objects docs)
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
717+ let iface = I.fromModule pkg canonical annotations
718+ let elmi = Stuff.elmi root name
719+ File.writeBinary (Stuff.elmo root name) objects
720+ maybeOldi <- File.readBinary elmi
721+ case maybeOldi of
722+ Just oldi | oldi == iface ->
723+ do -- iface should be fully forced by equality check
724+ Reporting.report key Reporting.BDone
725+ let local = Details.Local path time deps main lastChange buildID
726+ return (RSame local iface objects docs)
727+
728+ _ ->
729+ do -- iface may be lazy still
730+ File.writeBinary elmi iface
731+ Reporting.report key Reporting.BDone
732+ let local = Details.Local path time deps main buildID buildID
733+ return (RNew local iface objects docs)
700734
701735 Left err ->
702736 return $ RProblem $
703737 Error.Module (Src.getName modul) path time source err
704738
705739
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+
706747
707748-- WRITE DETAILS
708749
@@ -730,8 +771,8 @@ addNewLocal name result locals =
730771-- FINALIZE EXPOSED
731772
732773
733−finalizeExposed :: DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
734−finalizeExposed docsGoal exposed results =
774+finalizeExposed :: FilePath -> DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
775+finalizeExposed root docsGoal exposed results =
735776 case foldr (addImportProblems results) [] (NE.toList exposed) of
736777 p:ps ->
737778 return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))
@@ -739,7 +780,7 @@ finalizeExposed docsGoal exposed results =
739780 [] ->
740781 case Map.foldr addErrors [] results of
741782 [] -> Right <$> finalizeDocs docsGoal results
742− e:es -> return $ Left $ Exit.BuildBadModules e es
783+ e:es -> return $ Left $ Exit.BuildBadModules root e es
743784
744785
745786addErrors :: Result -> [Error.Module] -> [Error.Module]
@@ -790,14 +831,14 @@ toDocsNeed goal =
790831 KeepDocs -> DocsNeed True
791832
792833
793−makeDocs :: DocsNeed -> Can.Module -> Maybe Docs.Module
834+makeDocs :: DocsNeed -> Can.Module -> Either EDocs.Error (Maybe Docs.Module)
794835makeDocs (DocsNeed isNeeded) modul =
795836 if isNeeded then
796837 case Docs.fromModule modul of
797− Right docs -> Just docs
798− Left _ -> Nothing
838+ Right docs -> Right (Just docs)
839+ Left err -> Left err
799840 else
800− Nothing
841+ Right Nothing
801842
802843
803844finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs
@@ -846,40 +887,41 @@ data ReplArtifacts =
846887
847888fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
848889fromRepl root details source =
849− let
850− env@(Env _ _ pkg _ _ _ _) = makeEnv Reporting.ignorer root details
851− in
852− case Parse.fromByteString pkg source of
853− Left syntaxError ->
854− return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
890+ do env@(Env _ _ projectType _ _ _ _) <- makeEnv Reporting.ignorer root details
891+ case Parse.fromByteString projectType source of
892+ Left syntaxError ->
893+ return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
855894
856− Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
857− do dmvar <- Details.loadInterfaces root details
895+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
896+ do dmvar <- Details.loadInterfaces root details
858897
859− let deps = map Src.getImportName imports
860− mvar <- newMVar Map.empty
861− crawlDeps env mvar deps ()
898+ let deps = map Src.getImportName imports
899+ mvar <- newMVar Map.empty
900+ crawlDeps env mvar deps ()
862901
863− statuses <- traverse readMVar =<< readMVar mvar
864− midpoint <- checkMidpoint dmvar statuses
902+ statuses <- traverse readMVar =<< readMVar mvar
903+ midpoint <- checkMidpoint dmvar statuses
865904
866− case midpoint of
867− Left problem ->
868− return $ Left $ Exit.ReplProjectProblem problem
905+ case midpoint of
906+ Left problem ->
907+ return $ Left $ Exit.ReplProjectProblem problem
869908
870− Right foreigns ->
871− do rmvar <- newEmptyMVar
872− resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
873− putMVar rmvar resultMVars
874− results <- traverse readMVar resultMVars
875− writeDetails root details results
876− depsStatus <- checkDeps root resultMVars deps 0
877− finalizeReplArtifacts env source modul depsStatus resultMVars results
909+ Right foreigns ->
910+ do rmvar <- newEmptyMVar
911+ resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
912+ putMVar rmvar resultMVars
913+ results <- traverse readMVar resultMVars
914+ writeDetails root details results
915+ depsStatus <- checkDeps root resultMVars deps 0
916+ finalizeReplArtifacts env source modul depsStatus resultMVars results
878917
879918
880919finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
881−finalizeReplArtifacts env@(Env _ root pkg _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
920+finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
882921 let
922+ pkg =
923+ projectTypeToPkg projectType
924+
883925 compileInput ifaces =
884926 case Compile.compile pkg ifaces modul of
885927 Right (Compile.Artifacts canonical annotations objects) ->
@@ -906,7 +948,7 @@ finalizeReplArtifacts env@(Env _ root pkg _ _ _ _) source modul@(Src.Module _ _
906948 DepsBlock ->
907949 case Map.foldr addErrors [] results of
908950 [] -> return $ Left $ Exit.ReplBlocked
909− e:es -> return $ Left $ Exit.ReplBadLocalDeps e es
951+ e:es -> return $ Left $ Exit.ReplBadLocalDeps root e es
910952
911953 DepsNotFound problems ->
912954 return $ Left $ Exit.ReplBadInput source $ Error.BadImports $
@@ -922,25 +964,25 @@ finalizeReplArtifacts env@(Env _ root pkg _ _ _ _) source modul@(Src.Module _ _
922964
923965
924966
925−-- FIND MAIN
967+-- FIND ROOT
926968
927969
928−data MainLocation
970+data RootLocation
929971 = LInside ModuleName.Raw
930972 | LOutside FilePath
931973
932974
933−findMains :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List MainLocation))
934−findMains env paths =
935− do mvars <- traverse (fork . findLocation env) paths
936− elocs <- traverse readMVar mvars
937− return $ checkLocations =<< sequence elocs
975+findRoots :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List RootLocation))
976+findRoots env paths =
977+ do mvars <- traverse (fork . getRootInfo env) paths
978+ einfos <- traverse readMVar mvars
979+ return $ checkRoots =<< sequence einfos
938980
939981
940−checkLocations :: NE.List Location -> Either Exit.BuildProjectProblem (NE.List MainLocation)
941−checkLocations locations =
982+checkRoots :: NE.List RootInfo -> Either Exit.BuildProjectProblem (NE.List RootLocation)
983+checkRoots infos =
942984 let
943− toOneOrMore loc@(Location absolute _ _) =
985+ toOneOrMore loc@(RootInfo absolute _ _) =
944986 (absolute, OneOrMore.one loc)
945987
946988 fromOneOrMore loc locs =
@@ -948,33 +990,33 @@ checkLocations locations =
948990 [] -> Right ()
949991 loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))
950992 in
951− fmap (\_ -> fmap _location locations) $
993+ fmap (\_ -> fmap _location infos) $
952994 traverse (OneOrMore.destruct fromOneOrMore) $
953− Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList locations)
995+ Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList infos)
954996
955997
956998
957−-- LOCATIONS
999+-- ROOT INFO
9581000
9591001
960−data Location =
961− Location
1002+data RootInfo =
1003+ RootInfo
9621004 { _absolute :: FilePath
9631005 , _relative :: FilePath
964− , _location :: MainLocation
1006+ , _location :: RootLocation
9651007 }
9661008
9671009
968−findLocation :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem Location)
969−findLocation env path =
1010+getRootInfo :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
1011+getRootInfo env path =
9701012 do exists <- File.exists path
9711013 if exists
972− then findLoc env path =<< Dir.canonicalizePath path
1014+ then getRootInfoHelp env path =<< Dir.canonicalizePath path
9731015 else return (Left (Exit.BP_PathUnknown path))
9741016
9751017
976−findLoc :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem Location)
977−findLoc (Env _ root _ srcDirs _ _ _) path absolutePath =
1018+getRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
1019+getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
9781020 let
9791021 (dirs, file) = FP.splitFileName absolutePath
9801022 (final, ext) = FP.splitExtension file
@@ -984,45 +1026,39 @@ findLoc (Env _ root _ srcDirs _ _ _) path absolutePath =
9841026 return $ Left $ Exit.BP_WithBadExtension path
9851027 else
9861028 let
987− roots = FP.splitDirectories root
988− segments = FP.splitDirectories dirs ++ [final]
1029+ absoluteSegments = FP.splitDirectories dirs ++ [final]
9891030 in
990− case dropPrefix roots segments of
991− Nothing ->
992− return $ Right $ Location absolutePath path (LOutside path)
1031+ case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of
1032+ [] ->
1033+ return $ Right $ RootInfo absolutePath path (LOutside path)
9931034
994− Just relativeSegments ->
995− case Maybe.mapMaybe (isInsideSrcDirByPath relativeSegments) srcDirs of
996− [] ->
997− return $ Right $ Location absolutePath path (LOutside path)
1035+ [(_, Right names)] ->
1036+ do let name = Name.fromChars (List.intercalate "." names)
1037+ matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs
1038+ case matchingDirs of
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
9981043
999− [(_, Right names)] ->
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
1044+ _ ->
1045+ return $ Right $ RootInfo absolutePath path (LInside name)
10071046
1008− _ ->
1009− return $ Right $ Location absolutePath path (LInside name)
1047+ [(s, Left names)] ->
1048+ return $ Left $ Exit.BP_RootNameInvalid path s names
10101049
1011− [(s, Left names)] ->
1012− return $ Left $ Exit.BP_MainNameInvalid path s names
1050+ (s1,_):(s2,_):_ ->
1051+ return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
10131052
1014− (s1,_):(s2,_):_ ->
1015− return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
10161053
10171054
1055+isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
1056+isInsideSrcDirByName names srcDir =
1057+ File.exists (addRelative srcDir (FP.joinPath names <.> "elm"))
10181058
1019−isInsideSrcDirByName :: FilePath -> [String] -> FilePath -> IO Bool
1020−isInsideSrcDirByName root names srcDir =
1021− File.exists (root </> srcDir </> FP.joinPath names <.> "elm")
10221059
1023−
1024−isInsideSrcDirByPath :: [String] -> FilePath -> Maybe (FilePath, Either [String] [String])
1025−isInsideSrcDirByPath segments srcDir =
1060+isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])
1061+isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
10261062 case dropPrefix (FP.splitDirectories srcDir) segments of
10271063 Nothing ->
10281064 Nothing
@@ -1043,35 +1079,33 @@ isGoodName name =
10431079 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars
10441080
10451081
1082+-- INVARIANT: Dir.canonicalizePath has been run on both inputs
1083+--
10461084dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]
10471085dropPrefix roots paths =
10481086 case roots of
10491087 [] ->
10501088 Just paths
10511089
1052− ".":rs ->
1053− dropPrefix rs paths
1054−
10551090 r:rs ->
10561091 case paths of
1057− [] -> Nothing
1058− ".":ps -> dropPrefix roots ps
1059− p:ps -> if r == p then dropPrefix rs ps else Nothing
1092+ [] -> Nothing
1093+ p:ps -> if r == p then dropPrefix rs ps else Nothing
10601094
10611095
10621096
1063−-- CRAWL MAINS
1097+-- CRAWL ROOTS
10641098
10651099
1066−data MainStatus
1100+data RootStatus
10671101 = SInside ModuleName.Raw
10681102 | SOutsideOk Details.Local B.ByteString Src.Module
10691103 | SOutsideErr Error.Module
10701104
10711105
1072−crawlMain :: Env -> MVar StatusDict -> MainLocation -> IO MainStatus
1073−crawlMain env@(Env _ _ pkg _ buildID _ _) mvar given =
1074− case given of
1106+crawlRoot :: Env -> MVar StatusDict -> RootLocation -> IO RootStatus
1107+crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
1108+ case root of
10751109 LInside name ->
10761110 do statusMVar <- newEmptyMVar
10771111 statusDict <- takeMVar mvar
@@ -1082,7 +1116,7 @@ crawlMain env@(Env _ _ pkg _ buildID _ _) mvar given =
10821116 LOutside path ->
10831117 do time <- File.getTime path
10841118 source <- File.readUtf8 path
1085− case Parse.fromByteString pkg source of
1119+ case Parse.fromByteString projectType source of
10861120 Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->
10871121 do let deps = map Src.getImportName imports
10881122 let local = Details.Local path time deps (any isMain values) buildID buildID
@@ -1094,19 +1128,19 @@ crawlMain env@(Env _ _ pkg _ buildID _ _) mvar given =
10941128
10951129
10961130
1097−-- CHECK MAINS
1131+-- CHECK ROOTS
10981132
10991133
1100−data MainResult
1134+data RootResult
11011135 = RInside ModuleName.Raw
11021136 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph
11031137 | ROutsideErr Error.Module
11041138 | ROutsideBlocked
11051139
11061140
1107−checkMain :: Env -> ResultDict -> MainStatus -> IO MainResult
1108−checkMain env@(Env _ root _ _ _ _ _) results pendingMain =
1109− case pendingMain of
1141+checkRoot :: Env -> ResultDict -> RootStatus -> IO RootResult
1142+checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =
1143+ case rootStatus of
11101144 SInside name ->
11111145 return (RInside name)
11121146
@@ -1133,9 +1167,10 @@ checkMain env@(Env _ root _ _ _ _ _) results pendingMain =
11331167 Error.BadImports (toImportErrors env results imports problems)
11341168
11351169
1136−compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO MainResult
1137−compileOutside (Env key _ pkg _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =
1170+compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO RootResult
1171+compileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =
11381172 let
1173+ pkg = projectTypeToPkg projectType
11391174 name = Src.getName modul
11401175 in
11411176 case Compile.compile pkg ifaces modul of
@@ -1151,35 +1186,35 @@ compileOutside (Env key _ pkg _ _ _ _) (Details.Local path time _ _ _ _) source
11511186-- TO ARTIFACTS
11521187
11531188
1154−data Main
1189+data Root
11551190 = Inside ModuleName.Raw
11561191 | Outside ModuleName.Raw I.Interface Opt.LocalGraph
11571192
11581193
1159−toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either Exit.BuildProblem Artifacts
1160−toArtifacts (Env _ _ pkg _ _ _ _) foreigns results mainResults =
1161− case gatherProblemsOrMains results mainResults of
1194+toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either Exit.BuildProblem Artifacts
1195+toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults =
1196+ case gatherProblemsOrMains results rootResults of
11621197 Left (NE.List e es) ->
1163− Left (Exit.BuildBadModules e es)
1198+ Left (Exit.BuildBadModules root e es)
11641199
1165− Right mains ->
1166− Right $ Artifacts pkg foreigns mains $
1167− Map.foldrWithKey addInside (foldr addOutside [] mainResults) results
1200+ Right roots ->
1201+ Right $ Artifacts (projectTypeToPkg projectType) foreigns roots $
1202+ Map.foldrWithKey addInside (foldr addOutside [] rootResults) results
11681203
11691204
1170−gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either (NE.List Error.Module) (NE.List Main)
1171−gatherProblemsOrMains results (NE.List mainResult mainResults) =
1205+gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either (NE.List Error.Module) (NE.List Root)
1206+gatherProblemsOrMains results (NE.List rootResult rootResults) =
11721207 let
1173− sortMain result (es, mains) =
1208+ addResult result (es, roots) =
11741209 case result of
1175− RInside n -> ( es, Inside n : mains)
1176− ROutsideOk n i o -> ( es, Outside n i o : mains)
1177− ROutsideErr e -> (e:es, mains)
1178− ROutsideBlocked -> ( es, mains)
1210+ RInside n -> ( es, Inside n : roots)
1211+ ROutsideOk n i o -> ( es, Outside n i o : roots)
1212+ ROutsideErr e -> (e:es, roots)
1213+ ROutsideBlocked -> ( es, roots)
11791214
11801215 errors = Map.foldr addErrors [] results
11811216 in
1182− case (mainResult, foldr sortMain (errors, []) mainResults) of
1217+ case (rootResult, foldr addResult (errors, []) rootResults) of
11831218 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)
11841219 (RInside _ , (e:es, _ )) -> Left (NE.List e es)
11851220 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
@@ -1207,9 +1242,9 @@ badInside name =
12071242 "Error from `" ++ Name.toChars name ++ "` should have been reported already."
12081243
12091244
1210−addOutside :: MainResult -> [Module] -> [Module]
1211−addOutside main modules =
1212− case main of
1245+addOutside :: RootResult -> [Module] -> [Module]
1246+addOutside root modules =
1247+ case root of
12131248 RInside _ -> modules
12141249 ROutsideOk name iface objs -> Fresh name iface objs : modules
12151250 ROutsideErr _ -> modules
builder/src/Elm/Details.hs+2−2
@@ -79,7 +79,7 @@ type BuildID = Word64
7979
8080
8181data ValidOutline
82− = ValidApp (NE.List FilePath)
82+ = ValidApp (NE.List Outline.SrcDir)
8383 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})
8484
8585
@@ -595,7 +595,7 @@ crawlModule foreignDeps mvar pkg src docsStatus name =
595595crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
596596crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
597597 do bytes <- File.readUtf8 path
598− case Parse.fromByteString pkg bytes of
598+ case Parse.fromByteString (Parse.Package pkg) bytes of
599599 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->
600600 do deps <- crawlImports foreignDeps mvar pkg src imports
601601 return (Just (SLocal docsStatus deps modul))
builder/src/Elm/Outline.hs+96−12
@@ -5,6 +5,7 @@ module Elm.Outline
55 , AppOutline(..)
66 , PkgOutline(..)
77 , Exposed(..)
8+ , SrcDir(..)
89 , read
910 , write
1011 , encode
@@ -16,11 +17,14 @@ module Elm.Outline
1617
1718
1819import Prelude hiding (read)
19−import Control.Monad (filterM)
20+import Control.Monad (filterM, liftM)
21+import Data.Binary (Binary, get, put, getWord8, putWord8)
2022import qualified Data.Map as Map
2123import qualified Data.NonEmptyList as NE
24+import qualified Data.OneOrMore as OneOrMore
2225import Foreign.Ptr (minusPtr)
2326import qualified System.Directory as Dir
27+import qualified System.FilePath as FP
2428import System.FilePath ((</>))
2529
2630import qualified Elm.Constraint as Con
@@ -49,7 +53,7 @@ data Outline
4953data AppOutline =
5054 AppOutline
5155 { _app_elm_version :: V.Version
52− , _app_source_dirs :: NE.List FilePath
56+ , _app_source_dirs :: NE.List SrcDir
5357 , _app_deps_direct :: Map.Map Pkg.Name V.Version
5458 , _app_deps_indirect :: Map.Map Pkg.Name V.Version
5559 , _app_test_direct :: Map.Map Pkg.Name V.Version
@@ -75,6 +79,11 @@ data Exposed
7579 | ExposedDict [(Json.String, [ModuleName.Raw])]
7680
7781
82+data SrcDir
83+ = AbsoluteSrcDir FilePath
84+ | RelativeSrcDir FilePath
85+
86+
7887
7988-- DEFAULTS
8089
@@ -117,7 +126,7 @@ encode outline =
117126 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->
118127 E.object
119128 [ "type" ==> E.chars "application"
120− , "source-directories" ==> E.list E.chars (NE.toList srcDirs)
129+ , "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs)
121130 , "elm-version" ==> V.encode elm
122131 , "dependencies" ==>
123132 E.object
@@ -165,6 +174,13 @@ encodeDeps encodeValue deps =
165174 E.dict Pkg.toJsonString encodeValue deps
166175
167176
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+
168184
169185-- PARSE AND VERIFY
170186
@@ -192,15 +208,58 @@ read root =
192208 return $ Left Exit.OutlineNoAppJson
193209
194210 | otherwise ->
195− do badDirs <- filterM (isBadSrcDir root) (NE.toList srcDirs)
196− case badDirs of
197− [] -> return $ Right outline
198− d:ds -> return $ Left (Exit.OutlineHasBadSrcDirs d ds)
211+ do badDirs <- filterM (isSrcDirMissing root) (NE.toList srcDirs)
212+ case map toGiven 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
221+
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
199243
200244
201−isBadSrcDir :: FilePath -> FilePath -> IO Bool
202−isBadSrcDir root dir =
203− not <$> Dir.doesDirectoryExist (root </> dir)
245+detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))
246+detectDuplicates root srcDirs =
247+ do pairs <- traverse (toPair root) srcDirs
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)
204263
205264
206265
@@ -278,9 +337,16 @@ depsDecoder valueDecoder =
278337 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder
279338
280339
281−dirsDecoder :: Decoder (NE.List FilePath)
340+dirsDecoder :: Decoder (NE.List SrcDir)
282341dirsDecoder =
283− fmap Json.toChars <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs
342+ fmap (toSrcDir . 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
284350
285351
286352
@@ -321,3 +387,21 @@ boundParser bound tooLong =
321387 if len < bound
322388 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)
323389 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) =
9999-- GATHER MAINS
100100
101101
102−gatherMains :: Pkg.Name -> Objects -> NE.List Build.Main -> Map.Map ModuleName.Canonical Opt.Main
103−gatherMains pkg (Objects _ locals) buildMains =
104− Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList buildMains)
102+gatherMains :: Pkg.Name -> Objects -> NE.List Build.Root -> Map.Map ModuleName.Canonical Opt.Main
103+gatherMains pkg (Objects _ locals) roots =
104+ Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList roots)
105105
106106
107−lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Main -> Maybe (ModuleName.Canonical, Opt.Main)
108−lookupMain pkg locals buildMain =
107+lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Root -> Maybe (ModuleName.Canonical, Opt.Main)
108+lookupMain pkg locals root =
109109 let
110110 toPair name (Opt.LocalGraph maybeMain _ _) =
111111 (,) (ModuleName.Canonical pkg name) <$> maybeMain
112112 in
113− case buildMain of
113+ case root of
114114 Build.Inside name -> toPair name =<< Map.lookup name locals
115115 Build.Outside name _ g -> toPair name g
116116
builder/src/Http.hs+1−1
@@ -241,4 +241,4 @@ jsonPart name filePath value =
241241
242242stringPart :: String -> String -> Multi.Part
243243stringPart 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 =
364364
365365 Left problem ->
366366 case problem of
367− Exit.BuildBadModules _ [] ->
367+ Exit.BuildBadModules _ _ [] ->
368368 "Detected problems in 1 module."
369369
370− Exit.BuildBadModules _ (_:ps) ->
370+ Exit.BuildBadModules _ _ (_:ps) ->
371371 "Detected problems in " ++ show (2 + length ps) ++ " modules."
372372
373373 Exit.BuildProjectProblem _ ->
builder/src/Reporting/Exit.hs+44−60
@@ -8,7 +8,6 @@ module Reporting.Exit
88 , Publish(..), publishToReport
99 , Install(..), installToReport
1010 , Reactor(..), reactorToReport
11− , Worker(..), workerToReport
1211 , newPackageOverview
1312 --
1413 , Solver(..)
@@ -948,7 +947,8 @@ toSolverReport problem =
948947
949948data Outline
950949 = OutlineHasBadStructure (Decode.Error OutlineProblem)
951− | OutlineHasBadSrcDirs FilePath [FilePath]
950+ | OutlineHasMissingSrcDirs FilePath [FilePath]
951+ | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath
952952 | OutlineNoPkgCore
953953 | OutlineNoAppCore
954954 | OutlineNoAppJson
@@ -974,12 +974,12 @@ toOutlineReport problem =
974974 Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $
975975 Json.ExplicitReason "I ran into a problem with your elm.json file."
976976
977− OutlineHasBadSrcDirs dir dirs ->
977+ OutlineHasMissingSrcDirs dir dirs ->
978978 case dirs of
979979 [] ->
980980 Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")
981981 "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"
982− [ D.indent 4 $ D.dullyellow $ D.fromChars dir
982+ [ D.indent 4 $ D.red $ D.fromChars dir
983983 , D.reflow $
984984 "I cannot find it though. Is it missing? Is there a typo?"
985985 ]
@@ -987,11 +987,33 @@ toOutlineReport problem =
987987 _:_ ->
988988 Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")
989989 "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"
990− [ D.indent 4 $ D.dullyellow $ D.fromChars dir
990+ [ D.indent 4 $ D.vcat $
991+ map (D.red . D.fromChars) (dir:dirs)
991992 , D.reflow $
992993 "I cannot find them though. Are they missing? Are there typos?"
993994 ]
994995
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+
9951017 OutlineNoPkgCore ->
9961018 Help.report "MISSING DEPENDENCY" (Just "elm.json")
9971019 "I need to see an \"elm/core\" dependency your elm.json file. The default imports\
@@ -1260,8 +1282,7 @@ toDetailsReport details =
12601282 "The dependencies in your elm.json are not compatible."
12611283 [ D.fillSep
12621284 ["Did","you","change","them","by","hand?","Try","to","change","it","back!"
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" <> "."
1285+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
12651286 ]
12661287 , D.reflow $
12671288 "Please ask for help on the community forums if you try those paths and are still\
@@ -1278,8 +1299,7 @@ toDetailsReport details =
12781299 \ get access to the registry!"
12791300 , D.toFancyNote
12801301 ["If","you","changed","your","dependencies","by","hand,","try","to","change","them","back!"
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" <> "."
1302+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
12831303 ]
12841304 ]
12851305
@@ -1315,8 +1335,7 @@ toDetailsReport details =
13151335 \ party tool) leaving them in an invalid state."
13161336 [ D.fillSep
13171337 ["Try","to","change","them","back","to","what","they","were","before!"
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" <> "."
1338+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
13201339 ]
13211340 , D.reflow $
13221341 "Please ask for help on the community forums if you try those paths and are still\
@@ -1503,7 +1522,7 @@ toHttpErrorReport title err context =
15031522
15041523 Http.BadHttp url httpExceptionContent ->
15051524 case httpExceptionContent of
1506− HTTP.StatusCodeException response _ ->
1525+ HTTP.StatusCodeException response body ->
15071526 let
15081527 (HTTP.Status code message) = HTTP.responseStatus response
15091528 in
@@ -1511,6 +1530,7 @@ toHttpErrorReport title err context =
15111530 [ D.fillSep $
15121531 ["But","it","came","back","as",D.red (D.fromInt code)]
15131532 ++ map D.fromChars (words (BS_UTF8.toString message))
1533+ , D.indent 4 $ D.reflow $ BS_UTF8.toString body
15141534 , D.reflow $
15151535 "This may mean some online endpoint changed in an unexpected way, so if does not\
15161536 \ seem like something on your side is causing this (e.g. firewall) please report\
@@ -1736,7 +1756,7 @@ makeToReport make =
17361756
17371757
17381758data BuildProblem
1739− = BuildBadModules Error.Module [Error.Module]
1759+ = BuildBadModules FilePath Error.Module [Error.Module]
17401760 | BuildProjectProblem BuildProjectProblem
17411761
17421762
@@ -1745,8 +1765,8 @@ data BuildProjectProblem
17451765 | BP_WithBadExtension FilePath
17461766 | BP_WithAmbiguousSrcDir FilePath FilePath FilePath
17471767 | BP_MainPathDuplicate FilePath FilePath
1748− | BP_MainNameDuplicate ModuleName.Raw FilePath FilePath
1749− | BP_MainNameInvalid FilePath FilePath [String]
1768+ | BP_RootNameDuplicate ModuleName.Raw FilePath FilePath
1769+ | BP_RootNameInvalid FilePath FilePath [String]
17501770 | BP_CannotLoadDependencies
17511771 | BP_Cycle ModuleName.Raw [ModuleName.Raw]
17521772 | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))
@@ -1755,8 +1775,8 @@ data BuildProjectProblem
17551775toBuildProblemReport :: BuildProblem -> Help.Report
17561776toBuildProblemReport problem =
17571777 case problem of
1758− BuildBadModules e es ->
1759− Help.compilerReport e es
1778+ BuildBadModules root e es ->
1779+ Help.compilerReport root e es
17601780
17611781 BuildProjectProblem projectProblem ->
17621782 toProjectProblemReport projectProblem
@@ -1813,7 +1833,7 @@ toProjectProblemReport projectProblem =
18131833 \ unstuck!"
18141834 ]
18151835
1816− BP_MainNameDuplicate name outsidePath otherPath ->
1836+ BP_RootNameDuplicate name outsidePath otherPath ->
18171837 Help.report "MODULE NAME CLASH" Nothing
18181838 "These two files are causing a module name clash:"
18191839 [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]
@@ -1824,7 +1844,7 @@ toProjectProblemReport projectProblem =
18241844 "Try changing to a different module name in one of them!"
18251845 ]
18261846
1827− BP_MainNameInvalid givenPath srcDir _ ->
1847+ BP_RootNameInvalid givenPath srcDir _ ->
18281848 Help.report "UNEXPECTED FILE NAME" Nothing
18291849 "I am having trouble with this file name:"
18301850 [ D.indent 4 $ D.red $ D.fromChars givenPath
@@ -1948,7 +1968,7 @@ toGenerateReport problem =
19481968 "The issue is that --optimize strips out info needed by `Debug` functions.\
19491969 \ Here are two examples:"
19501970 , D.indent 4 $ D.reflow $
1951− "(1) It shortens record field names. This makes the generated JavaScript is\
1971+ "(1) It shortens record field names. This makes the generated JavaScript\
19521972 \ smaller, but `Debug.toString` cannot know the real field names anymore."
19531973 , D.indent 4 $ D.reflow $
19541974 "(2) Values like `type Height = Height Float` are unboxed. This reduces\
@@ -2017,7 +2037,7 @@ reactorToReport problem =
20172037data Repl
20182038 = ReplBadDetails Details
20192039 | ReplBadInput BS.ByteString Error.Error
2020− | ReplBadLocalDeps Error.Module [Error.Module]
2040+ | ReplBadLocalDeps FilePath Error.Module [Error.Module]
20212041 | ReplProjectProblem BuildProjectProblem
20222042 | ReplBadGenerate Generate
20232043 | ReplBadCache
@@ -2031,10 +2051,10 @@ replToReport problem =
20312051 toDetailsReport details
20322052
20332053 ReplBadInput source err ->
2034− Help.compilerReport (Error.Module N.replModule "REPL" File.zeroTime source err) []
2054+ Help.compilerReport "/" (Error.Module N.replModule "REPL" File.zeroTime source err) []
20352055
2036− ReplBadLocalDeps e es ->
2037− Help.compilerReport e es
2056+ ReplBadLocalDeps root e es ->
2057+ Help.compilerReport root e es
20382058
20392059 ReplProjectProblem projectProblem ->
20402060 toProjectProblemReport projectProblem
@@ -2047,39 +2067,3 @@ replToReport problem =
20472067
20482068 ReplBlocked ->
20492069 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
2929
3030
3131data Report
32− = CompilerReport Error.Module [Error.Module]
32+ = CompilerReport FilePath Error.Module [Error.Module]
3333 | Report
3434 { _title :: String
3535 , _path :: Maybe FilePath
@@ -52,7 +52,7 @@ jsonReport =
5252 Report
5353
5454
55−compilerReport :: Error.Module -> [Error.Module] -> Report
55+compilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report
5656compilerReport =
5757 CompilerReport
5858
@@ -64,8 +64,8 @@ compilerReport =
6464reportToDoc :: Report -> D.Doc
6565reportToDoc report_ =
6666 case report_ of
67− CompilerReport e es ->
68− Error.toDoc e es
67+ CompilerReport root e es ->
68+ Error.toDoc root e es
6969
7070 Report title maybePath message ->
7171 let
@@ -94,7 +94,7 @@ reportToDoc report_ =
9494reportToJson :: Report -> E.Value
9595reportToJson report_ =
9696 case report_ of
97− CompilerReport e es ->
97+ CompilerReport _ e es ->
9898 E.object
9999 [ "type" ==> E.chars "compile-errors"
100100 , "errors" ==> E.list Error.toJson (e:es)
builder/src/Stuff.hs+1−1
@@ -62,7 +62,7 @@ prepublishDir root =
6262
6363compilerVersion :: FilePath
6464compilerVersion =
65− V.toChars V.compiler ++ "-alpha-3"
65+ V.toChars V.compiler
6666
6767
6868
compiler/src/AST/Source.hs+5−5
@@ -195,15 +195,15 @@ newtype Comment =
195195
196196data Exposing
197197 = Open
198− | Explicit [A.Located Exposed]
198+ | Explicit [Exposed]
199199
200200
201201data Exposed
202− = Lower Name
203− | Upper Name Privacy
204− | Operator Name
202+ = Lower (A.Located Name)
203+ | Upper (A.Located Name) Privacy
204+ | Operator A.Region Name
205205
206206
207207data Privacy
208− = Public
208+ = Public A.Region
209209 | Private
compiler/src/AST/Utils/Type.hs−1
@@ -1,5 +1,4 @@
11{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
32module AST.Utils.Type
43 ( delambda
54 , dealias
compiler/src/Canonicalize/Environment.hs+50−20
@@ -4,6 +4,8 @@ module Canonicalize.Environment
44 ( Env(..)
55 , Exposed
66 , Qualified
7+ , Info(..)
8+ , mergeInfo
79 , Var(..)
810 , Type(..)
911 , Ctor(..)
@@ -20,8 +22,8 @@ module Canonicalize.Environment
2022
2123import qualified Data.Map.Merge.Strict as Map
2224import qualified Data.Map.Strict as Map
23−import qualified Data.Map.Strict.Internal as I
2425import qualified Data.Name as Name
26+import qualified Data.OneOrMore as OneOrMore
2527
2628import qualified AST.Utils.Binop as Binop
2729import qualified AST.Canonical as Can
@@ -58,11 +60,34 @@ data Env =
5860
5961
6062type Exposed a =
61− Map.Map Name.Name (Map.Map ModuleName.Canonical a)
63+ Map.Map Name.Name (Info a)
6264
6365
6466type Qualified a =
65− Map.Map Name.Name (Map.Map Name.Name (Map.Map ModuleName.Canonical a))
67+ Map.Map Name.Name (Map.Map Name.Name (Info 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))
6691
6792
6893
@@ -72,7 +97,8 @@ type Qualified a =
7297data Var
7398 = Local A.Region
7499 | TopLevel A.Region
75− | Foreign (Map.Map ModuleName.Canonical Can.Annotation)
100+ | Foreign ModuleName.Canonical Can.Annotation
101+ | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
76102
77103
78104
@@ -139,7 +165,10 @@ addLocalLeft _ region =
139165addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
140166addLocalBoth name region var =
141167 case var of
142− Foreign _ ->
168+ Foreign _ _ ->
169+ Result.ok (Local region)
170+
171+ Foreigns _ _ ->
143172 Result.ok (Local region)
144173
145174 Local parentRegion ->
@@ -150,17 +179,18 @@ addLocalBoth name region var =
150179
151180
152181
182+
153183-- FIND TYPE
154184
155185
156186findType :: A.Region -> Env -> Name.Name -> Result i w Type
157187findType region (Env _ _ ts _ _ _ qts _) name =
158188 case Map.lookup name ts of
159− Just (I.Bin 1 _ tipe _ _) ->
189+ Just (Specific _ tipe) ->
160190 Result.ok tipe
161191
162− Just homes ->
163− Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))
192+ Just (Ambiguous h hs) ->
193+ Result.throw (Error.AmbiguousType region Nothing name h hs)
164194
165195 Nothing ->
166196 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
@@ -171,11 +201,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
171201 case Map.lookup prefix qts of
172202 Just qualified ->
173203 case Map.lookup name qualified of
174− Just (I.Bin 1 _ tipe _ _) ->
204+ Just (Specific _ tipe) ->
175205 Result.ok tipe
176206
177− Just homes ->
178− Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))
207+ Just (Ambiguous h hs) ->
208+ Result.throw (Error.AmbiguousType region (Just prefix) name h hs)
179209
180210 Nothing ->
181211 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
@@ -191,11 +221,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
191221findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
192222findCtor region (Env _ _ _ cs _ _ _ qcs) name =
193223 case Map.lookup name cs of
194− Just (I.Bin 1 _ ctor _ _) ->
224+ Just (Specific _ ctor) ->
195225 Result.ok ctor
196226
197− Just homes ->
198− Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))
227+ Just (Ambiguous h hs) ->
228+ Result.throw (Error.AmbiguousVariant region Nothing name h hs)
199229
200230 Nothing ->
201231 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
@@ -206,11 +236,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
206236 case Map.lookup prefix qcs of
207237 Just qualified ->
208238 case Map.lookup name qualified of
209− Just (I.Bin 1 _ pattern _ _) ->
239+ Just (Specific _ pattern) ->
210240 Result.ok pattern
211241
212− Just homes ->
213− Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))
242+ Just (Ambiguous h hs) ->
243+ Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)
214244
215245 Nothing ->
216246 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
@@ -226,11 +256,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
226256findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
227257findBinop region (Env _ _ _ _ binops _ _ _) name =
228258 case Map.lookup name binops of
229− Just (I.Bin 1 _ binop _ _) ->
259+ Just (Specific _ binop) ->
230260 Result.ok binop
231261
232− Just homes ->
233− Result.throw (Error.AmbiguousBinop region name (Map.keys homes))
262+ Just (Ambiguous h hs) ->
263+ Result.throw (Error.AmbiguousBinop region name h hs)
234264
235265 Nothing ->
236266 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 =
105105
106106insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a
107107insert name region value dict =
108− Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict
108+ Map.insertWith (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict
109109
110110
111111union :: Dict a -> Dict a -> Dict a
compiler/src/Canonicalize/Environment/Foreign.hs+49−37
@@ -35,7 +35,14 @@ type Result i w a =
3535createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
3636createInitialEnv home ifaces imports =
3737 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)
38− Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)
38+ Result.ok (Env.Env home (Map.map infoToVar 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
3946
4047
4148
@@ -61,7 +68,7 @@ emptyState =
6168
6269emptyTypes :: Env.Exposed Env.Type
6370emptyTypes =
64− Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))
71+ Map.singleton "List" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))
6572
6673
6774
@@ -102,8 +109,8 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
102109 (Map.mapMaybeWithKey (unionToType home) unions)
103110 (Map.mapMaybeWithKey (aliasToType home) aliases)
104111
105− !vars = Map.map (Map.singleton home) defs
106− !types = Map.map (Map.singleton home . fst) rawTypeInfo
112+ !vars = Map.map (Env.Specific home) defs
113+ !types = Map.map (Env.Specific home . fst) rawTypeInfo
107114 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
108115
109116 !qvs2 = addQualified prefix vars qvs
@@ -129,7 +136,7 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
129136
130137addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
131138addExposed =
132− Map.unionWith Map.union
139+ Map.unionWith Env.mergeInfo
133140
134141
135142addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
@@ -150,7 +157,7 @@ unionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type,
150157unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
151158 let
152159 addCtor dict (Can.Ctor ctor index _ args) =
153− Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict
160+ Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict
154161 in
155162 ( Env.Union (length vars) home
156163 , List.foldl' addCtor Map.empty ctors
@@ -181,7 +188,7 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
181188 (Can.TAlias home name avars (Can.Filled tipe))
182189 (Can.fieldsToList fields)
183190 in
184− Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))
191+ Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))
185192
186193 _ ->
187194 Map.empty
@@ -192,9 +199,9 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
192199-- BINOP
193200
194201
195−binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop
202+binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop
196203binopToBinop home op (I.Binop name annotation associativity precedence) =
197− Map.singleton home (Env.Binop op home name annotation associativity precedence)
204+ Env.Specific home (Env.Binop op home name annotation associativity precedence)
198205
199206
200207
@@ -207,19 +214,19 @@ addExposedValue
207214 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)
208215 -> Map.Map Name.Name I.Binop
209216 -> State
210− -> A.Located Src.Exposed
217+ -> Src.Exposed
211218 -> Result i w State
212−addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At region exposed) =
219+addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
213220 case exposed of
214− Src.Lower name ->
221+ Src.Lower (A.At region name) ->
215222 case Map.lookup name vars of
216223 Just info ->
217− Result.ok (State (Map.insertWith Map.union name info vs) ts cs bs qvs qts qcs)
224+ Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)
218225
219226 Nothing ->
220227 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
221228
222− Src.Upper name privacy ->
229+ Src.Upper (A.At region name) privacy ->
223230 case privacy of
224231 Src.Private ->
225232 case Map.lookup name types of
@@ -227,43 +234,43 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg
227234 case tipe of
228235 Env.Union _ _ ->
229236 let
230− !ts2 = Map.insert name (Map.singleton home tipe) ts
237+ !ts2 = Map.insert name (Env.Specific home tipe) ts
231238 in
232239 Result.ok (State vs ts2 cs bs qvs qts qcs)
233240
234241 Env.Alias _ _ _ _ ->
235242 let
236− !ts2 = Map.insert name (Map.singleton home tipe) ts
243+ !ts2 = Map.insert name (Env.Specific home tipe) ts
237244 !cs2 = addExposed cs ctors
238245 in
239246 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
240247
241248 Nothing ->
242− case Map.lookup name (toCtors types) of
243− Just tipe ->
249+ case checkForCtorMistake name types of
250+ tipe:_ ->
244251 Result.throw $ Error.ImportCtorByName region name tipe
245252
246− Nothing ->
253+ [] ->
247254 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
248255
249− Src.Public ->
256+ Src.Public dotDotRegion ->
250257 case Map.lookup name types of
251258 Just (tipe, ctors) ->
252259 case tipe of
253260 Env.Union _ _ ->
254261 let
255− !ts2 = Map.insert name (Map.singleton home tipe) ts
262+ !ts2 = Map.insert name (Env.Specific home tipe) ts
256263 !cs2 = addExposed cs ctors
257264 in
258265 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
259266
260267 Env.Alias _ _ _ _ ->
261− Result.throw (Error.ImportOpenAlias region name)
268+ Result.throw (Error.ImportOpenAlias dotDotRegion name)
262269
263270 Nothing ->
264271 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))
265272
266− Src.Operator op ->
273+ Src.Operator region op ->
267274 case Map.lookup op binops of
268275 Just binop ->
269276 let
@@ -275,18 +282,23 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg
275282 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
276283
277284
278−
279−toCtors :: Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> Map.Map Name.Name Name.Name
280−toCtors types =
281− Map.foldr addCtors Map.empty types
285+checkForCtorMistake :: Name.Name -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> [Name.Name]
286+checkForCtorMistake givenName types =
287+ Map.foldr addMatches [] types
282288 where
283− addCtors (_, exposedCtors) dict =
284− Map.foldrWithKey addCtor dict exposedCtors
285−
286− addCtor ctorName homes dict =
287− case Map.elems homes of
288− [Env.Ctor _ tipeName _ _ _] ->
289− Map.insert ctorName tipeName dict
290−
291− _ ->
292− dict
289+ addMatches (_, exposedCtors) matches =
290+ Map.foldrWithKey addMatch matches exposedCtors
291+
292+ addMatch ctorName info matches =
293+ if ctorName /= givenName
294+ then matches
295+ else
296+ case info of
297+ Env.Specific _ (Env.Ctor _ tipeName _ _ _) ->
298+ tipeName : matches
299+
300+ Env.Specific _ (Env.RecordCtor _ _ _) ->
301+ matches
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
110110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)
111111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =
112112 do arity <- checkUnionFreeVars union
113− let one = Map.singleton home (Env.Union arity home)
113+ let one = Env.Specific home (Env.Union arity home)
114114 Result.ok $ Map.insert name one types
115115
116116
@@ -133,7 +133,7 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =
133133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->
134134 do args <- checkAliasFreeVars alias
135135 ctype <- Type.canonicalize env tipe
136− let one = Map.singleton home (Env.Alias (length args) home args ctype)
136+ let one = Env.Specific home (Env.Alias (length args) home args ctype)
137137 let ts1 = Map.insert name one ts
138138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
139139
@@ -281,7 +281,7 @@ addCtors (Src.Module _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs
281281 )
282282
283283
284−type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)
284+type CtorDups = Dups.Dict (Env.Info Env.Ctor)
285285
286286
287287
@@ -297,7 +297,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At regi
297297 ,
298298 case ctipe of
299299 Can.TRecord fields Nothing ->
300− Dups.one name region (Map.singleton home (toRecordCtor home name vars fields))
300+ Dups.one name region (Env.Specific home (toRecordCtor home name vars fields))
301301
302302 _ ->
303303 Dups.none
@@ -351,5 +351,5 @@ toOpts ctors =
351351
352352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
353353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
354− Dups.one name region $ Map.singleton home $
354+ Dups.one name region $ Env.Specific home $
355355 Env.Ctor home typeName union index args
compiler/src/Canonicalize/Expression.hs+6−7
@@ -14,7 +14,6 @@ import Control.Monad (foldM)
1414import qualified Data.Graph as Graph
1515import qualified Data.List as List
1616import qualified Data.Map.Strict as Map
17−import qualified Data.Map.Strict.Internal as I
1817import qualified Data.Name as Name
1918
2019import qualified AST.Canonical as Can
@@ -696,15 +695,15 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =
696695 Env.TopLevel _ ->
697696 logVar name (Can.VarTopLevel localHome name)
698697
699− Env.Foreign (I.Bin 1 home annotation _ _) ->
698+ Env.Foreign home annotation ->
700699 Result.ok $
701700 if home == ModuleName.debug then
702701 Can.VarDebug localHome name annotation
703702 else
704703 Can.VarForeign home name annotation
705704
706− Env.Foreign homes ->
707− Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))
705+ Env.Foreigns h hs ->
706+ Result.throw (Error.AmbiguousVar region Nothing name h hs)
708707
709708 Nothing ->
710709 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
@@ -715,15 +714,15 @@ findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =
715714 case Map.lookup prefix qvs of
716715 Just qualified ->
717716 case Map.lookup name qualified of
718− Just (I.Bin 1 home annotation _ _) ->
717+ Just (Env.Specific home annotation) ->
719718 Result.ok $
720719 if home == ModuleName.debug then
721720 Can.VarDebug localHome name annotation
722721 else
723722 Can.VarForeign home name annotation
724723
725− Just homes ->
726− Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))
724+ Just (Env.Ambiguous h hs) ->
725+ Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)
727726
728727 Nothing ->
729728 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))
compiler/src/Canonicalize/Module.hs+7−7
@@ -236,11 +236,11 @@ checkExposed
236236 -> Map.Map Name.Name alias
237237 -> Map.Map Name.Name binop
238238 -> Can.Effects
239− -> A.Located Src.Exposed
239+ -> Src.Exposed
240240 -> Result i w (Dups.Dict (A.Located Can.Export))
241−checkExposed values unions aliases binops effects (A.At region exposed) =
241+checkExposed values unions aliases binops effects exposed =
242242 case exposed of
243− Src.Lower name ->
243+ Src.Lower (A.At region name) ->
244244 if Map.member name values then
245245 ok name region Can.ExportValue
246246 else
@@ -252,23 +252,23 @@ checkExposed values unions aliases binops effects (A.At region exposed) =
252252 Result.throw $ Error.ExportNotFound region Error.BadVar name $
253253 ports ++ Map.keys values
254254
255− Src.Operator name ->
255+ Src.Operator region name ->
256256 if Map.member name binops then
257257 ok name region Can.ExportBinop
258258 else
259259 Result.throw $ Error.ExportNotFound region Error.BadOp name $
260260 Map.keys binops
261261
262− Src.Upper name Src.Public ->
262+ Src.Upper (A.At region name) (Src.Public dotDotRegion) ->
263263 if Map.member name unions then
264264 ok name region Can.ExportUnionOpen
265265 else if Map.member name aliases then
266− Result.throw $ Error.ExportOpenAlias region name
266+ Result.throw $ Error.ExportOpenAlias dotDotRegion name
267267 else
268268 Result.throw $ Error.ExportNotFound region Error.BadType name $
269269 Map.keys unions ++ Map.keys aliases
270270
271− Src.Upper name Src.Private ->
271+ Src.Upper (A.At region name) Src.Private ->
272272 if Map.member name unions then
273273 ok name region Can.ExportUnionClosed
274274 else if Map.member name aliases then
compiler/src/Canonicalize/Pattern.hs+3−2
@@ -8,6 +8,7 @@ module Canonicalize.Pattern
88 where
99
1010
11+import qualified Data.List as List
1112import qualified Data.Map.Strict as Map
1213import qualified Data.Name as Name
1314
@@ -173,8 +174,8 @@ logVar name region value =
173174logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a
174175logFields fields value =
175176 let
176− addField (A.At region name) dict =
177+ addField dict (A.At region name) =
177178 Dups.insert name region region dict
178179 in
179180 Result.Result $ \bindings warnings _ ok ->
180− ok (foldr addField bindings fields) warnings value
181+ ok (List.foldl' addField bindings fields) warnings value
compiler/src/Data/Name.hs+1−1
@@ -304,7 +304,7 @@ fromManyNames names =
304304 case names of
305305 [] ->
306306 blank
307− -- this case is needed for (let _ = Debug.log "x" x in ...)
307+ -- NOTE: this case is needed for (let _ = Debug.log "x" x in ...)
308308 -- but maybe unused patterns should be stripped out instead
309309
310310 Utf8.Utf8 ba# : _ ->
compiler/src/Data/Utf8.hs+3−1
@@ -261,7 +261,9 @@ instance Eq (Utf8 t) where
261261
262262
263263-- COMPARE
264−
264+--
265+-- TODO: is it fine to sort by length and only compare bytes on length ties?
266+--
265267
266268instance Ord (Utf8 t) where
267269 compare (Utf8 ba1#) (Utf8 ba2#) =
compiler/src/Elm/Compiler/Imports.hs+3−3
@@ -49,14 +49,14 @@ closed =
4949
5050typeOpen :: Name.Name -> Src.Exposing
5151typeOpen name =
52− Src.Explicit [ A.At A.zero (Src.Upper name Src.Public) ]
52+ Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]
5353
5454
5555typeClosed :: Name.Name -> Src.Exposing
5656typeClosed name =
57− Src.Explicit [ A.At A.zero (Src.Upper name Src.Private) ]
57+ Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]
5858
5959
6060operator :: Name.Name -> Src.Exposing
6161operator op =
62− Src.Explicit [ A.At A.zero (Src.Operator op) ]
62+ Src.Explicit [ Src.Operator A.zero op ]
compiler/src/Elm/Kernel.hs+6−6
@@ -319,19 +319,19 @@ toNames exposing =
319319 map toName exposedList
320320
321321
322−toName :: A.Located Src.Exposed -> Name.Name
323−toName (A.At _ exposed) =
322+toName :: Src.Exposed -> Name.Name
323+toName exposed =
324324 case exposed of
325− Src.Lower name ->
325+ Src.Lower (A.At _ name) ->
326326 name
327327
328− Src.Upper name Src.Private ->
328+ Src.Upper (A.At _ name) Src.Private ->
329329 name
330330
331− Src.Upper _ Src.Public ->
331+ Src.Upper _ (Src.Public _) ->
332332 error "cannot have Maybe(..) syntax in kernel code header"
333333
334− Src.Operator _ ->
334+ Src.Operator _ _ ->
335335 error "cannot use binops in kernel code"
336336
337337
compiler/src/Elm/ModuleName.hs+2−6
@@ -7,12 +7,13 @@ module Elm.ModuleName
77 --
88 , encode
99 , decoder
10+ , parser
1011 --
1112 , Canonical(..)
1213 , basics, char, string
1314 , maybe, result, list, array, dict, tuple
1415 , platform, cmd, sub
15− , debug, bitwise
16+ , debug
1617 , virtualDom
1718 , jsonDecode, jsonEncode
1819 , webgl, texture, vector2, vector3, vector4, matrix4
@@ -225,11 +226,6 @@ debug :: Canonical
225226debug = Canonical Pkg.core Name.debug
226227
227228
228−{-# NOINLINE bitwise #-}
229−bitwise :: Canonical
230−bitwise = Canonical Pkg.core Name.bitwise
231−
232−
233229
234230-- HTML
235231
compiler/src/Generate/Html.hs+4−8
@@ -29,20 +29,16 @@ sandwich moduleName javascript =
2929
3030<body>
3131
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>
32+<pre id="elm"></pre>
3933
4034<script>
4135try {
4236|] <> javascript <> [r|
4337
4438 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
45−} catch (e) {
39+}
40+catch (e)
41+{
4642 // display initialization errors (e.g. bad flags, infinite recursion)
4743 var header = document.createElement("h1");
4844 header.style.fontFamily = "monospace";
compiler/src/Generate/JavaScript.hs+45−10
@@ -2,6 +2,7 @@
22module Generate.JavaScript
33 ( generate
44 , generateForRepl
5+ , generateForReplEndpoint
56 )
67 where
78
@@ -85,7 +86,8 @@ generateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _
8586 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")
8687 evalState = addGlobal mode graph debugState (Opt.Global home name)
8788 in
88− Functions.functions
89+ "process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\n'); process.exit(1); });"
90+ <> Functions.functions
8991 <> stateToBuilder evalState
9092 <> print ansi localizer home name tipe
9193
@@ -98,14 +100,47 @@ print ansi localizer home name tipe =
98100 tipeDoc = RT.canToDoc localizer RT.None tipe
99101 bool = if ansi then "true" else "false"
100102 in
101− "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\
102− \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\
103− \function _print(t) { console.log(_value + (" <> bool <> " ? '\x1b[90m' + t + '\x1b[0m' : t)); }\n\
104− \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\
105− \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\
106− \} else {\n\
107− \ _print(' : ' + _type);\n\
108− \}\n"
103+ "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\
104+ \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\
105+ \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\
107+ \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\
108+ \} else {\n\
109+ \ _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"
109144
110145
111146
@@ -257,7 +292,7 @@ generateCycle mode (Opt.Global home _) names values functions =
257292 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"
258293 <> drawCycle names
259294 <> "\\n\\nThese errors are very tricky, so read "
260− <> B.stringUtf8 (D.makeNakedLink "halting-problem")
295+ <> B.stringUtf8 (D.makeNakedLink "bad-recursion")
261296 <> " to learn how to fix it!"
262297 ]
263298
compiler/src/Optimize/Port.hs+1−1
@@ -58,7 +58,7 @@ toEncoder tipe =
5858 | name == Name.array -> encodeArray arg
5959
6060 _ ->
61− error "toEncoder: bad union type"
61+ error "toEncoder: bad custom type"
6262
6363 Can.TRecord _ (Just _) ->
6464 error "toEncoder: bad record"
compiler/src/Parse/Module.hs+81−35
@@ -2,6 +2,8 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Parse.Module
44 ( fromByteString
5+ , ProjectType(..)
6+ , isKernel
57 , chompImports
68 , chompImport
79 )
@@ -29,14 +31,37 @@ import qualified Reporting.Error.Syntax as E
2931-- FROM BYTE STRING
3032
3133
32−fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module
33−fromByteString pkg source =
34− case P.fromByteString (chompModule pkg) E.ModuleBadEnd source of
35− Right modul -> checkModule modul
34+fromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module
35+fromByteString projectType source =
36+ case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of
37+ Right modul -> checkModule projectType modul
3638 Left err -> Left (E.ParseError err)
3739
3840
3941
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+
4065-- MODULE
4166
4267
@@ -49,11 +74,11 @@ data Module =
4974 }
5075
5176
52−chompModule :: Pkg.Name -> Parser E.Module Module
53−chompModule pkg =
77+chompModule :: ProjectType -> Parser E.Module Module
78+chompModule projectType =
5479 do header <- chompHeader
55− imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)
56− infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []
80+ imports <- chompImports (if isCore projectType then [] else Imports.defaults)
81+ infixes <- if isKernel projectType then chompInfixes [] else return []
5782 decls <- specialize E.Declarations $ chompDecls []
5883 return (Module header imports infixes decls)
5984
@@ -62,15 +87,15 @@ chompModule pkg =
6287-- CHECK MODULE
6388
6489
65−checkModule :: Module -> Either E.Error Src.Module
66−checkModule (Module maybeHeader imports infixes decls) =
90+checkModule :: ProjectType -> Module -> Either E.Error Src.Module
91+checkModule projectType (Module maybeHeader imports infixes decls) =
6792 let
6893 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
6994 in
7095 case maybeHeader of
7196 Just (Header name effects exports docs) ->
7297 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
73− <$> checkEffects ports effects
98+ <$> checkEffects projectType ports effects
7499
75100 Nothing ->
76101 Right $
@@ -80,23 +105,37 @@ checkModule (Module maybeHeader imports infixes decls) =
80105 _:_ -> Src.Ports ports
81106
82107
83−checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects
84−checkEffects ports effects =
108+checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects
109+checkEffects projectType ports effects =
85110 case effects of
86111 NoEffects region ->
87112 case ports of
88− [] -> Right Src.NoEffects
89− _:_ -> Left (E.UnexpectedPort region)
113+ [] ->
114+ Right Src.NoEffects
115+
116+ Src.Port name _ : _ ->
117+ case projectType of
118+ Package _ -> Left (E.NoPortsInPackage name)
119+ Application -> Left (E.UnexpectedPort region)
90120
91121 Ports region ->
92− case ports of
93− [] -> Left (E.NoPorts region)
94− _:_ -> Right (Src.Ports ports)
122+ case projectType of
123+ Package _ ->
124+ Left (E.NoPortModulesInPackage region)
125+
126+ Application ->
127+ case ports of
128+ [] -> Left (E.NoPorts region)
129+ _:_ -> Right (Src.Ports ports)
95130
96131 Manager region manager ->
97− case ports of
98− [] -> Right (Src.Manager region manager)
99− _:_ -> Left (E.UnexpectedPort region)
132+ if isKernel projectType then
133+ case ports of
134+ [] -> Right (Src.Manager region manager)
135+ _:_ -> Left (E.UnexpectedPort region)
136+ else
137+ Left (E.NoEffectsOutsideKernel region)
138+
100139
101140
102141categorizeDecls :: [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] )
@@ -395,18 +434,18 @@ exposing =
395434 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
396435 word1 0x29 {-)-} E.ExposingEnd
397436 return Src.Open
398− , do exposed <- addLocation chompExposed
437+ , do exposed <- chompExposed
399438 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
400439 exposingHelp [exposed]
401440 ]
402441
403442
404−exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing
443+exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing
405444exposingHelp revExposed =
406445 oneOf E.ExposingEnd
407446 [ do word1 0x2C {-,-} E.ExposingEnd
408447 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
409− exposed <- addLocation chompExposed
448+ exposed <- chompExposed
410449 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
411450 exposingHelp (exposed:revExposed)
412451 , do word1 0x29 {-)-} E.ExposingEnd
@@ -416,16 +455,21 @@ exposingHelp revExposed =
416455
417456chompExposed :: Parser E.Exposing Src.Exposed
418457chompExposed =
419− oneOf E.ExposingValue
420− [ Src.Lower <$> Var.lower E.ExposingValue
421− , do word1 0x28 {-(-} E.ExposingValue
422− op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
423− word1 0x29 {-)-} E.ExposingOperatorRightParen
424− return (Src.Operator op)
425− , do name <- Var.upper E.ExposingValue
426− Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
427− Src.Upper name <$> privacy
428− ]
458+ do start <- getPosition
459+ oneOf E.ExposingValue
460+ [ do name <- Var.lower E.ExposingValue
461+ end <- getPosition
462+ return $ Src.Lower $ A.at start end name
463+ , do word1 0x28 {-(-} E.ExposingValue
464+ op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
465+ word1 0x29 {-)-} E.ExposingOperatorRightParen
466+ end <- getPosition
467+ return $ Src.Operator (A.Region start end) op
468+ , do name <- Var.upper E.ExposingValue
469+ end <- getPosition
470+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
471+ Src.Upper (A.at start end name) <$> privacy
472+ ]
429473
430474
431475privacy :: Parser E.Exposing Src.Privacy
@@ -433,9 +477,11 @@ privacy =
433477 oneOfWithFallback
434478 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
435479 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
480+ start <- getPosition
436481 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
482+ end <- getPosition
437483 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
438484 word1 0x29 {-)-} E.ExposingTypePrivacy
439− return Src.Public
485+ return $ Src.Public (A.Region start end)
440486 ]
441487 Src.Private
compiler/src/Parse/Pattern.hs+1−1
@@ -129,7 +129,7 @@ recordHelp start vars =
129129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd
130130 recordHelp start (var:vars)
131131 , do word1 0x7D {-}-} E.PRecordEnd
132− addEnd start (Src.PRecord vars)
132+ addEnd start (Src.PRecord (reverse vars))
133133 ]
134134
135135
compiler/src/Parse/Variable.hs+2−2
@@ -149,14 +149,14 @@ foreignUpper toError =
149149 let
150150 !newState = P.State src upperEnd end indent row newCol
151151 !name = Name.fromPtr upperStart upperEnd
152− !foreign =
152+ !upperName =
153153 if upperStart == pos then
154154 Unqualified name
155155 else
156156 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in
157157 Qualified home name
158158 in
159− cok foreign newState
159+ cok upperName newState
160160
161161
162162foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)
compiler/src/Reporting/Error.hs+20−16
@@ -12,6 +12,7 @@ module Reporting.Error
1212import qualified Data.ByteString as B
1313import qualified Data.NonEmptyList as NE
1414import qualified Data.OneOrMore as OneOrMore
15+import qualified System.FilePath as FP
1516
1617import qualified Elm.ModuleName as ModuleName
1718import qualified File
@@ -38,8 +39,8 @@ import qualified Reporting.Report as Report
3839data Module =
3940 Module
4041 { _name :: ModuleName.Raw
41− , _path :: FilePath
42− , _time :: File.Time
42+ , _absolutePath :: FilePath
43+ , _modificationTime :: File.Time
4344 , _source :: B.ByteString
4445 , _error :: Error
4546 }
@@ -92,26 +93,26 @@ toReports source err =
9293-- TO DOC
9394
9495
95−toDoc :: Module -> [Module] -> D.Doc
96−toDoc err errs =
96+toDoc :: FilePath -> Module -> [Module] -> D.Doc
97+toDoc root err errs =
9798 let
98− (NE.List m ms) = NE.sortBy _time (NE.List err errs)
99+ (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)
99100 in
100− D.vcat (toDocHelp m ms)
101+ D.vcat (toDocHelp root m ms)
101102
102103
103−toDocHelp :: Module -> [Module] -> [D.Doc]
104−toDocHelp module1 modules =
104+toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]
105+toDocHelp root module1 modules =
105106 case modules of
106107 [] ->
107− [moduleToDoc module1
108+ [moduleToDoc root module1
108109 ,""
109110 ]
110111
111112 module2 : otherModules ->
112− moduleToDoc module1
113+ moduleToDoc root module1
113114 : toSeparator module1 module2
114− : toDocHelp module2 otherModules
115+ : toDocHelp root module2 otherModules
115116
116117
117118toSeparator :: Module -> Module -> D.Doc
@@ -133,19 +134,22 @@ toSeparator beforeModule afterModule =
133134-- MODULE TO DOC
134135
135136
136−moduleToDoc :: Module -> D.Doc
137−moduleToDoc (Module _ path _ source err) =
137+moduleToDoc :: FilePath -> Module -> D.Doc
138+moduleToDoc root (Module _ absolutePath _ source err) =
138139 let
139140 reports =
140141 toReports (Code.toSource source) err
142+
143+ relativePath =
144+ FP.makeRelative root absolutePath
141145 in
142− D.vcat $ map (reportToDoc path) (NE.toList reports)
146+ D.vcat $ map (reportToDoc relativePath) (NE.toList reports)
143147
144148
145149reportToDoc :: FilePath -> Report.Report -> D.Doc
146−reportToDoc path (Report.Report title _ _ message) =
150+reportToDoc relativePath (Report.Report title _ _ message) =
147151 D.vcat
148− [ toMessageBar title path
152+ [ toMessageBar title relativePath
149153 , ""
150154 , message
151155 , ""
compiler/src/Reporting/Error/Canonicalize.hs+21−16
@@ -14,8 +14,10 @@ module Reporting.Error.Canonicalize
1414
1515
1616import qualified Data.Char as Char
17+import qualified Data.List as List
1718import qualified Data.Map as Map
1819import qualified Data.Name as Name
20+import qualified Data.OneOrMore as OneOrMore
1921import qualified Data.Set as Set
2022
2123import qualified AST.Canonical as Can
@@ -37,10 +39,10 @@ import qualified Reporting.Suggest as Suggest
3739
3840data Error
3941 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
40− | AmbiguousVar A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
41− | AmbiguousType A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
42− | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
43− | AmbiguousBinop A.Region Name.Name [ModuleName.Canonical]
42+ | AmbiguousVar A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
43+ | AmbiguousType A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
44+ | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
45+ | AmbiguousBinop A.Region Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
4446 | BadArity A.Region BadArityContext Name.Name Int Int
4547 | Binop A.Region Name.Name Name.Name
4648 | DuplicateDecl Name.Name A.Region A.Region
@@ -164,17 +166,17 @@ toReport source err =
164166 <> " be deleted? Maybe some parentheses are missing?"
165167 )
166168
167− AmbiguousVar region maybePrefix name possibleHomes ->
168− ambiguousName source region maybePrefix name possibleHomes "variable"
169+ AmbiguousVar region maybePrefix name h hs ->
170+ ambiguousName source region maybePrefix name h hs "variable"
169171
170− AmbiguousType region maybePrefix name possibleHomes ->
171− ambiguousName source region maybePrefix name possibleHomes "type"
172+ AmbiguousType region maybePrefix name h hs ->
173+ ambiguousName source region maybePrefix name h hs "type"
172174
173− AmbiguousVariant region maybePrefix name possibleHomes ->
174− ambiguousName source region maybePrefix name possibleHomes "variant"
175+ AmbiguousVariant region maybePrefix name h hs ->
176+ ambiguousName source region maybePrefix name h hs "variant"
175177
176− AmbiguousBinop region name possibleHomes ->
177− ambiguousName source region Nothing name possibleHomes "operator"
178+ AmbiguousBinop region name h hs ->
179+ ambiguousName source region Nothing name h hs "operator"
178180
179181 BadArity region badArityContext name expected actual ->
180182 let
@@ -677,7 +679,7 @@ toReport source err =
677679 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
678680 ,
679681 D.stack
680− [ makeTheory "Are you are trying to mutate a variable?" $
682+ [ makeTheory "Are you trying to mutate a variable?" $
681683 "Elm does not have mutation, so when I see " ++ Name.toChars name
682684 ++ " defined in terms of " ++ Name.toChars name
683685 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -723,7 +725,7 @@ toReport source err =
723725 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
724726 ,
725727 D.stack
726− [ makeTheory "Are you are trying to mutate a variable?" $
728+ [ makeTheory "Are you trying to mutate a variable?" $
727729 "Elm does not have mutation, so when I see " ++ Name.toChars name
728730 ++ " defined in terms of " ++ Name.toChars name
729731 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -974,8 +976,11 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =
974976-- AMBIGUOUS NAME
975977
976978
977−ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> [ModuleName.Canonical] -> String -> Report.Report
978−ambiguousName source region maybePrefix name possibleHomes thing =
979+ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> ModuleName.Canonical -> OneOrMore.OneOrMore ModuleName.Canonical -> String -> Report.Report
980+ambiguousName source region maybePrefix name h hs thing =
981+ let
982+ possibleHomes = List.sort (h : OneOrMore.destruct (:) hs)
983+ in
979984 Report.Report "AMBIGUOUS NAME" region [] $
980985 Code.toSnippet source region Nothing $
981986 case maybePrefix of
compiler/src/Reporting/Error/Import.hs+1−1
@@ -56,7 +56,7 @@ toReport source (Error region name unimportedModules problem) =
5656 D.stack
5757 [
5858 D.reflow $
59− "I checked the \"dependencies\" and \"source-directories\" listend in your elm.json,\
59+ "I checked the \"dependencies\" and \"source-directories\" listed in your elm.json,\
6060 \ but I cannot find it! Maybe it is a typo for one of these names?"
6161 ,
6262 D.dullyellow $ D.indent 4 $ D.vcat $
compiler/src/Reporting/Error/Json.hs+16−4
@@ -51,9 +51,13 @@ parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Re
5151parseErrorToReport path source parseError reason =
5252 let
5353 toSnippet title row col (problem, details) =
54− let pos = A.Position row col in
54+ let
55+ pos = A.Position row col
56+ surroundings = A.Region (A.Position (max 1 (row - 2)) 1) pos
57+ region = A.Region pos pos
58+ in
5559 Help.jsonReport title (Just path) $
56− Code.toSnippet source (A.Region pos pos) Nothing
60+ Code.toSnippet source surroundings (Just region)
5761 ( D.reflow (because reason problem)
5862 , details
5963 )
@@ -77,12 +81,20 @@ parseErrorToReport path source parseError reason =
7781 )
7882
7983 ObjectField row col ->
80− toSnippet "UNFINISHED OBJECT" row col
84+ toSnippet "EXTRA COMMA" row col
8185 (
8286 "I was partway through parsing a JSON object when I got stuck here:"
8387 ,
8488 D.stack
85− [ D.reflow $ "I was expecting to see a field name next."
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"
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."
8698 , objectNote
8799 ]
88100 )
compiler/src/Reporting/Error/Pattern.hs+2−2
@@ -41,7 +41,7 @@ toReport source err =
4141 Report.Report "UNSAFE PATTERN" region [] $
4242 Code.toSnippet source region Nothing
4343 (
44− "This pattern does not cover all possiblities:"
44+ "This pattern does not cover all possibilities:"
4545 ,
4646 D.stack
4747 [ "Other possibilities include:"
@@ -64,7 +64,7 @@ toReport source err =
6464 , unhandledPatternsToDocBlock unhandled
6565 , D.reflow $
6666 "I would have to crash if I saw one of those! You can use\
67− \ `let` to deconstruct values only if there is ONE possiblity.\
67+ \ `let` to deconstruct values only if there is ONE possibility.\
6868 \ Switch to a `case` expression to account for all possibilities."
6969 , D.toSimpleHint $
7070 "Are you calling a function that definitely returns values\
compiler/src/Reporting/Error/Syntax.hs+963−516
@@ -69,6 +69,9 @@ data Error
6969 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)
7070 | UnexpectedPort A.Region
7171 | NoPorts A.Region
72+ | NoPortsInPackage (A.Located Name.Name)
73+ | NoPortModulesInPackage A.Region
74+ | NoEffectsOutsideKernel A.Region
7275 | ParseError Module
7376
7477
@@ -561,10 +564,84 @@ toReport source err =
561564 ]
562565 )
563566
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+
564619 ParseError modul ->
565620 toParseErrorReport source modul
566621
567622
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+
568645toParseErrorReport :: Code.Source -> Module -> Report.Report
569646toParseErrorReport source modul =
570647 case modul of
@@ -572,156 +649,9 @@ toParseErrorReport source modul =
572649 toSpaceReport source space row col
573650
574651 ModuleBadEnd row col ->
575− case Code.whatIsNext source row col of
576− Code.Keyword keyword ->
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− )
652+ if col == 1
653+ then toDeclStartReport source row col
654+ else toWeirdEndReport source row col
725655
726656 ModuleProblem row col ->
727657 let
@@ -867,11 +797,11 @@ toParseErrorReport source modul =
867797 [ D.reflow $
868798 "I am not sure what is going on, but I recommend starting an Elm\
869799 \ file with the following lines:"
870− , D.vcat
800+ , D.indent 4 $ D.vcat $
871801 [ D.fillSep [D.cyan "import","Html"]
872802 , ""
873− , D.fillSep [D.green "main","="]
874− , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
803+ , "main ="
804+ , " Html.text " <> D.dullyellow "\"Hello!\""
875805 ]
876806 , D.reflow $
877807 "You should be able to copy those lines directly into your file. Check out the\
@@ -900,11 +830,12 @@ toParseErrorReport source modul =
900830 , D.indent 4 $ D.vcat $
901831 [ D.fillSep [D.cyan "import","Dict"]
902832 , D.fillSep [D.cyan "import","Maybe"]
903− , D.fillSep [D.cyan "import","Html.Attributes"]
904− , D.fillSep [D.cyan "import","Json.Decode"]
833+ , D.fillSep [D.cyan "import","Html.Attributes",D.cyan "as","A"]
834+ , D.fillSep [D.cyan "import","Json.Decode",D.cyan "exposing","(..)"]
905835 ]
906836 , D.reflow $
907837 "Notice that the module names all start with capital letters. That is required!"
838+ , D.reflowLink "Read" "imports" "to learn more."
908839 ]
909840 )
910841
@@ -931,6 +862,7 @@ toParseErrorReport source modul =
931862 ]
932863 , D.reflow $
933864 "Notice that the alias always starts with a capital letter. That is required!"
865+ , D.reflowLink "Read" "imports" "to learn more."
934866 ]
935867 )
936868
@@ -993,6 +925,192 @@ toParseErrorReport source modul =
993925
994926
995927
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+
9961114-- IMPORTS
9971115
9981116
@@ -1018,6 +1136,7 @@ toImportReport source row col =
10181136 ]
10191137 , D.reflow $
10201138 "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."
10211140 ]
10221141 )
10231142
@@ -1324,106 +1443,7 @@ toDeclarationsReport :: Code.Source -> Decl -> Report.Report
13241443toDeclarationsReport source decl =
13251444 case decl of
13261445 DeclStart 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− )
1446+ toDeclStartReport source row col
14271447
14281448 DeclSpace space row col ->
14291449 toSpaceReport source space row col
@@ -1453,6 +1473,165 @@ toDeclarationsReport source decl =
14531473 )
14541474
14551475
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+
14561635
14571636-- PORT
14581637
@@ -1579,7 +1758,7 @@ toPortReport source port_ startRow startCol =
15791758 [ D.reflow $
15801759 "I was expecting to see a type next. Here are examples of outgoing and\
15811760 \ incoming ports for reference:"
1582− , D.vcat
1761+ , D.indent 4 $ D.vcat $
15831762 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
15841763 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
15851764 ]
@@ -1598,7 +1777,7 @@ portNote =
15981777 D.stack
15991778 [ D.toSimpleNote $
16001779 "Here are some example `port` declarations for reference:"
1601− , D.vcat
1780+ , D.indent 4 $ D.vcat $
16021781 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
16031782 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
16041783 ]
@@ -1781,8 +1960,8 @@ typeAliasNote =
17811960 [ D.toSimpleNote $
17821961 "Here is an example of a valid `type alias` for reference:"
17831962 , D.vcat $
1784− [ D.indent 0 $ D.fillSep [D.cyan "type",D.cyan "alias",D.green "Person","="]
1785− , D.indent 2 $ D.vcat $
1963+ [ D.indent 4 $ D.fillSep [D.cyan "type",D.cyan "alias","Person","="]
1964+ , D.indent 6 $ D.vcat $
17861965 ["{ name : String"
17871966 ,", age : Int"
17881967 ,", height : Float"
@@ -1982,10 +2161,10 @@ customTypeNote =
19822161 [ D.toSimpleNote $
19832162 "Here is an example of a valid `type` declaration for reference:"
19842163 , D.vcat $
1985− [ D.indent 0 $ D.fillSep [D.cyan "type",D.green "Status"]
1986− , D.indent 2 $ D.fillSep ["=","Failure"]
1987− , D.indent 2 $ D.fillSep ["|","Waiting"]
1988− , D.indent 2 $ D.fillSep ["|","Success","String"]
2164+ [ D.indent 4 $ D.fillSep [D.cyan "type","Status"]
2165+ , D.indent 6 $ D.fillSep ["=","Failure"]
2166+ , D.indent 6 $ D.fillSep ["|","Waiting"]
2167+ , D.indent 6 $ D.fillSep ["|","Success","String"]
19892168 ]
19902169 , D.reflow $
19912170 "This defines a new `Status` type with three variants. This could be useful if\
@@ -2016,11 +2195,55 @@ toDeclDefReport source name declDef startRow startCol =
20162195 Report.Report "RESERVED WORD" region [] $
20172196 Code.toSnippet source surroundings (Just region)
20182197 (
2019− D.reflow $
2020− "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
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+ ]
20212204 ,
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)
2229+ (
20222230 D.reflow $
2023− "This is a reserved word! Try using some other name?"
2231+ "I was not expecting to see an arrow here:"
2232+ ,
2233+ D.stack
2234+ [ D.fillSep
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+ ]
20242247 )
20252248
20262249 Code.Operator op ->
@@ -2038,10 +2261,10 @@ toDeclDefReport source name declDef startRow startCol =
20382261 [ D.reflow $
20392262 "I am not sure what is going wrong exactly, so here is a valid\
20402263 \ definition (with an optional type annotation) for reference:"
2041− , D.vcat
2042− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2043− , D.fillSep [D.green "add","x","y","="]
2044− , D.fillSep [" ","x","+","y"]
2264+ , D.indent 4 $ D.vcat $
2265+ [ "greet : String -> String"
2266+ , "greet name ="
2267+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
20452268 ]
20462269 , D.reflow $
20472270 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -2063,10 +2286,10 @@ toDeclDefReport source name declDef startRow startCol =
20632286 [ D.reflow $
20642287 "I am not sure what is going wrong exactly, so here is a valid\
20652288 \ definition (with an optional type annotation) for reference:"
2066− , D.vcat
2067− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2068− , D.fillSep [D.green "add","x","y","="]
2069− , D.fillSep [" ","x","+","y"]
2289+ , D.indent 4 $ D.vcat $
2290+ [ "greet : String -> String"
2291+ , "greet name ="
2292+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
20702293 ]
20712294 , D.reflow $
20722295 "Try to use that format!"
@@ -2181,10 +2404,10 @@ declDefNote =
21812404 D.stack
21822405 [ D.reflow $
21832406 "Here is a valid definition (with a type annotation) for reference:"
2184− , D.vcat
2185− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2186− , D.fillSep [D.green "add","x","y","="]
2187− , D.fillSep [" ","x","+","y"]
2407+ , D.indent 4 $ D.vcat $
2408+ [ "greet : String -> String"
2409+ , "greet name ="
2410+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
21882411 ]
21892412 , D.reflow $
21902413 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -2296,25 +2519,40 @@ toExprReport source context expr startRow startCol =
22962519 )
22972520
22982521 OperatorRight op row col ->
2299− let region = toRegion row col in
2522+ let
2523+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
2524+ region = toRegion row col
2525+ isMath = elem op ["-","+","*","/","^"]
2526+ in
23002527 Report.Report "MISSING EXPRESSION" region [] $
2301− Code.toSnippet source region Nothing
2528+ Code.toSnippet source surroundings (Just region)
23022529 (
23032530 D.reflow $
2304− "I was expecting to see an expression after this " ++ Name.toChars op ++ " operator:"
2531+ "I just saw a " ++ Name.toChars op ++ " "
2532+ ++ (if isMath then "sign" else "operator")
2533+ ++ ", so I am getting stuck here:"
23052534 ,
2306− D.stack
2307− [ D.fillSep $
2308− ["You","can","just","put","anything","for","now,","like"
2309− ,D.dullyellow "42","or",D.dullyellow"\"hello\"" <> "."
2310− ,"Once","there","is","something","there,","I","can","probably"
2311− ,"give","a","more","specific","hint!"
2312− ]
2313− , D.toSimpleNote $
2314− "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
2315− \ Or if I run into operators in unexpected spots. Point is, there are a\
2316− \ couple ways I can get confused and give sort of weird advice!"
2317− ]
2535+ if isMath then
2536+ D.fillSep
2537+ ["I","was","expecting","to","see","an","expression","next."
2538+ ,"Something","like",D.dullyellow "42","or",D.dullyellow "1000"
2539+ ,"that","makes","sense","with","a",D.fromName op,"sign."
2540+ ]
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+ ]
2547+ else if op == "|>" then
2548+ D.reflow $
2549+ "I was expecting to see a function next."
2550+ else if op == "<|" then
2551+ D.reflow $
2552+ "I was expecting to see an argument next."
2553+ else
2554+ D.reflow $
2555+ "I was expecting to see an expression next."
23182556 )
23192557
23202558 OperatorReserved operator row col ->
@@ -2353,7 +2591,7 @@ toExprReport source context expr startRow startCol =
23532591 ,"give","a","more","specific","hint!"
23542592 ]
23552593 , D.toSimpleNote $
2356− "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
2594+ "This can also happen if I run into reserved words like `let` or `as` unexpectedly.\
23572595 \ Or if I run into operators in unexpected spots. Point is, there are a\
23582596 \ couple ways I can get confused and give sort of weird advice!"
23592597 ]
@@ -2502,17 +2740,15 @@ toStringReport source string row col =
25022740 , D.toSimpleNote $
25032741 "For a string that spans multiple lines, you can use the multi-line string\
25042742 \ syntax like this:"
2505− , D.vcat
2506− [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2507− , mempty
2508− , D.dullyellow "# Multi-line Strings"
2509− , mempty
2510− , D.dullyellow "- start with triple double quotes"
2511− , D.dullyellow "- write whatever you want"
2512− , D.dullyellow "- no need to escape newlines or double quotes"
2513− , D.dullyellow "- end with triple double quotes"
2514− , mempty
2515− , D.dullyellow "\"\"\""
2743+ , D.dullyellow $ D.indent 4 $ D.vcat $
2744+ [ "\"\"\""
2745+ , "# Multi-line Strings"
2746+ , ""
2747+ , "- start with triple double quotes"
2748+ , "- write whatever you want"
2749+ , "- no need to escape newlines or double quotes"
2750+ , "- end with triple double quotes"
2751+ , "\"\"\""
25162752 ]
25172753 ]
25182754 )
@@ -2531,17 +2767,15 @@ toStringReport source string row col =
25312767 [ D.reflow "Add a \"\"\" somewhere after this to end the string."
25322768 , D.toSimpleNote $
25332769 "Here is a valid multi-line string for reference:"
2534− , D.vcat
2535− [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2536− , mempty
2537− , D.dullyellow "# Multi-line Strings"
2538− , mempty
2539− , D.dullyellow "- start with triple double quotes"
2540− , D.dullyellow "- write whatever you want"
2541− , D.dullyellow "- no need to escape newlines or double quotes"
2542− , D.dullyellow "- end with triple double quotes"
2543− , mempty
2544− , D.dullyellow "\"\"\""
2770+ , D.dullyellow $ D.indent 4 $ D.vcat $
2771+ [ "\"\"\""
2772+ , "# Multi-line Strings"
2773+ , ""
2774+ , "- start with triple double quotes"
2775+ , "- write whatever you want"
2776+ , "- no need to escape newlines or double quotes"
2777+ , "- end with triple double quotes"
2778+ , "\"\"\""
25452779 ]
25462780 ]
25472781 )
@@ -2793,7 +3027,7 @@ toOperatorReport source context operator row col =
27933027 ,
27943028 D.stack
27953029 [ D.reflow $
2796− "It makes sense to see arrows around here, so I suspect it is something earlier."
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?"
27973031 , noteForCaseIndentError
27983032 ]
27993033 )
@@ -2801,11 +3035,15 @@ toOperatorReport source context operator row col =
28013035 else
28023036 (
28033037 D.reflow $
2804− "I was not expecting an arrow here:"
3038+ "I was partway through parsing an expression when I got stuck on this arrow:"
28053039 ,
2806− D.reflow $
2807− "Arrows should only appear in `case` expressions and anonymous functions. Maybe\
2808− \ you want > or >= instead?"
3040+ D.stack
3041+ [ "Arrows should only appear in `case` expressions and anonymous functions.\n\
3042+ \Maybe it was supposed to be a > sign 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+ ]
28093047 )
28103048
28113049 BadEquals ->
@@ -3002,8 +3240,8 @@ toUnfinishLetReport source row col startRow startCol message =
30023240 [ message
30033241 , D.toSimpleNote $
30043242 "Here is an example with a valid `let` expression for reference:"
3005− , D.vcat $
3006− [ D.indent 0 $ D.fillSep [D.green "viewPerson","person","="]
3243+ , D.indent 4 $ D.vcat $
3244+ [ D.indent 0 $ D.fillSep ["viewPerson","person","="]
30073245 , D.indent 2 $ D.fillSep [D.cyan "let"]
30083246 , D.indent 4 $ D.fillSep ["fullName","="]
30093247 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]
@@ -3075,16 +3313,60 @@ toLetDefReport source name def startRow startCol =
30753313 Code.Keyword keyword ->
30763314 let
30773315 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3078− region = toKeywordRegion row col keyword
3316+ 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
30793349 in
3080− Report.Report "RESERVED WORD" region [] $
3350+ Report.Report "MISSING COLON?" region [] $
30813351 Code.toSnippet source surroundings (Just region)
30823352 (
30833353 D.reflow $
3084− "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
3354+ "I was not expecting to see an arrow here:"
30853355 ,
3086− D.reflow $
3087− "This is a reserved word! Try using some other name?"
3356+ D.stack
3357+ [ D.fillSep
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+ ]
30883370 )
30893371
30903372 Code.Operator op ->
@@ -3102,10 +3384,10 @@ toLetDefReport source name def startRow startCol =
31023384 [ D.reflow $
31033385 "I am not sure what is going wrong exactly, so here is a valid\
31043386 \ definition (with an optional type annotation) for reference:"
3105− , D.vcat
3106− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3107− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3108− , D.indent 6 $ D.fillSep ["x","+","y"]
3387+ , D.indent 4 $ D.vcat $
3388+ [ "greet : String -> String"
3389+ , "greet name ="
3390+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
31093391 ]
31103392 , D.reflow $
31113393 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -3127,10 +3409,10 @@ toLetDefReport source name def startRow startCol =
31273409 [ D.reflow $
31283410 "I am not sure what is going wrong exactly, so here is a valid\
31293411 \ definition (with an optional type annotation) for reference:"
3130− , D.vcat
3131− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3132− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3133− , D.indent 4 $ D.fillSep ["x","+","y"]
3412+ , D.indent 4 $ D.vcat $
3413+ [ "greet : String -> String"
3414+ , "greet name ="
3415+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
31343416 ]
31353417 , D.reflow $
31363418 "Try to use that format!"
@@ -3220,10 +3502,10 @@ defNote =
32203502 D.stack
32213503 [ D.reflow $
32223504 "Here is a valid definition (with a type annotation) for reference:"
3223− , D.vcat
3224− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3225− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3226− , D.indent 6 $ D.fillSep ["x","+","y"]
3505+ , D.indent 4 $ D.vcat $
3506+ [ "greet : String -> String"
3507+ , "greet name ="
3508+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
32273509 ]
32283510 , D.reflow $
32293511 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -3482,8 +3764,9 @@ noteForCaseIndentError =
34823764 , D.indent 8 $ D.fillSep [D.dullyellow "400"]
34833765 ]
34843766 , D.reflow $
3485− "Notice the indentation! Each pattern is aligned, and each branch is indented\
3486− \ a bit more than the corresponding pattern. That is important!"
3767+ "Notice the indentation! Patterns are aligned with each other. Same indentation.\
3768+ \ The expressions after each arrow are all indented a bit more than the patterns.\
3769+ \ That is important!"
34873770 ]
34883771
34893772
@@ -3635,23 +3918,43 @@ toIfReport source context if_ startRow startCol =
36353918 )
36363919
36373920 IfIndentElse row col ->
3638− let
3639− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3640− region = toRegion row col
3641− in
3642− Report.Report "UNFINISHED IF" region [] $
3643− Code.toSnippet source surroundings (Just region)
3644− (
3645− D.reflow $
3646− "I was expecting to see an `else` branch after this:"
3647− ,
3648− D.stack
3649− [ D.reflow $
3650− "I know what to do when the condition is `True`, but not when it is `False`."
3651− , D.fillSep
3652− ["Add","an",D.cyan "else","branch","to","handle","that","scenario!"]
3653− ]
3654− )
3921+ case Code.nextLineStartsWithKeyword "else" source row of
3922+ Just (elseRow, elseCol) ->
3923+ 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)
3942+ region = toRegion row col
3943+ in
3944+ Report.Report "UNFINISHED IF" region [] $
3945+ Code.toSnippet source surroundings (Just region)
3946+ (
3947+ D.reflow $
3948+ "I was expecting to see an `else` branch after this:"
3949+ ,
3950+ D.stack
3951+ [ D.fillSep
3952+ ["I","know","what","to","do","when","the","condition","is","True,"
3953+ ,"but","what","happens","when","it","is","False?"
3954+ ,"Add","an",D.cyan "else","branch","to","handle","that","scenario!"
3955+ ]
3956+ ]
3957+ )
36553958
36563959
36573960
@@ -3684,15 +3987,22 @@ toRecordReport source context record startRow startCol =
36843987 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
36853988 region = toRegion row col
36863989 in
3687− Report.Report "UNFINISHED RECORD" region [] $
3990+ Report.Report "PROBLEM IN RECORD" region [] $
36883991 Code.toSnippet source surroundings (Just region)
36893992 (
36903993 D.reflow $
36913994 "I just started parsing a record, but I got stuck here:"
36923995 ,
3693− D.fillSep
3694− ["Records","look","like",D.dullyellow "{ x = 3, y = 4 },"
3695− ,"so","I","was","expecting","to","see","a","field","name","next."
3996+ D.stack
3997+ [ D.fillSep
3998+ ["I","was","expecting","to","see","a","record","field","defined","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
36964006 ]
36974007 )
36984008
@@ -3701,7 +4011,7 @@ toRecordReport source context record startRow startCol =
37014011 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
37024012 region = toRegion row col
37034013 in
3704− Report.Report "UNFINISHED RECORD" region [] $
4014+ Report.Report "PROBLEM IN RECORD" region [] $
37054015 Code.toSnippet source surroundings (Just region)
37064016 (
37074017 D.reflow $
@@ -3736,22 +4046,67 @@ toRecordReport source context record startRow startCol =
37364046 \ that is a reserved word. Try using a different name!"
37374047 )
37384048
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+
37394088 _ ->
37404089 let
37414090 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
37424091 region = toRegion row col
37434092 in
3744− Report.Report "UNFINISHED RECORD" region [] $
4093+ Report.Report "PROBLEM IN RECORD" region [] $
37454094 Code.toSnippet source surroundings (Just region)
37464095 (
37474096 D.reflow $
3748− "I am partway through parsing a record, but I got stuck after that last comma:"
4097+ "I am partway through parsing a record, but I got stuck here:"
37494098 ,
3750− addNoteForRecordError $
3751− D.reflow $
3752− "Trailing commas are not allowed in records, so I was expecting to see another\
3753− \ record field defined next. If you are done defining the record, the fix may\
3754− \ be to delete that last comma?"
4099+ D.stack
4100+ [ D.fillSep
4101+ ["I","was","expecting","to","see","another","record","field","defined","next,"
4102+ ,"so","I","am","looking","for","a","name","like"
4103+ ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."
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+ ]
37554110 )
37564111
37574112 RecordEquals row col ->
@@ -3759,17 +4114,19 @@ toRecordReport source context record startRow startCol =
37594114 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
37604115 region = toRegion row col
37614116 in
3762− Report.Report "UNFINISHED RECORD" region [] $
4117+ Report.Report "PROBLEM IN RECORD" region [] $
37634118 Code.toSnippet source surroundings (Just region)
37644119 (
37654120 D.reflow $
37664121 "I am partway through parsing a record, but I got stuck here:"
37674122 ,
3768− addNoteForRecordError $
3769− D.fillSep $
3770− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
3771− ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"
3772− ]
4123+ D.stack
4124+ [ D.fillSep $
4125+ ["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?"
4127+ ]
4128+ , noteForRecordError
4129+ ]
37734130 )
37744131
37754132 RecordExpr expr row col ->
@@ -3789,29 +4146,54 @@ toRecordReport source context record startRow startCol =
37894146 D.reflow $
37904147 "I just saw the opening curly brace of a record, but then I got stuck here:"
37914148 ,
3792− addNoteForRecordIndentError $
3793− D.fillSep $
3794− ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."
3795− ,"Try","defining","some","fields","of","your","own?"
3796− ]
4149+ D.stack
4150+ [ D.fillSep $
4151+ ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."
4152+ ,"Try","defining","some","fields","of","your","own?"
4153+ ]
4154+ , noteForRecordIndentError
4155+ ]
37974156 )
37984157
37994158 RecordIndentEnd row col ->
3800− let
3801− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3802− region = toRegion row col
3803− in
3804− Report.Report "UNFINISHED RECORD" region [] $
3805− Code.toSnippet source surroundings (Just region)
3806− (
3807− D.reflow $
3808− "I was expecting to see a closing curly brace next:"
3809− ,
3810− addNoteForRecordIndentError $
3811− D.fillSep $
3812− ["Try","putting","an",D.green "}","and","see","if","that","helps?"
3813− ]
3814− )
4159+ case Code.nextLineStartsWithCloseCurly source row of
4160+ Just (curlyRow, curlyCol) ->
4161+ 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)
4181+ region = toRegion row col
4182+ in
4183+ Report.Report "UNFINISHED RECORD" region [] $
4184+ Code.toSnippet source surroundings (Just region)
4185+ (
4186+ 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."
4192+ ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"
4193+ ]
4194+ , noteForRecordIndentError
4195+ ]
4196+ )
38154197
38164198 RecordIndentField row col ->
38174199 let
@@ -3824,11 +4206,13 @@ toRecordReport source context record startRow startCol =
38244206 D.reflow $
38254207 "I am partway through parsing a record, but I got stuck after that last comma:"
38264208 ,
3827− addNoteForRecordError $
3828− D.reflow $
3829− "Trailing commas are not allowed in records, so the fix may be to\
3830− \ delete that last comma? Or maybe you were in the middle of defining\
3831− \ an additional field?"
4209+ D.stack
4210+ [ D.reflow $
4211+ "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\
4213+ \ an additional field?"
4214+ , noteForRecordError
4215+ ]
38324216 )
38334217
38344218 RecordIndentEquals row col ->
@@ -3843,10 +4227,12 @@ toRecordReport source context record startRow startCol =
38434227 "I am partway through parsing a record. I just saw a record\
38444228 \ field, so I was expecting to see an equals sign next:"
38454229 ,
3846− addNoteForRecordIndentError $
3847− D.fillSep $
3848− ["Try","putting","an",D.green "=","followed","by","an","expression?"
3849− ]
4230+ D.stack
4231+ [ D.fillSep $
4232+ ["Try","putting","an",D.green "=","followed","by","an","expression?"
4233+ ]
4234+ , noteForRecordIndentError
4235+ ]
38504236 )
38514237
38524238 RecordIndentExpr row col ->
@@ -3860,52 +4246,48 @@ toRecordReport source context record startRow startCol =
38604246 D.reflow $
38614247 "I am partway through parsing a record, and I was expecting to run into an expression next:"
38624248 ,
3863− addNoteForRecordIndentError $
3864− D.fillSep $
3865− ["Try","putting","something","like"
3866− ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"
3867− ]
4249+ D.stack
4250+ [ D.fillSep $
4251+ ["Try","putting","something","like"
4252+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"
4253+ ]
4254+ , noteForRecordIndentError
4255+ ]
38684256 )
38694257
38704258
3871−addNoteForRecordError :: D.Doc -> D.Doc
3872−addNoteForRecordError normalRecommendation =
4259+noteForRecordError :: D.Doc
4260+noteForRecordError =
38734261 D.stack $
3874− normalRecommendation
3875− :
38764262 [ D.toSimpleNote
38774263 "If you are trying to define a record across multiple lines, I recommend using this format:"
38784264 , D.indent 4 $ D.vcat $
3879− [ "{ name = \"Alice\""
3880− , ", age = 42"
3881− , ", height = 1.75"
4265+ [ "{ name = " <> D.dullyellow "\"Alice\""
4266+ , ", age = " <> D.dullyellow "42"
4267+ , ", height = " <> D.dullyellow "1.75"
38824268 , "}"
38834269 ]
38844270 , D.reflow $
3885− "Notice that each line starts with some indentation. Usually two or four spaces. I\
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."
4271+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4272+ \ This is the stylistic convention in the Elm ecosystem."
38884273 ]
38894274
38904275
3891−addNoteForRecordIndentError :: D.Doc -> D.Doc
3892−addNoteForRecordIndentError normalRecommendation =
3893− D.stack $
3894− normalRecommendation
3895− :
4276+noteForRecordIndentError :: D.Doc
4277+noteForRecordIndentError =
4278+ D.stack
38964279 [ D.toSimpleNote
38974280 "I may be confused by indentation. For example, if you are trying to define\
38984281 \ a record across multiple lines, I recommend using this format:"
38994282 , D.indent 4 $ D.vcat $
3900− [ "{ name = \"Alice\""
3901− , ", age = 42"
3902− , ", height = 1.75"
4283+ [ "{ name = " <> D.dullyellow "\"Alice\""
4284+ , ", age = " <> D.dullyellow "42"
4285+ , ", height = " <> D.dullyellow "1.75"
39034286 , "}"
39044287 ]
39054288 , D.reflow $
3906− "Notice that each line starts with some indentation. Usually two or four spaces. I\
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."
4289+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4290+ \ This is the stylistic convention in the Elm ecosystem!"
39094291 ]
39104292
39114293
@@ -4094,15 +4476,14 @@ toListReport source context list startRow startCol =
40944476 , D.toSimpleNote
40954477 "I recommend using the following format for lists that span multiple lines:"
40964478 , D.indent 4 $ D.vcat $
4097− [ "[ \"Alice\""
4098− , ", \"Bob\""
4099− , ", \"Chuck\""
4479+ [ "[ " <> D.dullyellow "\"Alice\""
4480+ , ", " <> D.dullyellow "\"Bob\""
4481+ , ", " <> D.dullyellow "\"Chuck\""
41004482 , "]"
41014483 ]
41024484 , D.reflow $
4103− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
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."
4485+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4486+ \ This is the stylistic convention in the Elm ecosystem."
41064487 ]
41074488 )
41084489
@@ -4155,15 +4536,14 @@ toListReport source context list startRow startCol =
41554536 "I may be confused by indentation. For example, if you are trying to define\
41564537 \ a list across multiple lines, I recommend using this format:"
41574538 , D.indent 4 $ D.vcat $
4158− [ "[ \"Alice\""
4159− , ", \"Bob\""
4160− , ", \"Chuck\""
4539+ [ "[ " <> D.dullyellow "\"Alice\""
4540+ , ", " <> D.dullyellow "\"Bob\""
4541+ , ", " <> D.dullyellow "\"Chuck\""
41614542 , "]"
41624543 ]
41634544 , D.reflow $
4164− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
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."
4545+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4546+ \ This is the stylistic convention in the Elm ecosystem."
41674547 ]
41684548 )
41694549
@@ -4187,15 +4567,14 @@ toListReport source context list startRow startCol =
41874567 "I may be confused by indentation. For example, if you are trying to define\
41884568 \ a list across multiple lines, I recommend using this format:"
41894569 , D.indent 4 $ D.vcat $
4190− [ "[ \"Alice\""
4191− , ", \"Bob\""
4192− , ", \"Chuck\""
4570+ [ "[ " <> D.dullyellow "\"Alice\""
4571+ , ", " <> D.dullyellow "\"Bob\""
4572+ , ", " <> D.dullyellow "\"Chuck\""
41934573 , "]"
41944574 ]
41954575 , D.reflow $
4196− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
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."
4576+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4577+ \ This is the stylistic convention in the Elm ecosystem."
41994578 ]
42004579 )
42014580
@@ -4216,15 +4595,14 @@ toListReport source context list startRow startCol =
42164595 , D.toSimpleNote
42174596 "I recommend using the following format for lists that span multiple lines:"
42184597 , D.indent 4 $ D.vcat $
4219− [ "[ \"Alice\""
4220− , ", \"Bob\""
4221− , ", \"Chuck\""
4598+ [ "[ " <> D.dullyellow "\"Alice\""
4599+ , ", " <> D.dullyellow "\"Bob\""
4600+ , ", " <> D.dullyellow "\"Chuck\""
42224601 , "]"
42234602 ]
42244603 , D.reflow $
4225− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
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."
4604+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4605+ \ This is the stylistic convention in the Elm ecosystem."
42284606 ]
42294607 )
42304608
@@ -5097,22 +5475,64 @@ toTRecordReport source context record startRow startCol =
50975475 \ that is a reserved word. Try using a different name!"
50985476 )
50995477
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+
51005517 _ ->
51015518 let
51025519 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
51035520 region = toRegion row col
51045521 in
5105− Report.Report "UNFINISHED RECORD TYPE" region [] $
5522+ Report.Report "PROBLEM IN RECORD TYPE" region [] $
51065523 Code.toSnippet source surroundings (Just region)
51075524 (
51085525 D.reflow $
5109− "I am partway through parsing a record type, but I got stuck after that last comma:"
5526+ "I am partway through parsing a record type, but I got stuck here:"
51105527 ,
5111− addNoteForRecordTypeError $
5112− D.reflow $
5113− "Trailing commas are not allowed in records, so I was expecting to see another\
5114− \ record field defined next. If you are done defining the record, the fix may\
5115− \ be to delete that last comma?"
5528+ D.stack
5529+ [ D.fillSep
5530+ ["I","was","expecting","to","see","another","record","field","defined","next,"
5531+ ,"so","I","am","looking","for","a","name","like"
5532+ ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."
5533+ ]
5534+ , noteForRecordTypeError
5535+ ]
51165536 )
51175537
51185538 TRecordColon row col ->
@@ -5126,11 +5546,13 @@ toTRecordReport source context record startRow startCol =
51265546 D.reflow $
51275547 "I am partway through parsing a record type, but I got stuck here:"
51285548 ,
5129− addNoteForRecordTypeError $
5130− D.fillSep $
5131− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
5132− ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"
5133− ]
5549+ D.stack
5550+ [ D.fillSep $
5551+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
5552+ ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"
5553+ ]
5554+ , noteForRecordTypeError
5555+ ]
51345556 )
51355557
51365558 TRecordType tipe row col ->
@@ -5150,29 +5572,54 @@ toTRecordReport source context record startRow startCol =
51505572 D.reflow $
51515573 "I just saw the opening curly brace of a record type, but then I got stuck here:"
51525574 ,
5153− addNoteForRecordTypeIndentError $
5154− D.fillSep $
5155− ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."
5156− ,"Try","defining","some","fields","of","your","own?"
5157− ]
5575+ D.stack
5576+ [ D.fillSep $
5577+ ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."
5578+ ,"Try","defining","some","fields","of","your","own?"
5579+ ]
5580+ , noteForRecordTypeIndentError
5581+ ]
51585582 )
51595583
51605584 TRecordIndentEnd row col ->
5161− let
5162− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5163− region = toRegion row col
5164− in
5165− Report.Report "UNFINISHED RECORD TYPE" region [] $
5166− Code.toSnippet source surroundings (Just region)
5167− (
5168− D.reflow $
5169− "I was expecting to see a closing curly brace next:"
5170− ,
5171− addNoteForRecordTypeIndentError $
5172− D.fillSep $
5173− ["Try","putting","an",D.green "}","and","see","if","that","helps?"
5174− ]
5175− )
5585+ case Code.nextLineStartsWithCloseCurly source row of
5586+ Just (curlyRow, curlyCol) ->
5587+ 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)
5607+ region = toRegion row col
5608+ in
5609+ Report.Report "UNFINISHED RECORD TYPE" region [] $
5610+ Code.toSnippet source surroundings (Just region)
5611+ (
5612+ 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."
5618+ ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"
5619+ ]
5620+ , noteForRecordTypeIndentError
5621+ ]
5622+ )
51765623
51775624 TRecordIndentField row col ->
51785625 let
@@ -5185,11 +5632,13 @@ toTRecordReport source context record startRow startCol =
51855632 D.reflow $
51865633 "I am partway through parsing a record type, but I got stuck after that last comma:"
51875634 ,
5188− addNoteForRecordTypeIndentError $
5189− D.reflow $
5190− "Trailing commas are not allowed in record types, so the fix may be to\
5191− \ delete that last comma? Or maybe you were in the middle of defining\
5192− \ an additional field?"
5635+ D.stack
5636+ [ D.reflow $
5637+ "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\
5639+ \ an additional field?"
5640+ , noteForRecordTypeIndentError
5641+ ]
51935642 )
51945643
51955644 TRecordIndentColon row col ->
@@ -5204,10 +5653,12 @@ toTRecordReport source context record startRow startCol =
52045653 "I am partway through parsing a record type. I just saw a record\
52055654 \ field, so I was expecting to see a colon next:"
52065655 ,
5207− addNoteForRecordTypeIndentError $
5208− D.fillSep $
5209− ["Try","putting","an",D.green ":","followed","by","a","type?"
5210− ]
5656+ D.stack
5657+ [ D.fillSep $
5658+ ["Try","putting","an",D.green ":","followed","by","a","type?"
5659+ ]
5660+ , noteForRecordTypeIndentError
5661+ ]
52115662 )
52125663
52135664 TRecordIndentType row col ->
@@ -5221,19 +5672,19 @@ toTRecordReport source context record startRow startCol =
52215672 D.reflow $
52225673 "I am partway through parsing a record type, and I was expecting to run into a type next:"
52235674 ,
5224− addNoteForRecordTypeIndentError $
5225− D.fillSep $
5226− ["Try","putting","something","like"
5227− ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"
5228− ]
5675+ D.stack
5676+ [ D.fillSep $
5677+ ["Try","putting","something","like"
5678+ ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"
5679+ ]
5680+ , noteForRecordTypeIndentError
5681+ ]
52295682 )
52305683
52315684
5232−addNoteForRecordTypeError :: D.Doc -> D.Doc
5233−addNoteForRecordTypeError normalRecommendation =
5685+noteForRecordTypeError :: D.Doc
5686+noteForRecordTypeError =
52345687 D.stack $
5235− normalRecommendation
5236− :
52375688 [ D.toSimpleNote
52385689 "If you are trying to define a record type across multiple lines, I recommend using this format:"
52395690 , D.indent 4 $ D.vcat $
@@ -5243,17 +5694,14 @@ addNoteForRecordTypeError normalRecommendation =
52435694 , "}"
52445695 ]
52455696 , D.reflow $
5246− "Notice that each line starts with some indentation. Usually two or four spaces. I\
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."
5697+ "Notice that each line starts with some indentation. Usually two or four spaces.\
5698+ \ This is the stylistic convention in the Elm ecosystem."
52495699 ]
52505700
52515701
5252−addNoteForRecordTypeIndentError :: D.Doc -> D.Doc
5253−addNoteForRecordTypeIndentError normalRecommendation =
5702+noteForRecordTypeIndentError :: D.Doc
5703+noteForRecordTypeIndentError =
52545704 D.stack $
5255− normalRecommendation
5256− :
52575705 [ D.toSimpleNote
52585706 "I may be confused by indentation. For example, if you are trying to define\
52595707 \ a record type across multiple lines, I recommend using this format:"
@@ -5264,9 +5712,8 @@ addNoteForRecordTypeIndentError normalRecommendation =
52645712 , "}"
52655713 ]
52665714 , D.reflow $
5267− "Notice that each line starts with some indentation. Usually two or four spaces. I\
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."
5715+ "Notice that each line starts with some indentation. Usually two or four spaces.\
5716+ \ This is the stylistic convention in the Elm ecosystem."
52705717 ]
52715718
52725719
compiler/src/Reporting/Error/Type.hs+23−7
@@ -431,10 +431,6 @@ problemToHint problem =
431431 ]
432432 ]
433433
434− T.AnythingToList ->
435− [ D.toSimpleHint "Did you forget to add [] around it?"
436− ]
437−
438434 T.ArityMismatch x y ->
439435 [ D.toSimpleHint $
440436 if x < y then
@@ -563,11 +559,31 @@ badFlexSuper :: T.Direction -> T.Super -> T.Type -> [D.Doc]
563559badFlexSuper direction super tipe =
564560 case super of
565561 T.Comparable ->
566− [ D.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable."
567− ]
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\
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+ ]
568584
569585 T.Appendable ->
570− [ D.toSimpleHint "Only strings and lists are appendable."
586+ [ D.toSimpleHint "I only know how to append strings and lists."
571587 ]
572588
573589 T.CompAppend ->
compiler/src/Reporting/Render/Code.hs+65−24
@@ -7,6 +7,8 @@ module Reporting.Render.Code
77 , toPair
88 , Next(..)
99 , whatIsNext
10+ , nextLineStartsWithKeyword
11+ , nextLineStartsWithCloseCurly
1012 )
1113 where
1214
@@ -120,7 +122,7 @@ makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end
120122 spaces = replicate (fromIntegral c1 + width + 1) ' '
121123 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
122124 in
123− Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
125+ Just (D.fromChars spaces <> D.red (D.fromChars zigzag))
124126
125127
126128drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
@@ -146,7 +148,7 @@ addLineNumber addZigZag width start end n line =
146148
147149 spacer =
148150 if addZigZag && start <= n && n <= end then
149− D.dullred ">"
151+ D.red ">"
150152 else
151153 " "
152154 in
@@ -181,8 +183,8 @@ renderPair source@(Source sourceLines) region1 region2 =
181183 OneLine $
182184 D.vcat
183185 [ D.fromChars lineNumber <> "| " <> D.fromChars line
184− , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
185− D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
186+ , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>
187+ D.fromChars spaces2 <> D.red (D.fromChars zigzag2)
186188 ]
187189
188190 else
@@ -199,6 +201,8 @@ data Next
199201 = Keyword [Char]
200202 | Operator [Char]
201203 | Close [Char] Char
204+ | Upper Char [Char]
205+ | Lower Char [Char]
202206 | Other (Maybe Char)
203207
204208
@@ -209,25 +213,34 @@ whatIsNext (Source sourceLines) row col =
209213 Other Nothing
210214
211215 Just line ->
212− let
213− chars = drop (fromIntegral col - 1) line
214− keywords = map Name.toChars (Set.toList reservedWords)
215− in
216− case List.find (startsWithKeyword chars) keywords of
217− Just keyword ->
218− Keyword keyword
219−
220− Nothing ->
221− case chars of
222− [] ->
223− Other Nothing
224−
225− c:cs
226− | isSymbol c -> Operator (c : takeWhile isSymbol cs)
227− | c == ')' -> Close "parenthesis" ')'
228− | c == ']' -> Close "square bracket" ']'
229− | c == '}' -> Close "curly brace" '}'
230− | otherwise -> Other (Just c)
216+ case drop (fromIntegral col - 1) line of
217+ [] ->
218+ Other Nothing
219+
220+ c:cs
221+ | Char.isUpper c -> Upper c (takeWhile isInner cs)
222+ | Char.isLower c -> detectKeywords c cs
223+ | isSymbol c -> Operator (c : takeWhile isSymbol cs)
224+ | c == ')' -> Close "parenthesis" ')'
225+ | c == ']' -> Close "square bracket" ']'
226+ | c == '}' -> Close "curly brace" '}'
227+ | 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 == '_'
231244
232245
233246isSymbol :: Char -> Bool
@@ -244,4 +257,32 @@ startsWithKeyword restOfLine keyword =
244257 True
245258
246259 c:_ ->
247− not (Char.isAlphaNum c || c == '_')
260+ not (isInner 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 =
112112 Only (foldr addType Set.empty exposedList)
113113
114114
115−addType :: A.Located Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
116−addType (A.At _ exposed) types =
115+addType :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
116+addType exposed types =
117117 case exposed of
118− Src.Lower _ -> types
119− Src.Upper name _ -> Set.insert name types
120− Src.Operator _ -> types
118+ Src.Lower _ -> types
119+ Src.Upper (A.At _ name) _ -> Set.insert name types
120+ Src.Operator _ _ -> types
compiler/src/Type/Error.hs+8−2
@@ -175,7 +175,6 @@ data Problem
175175 | StringToFloat
176176 | AnythingToBool
177177 | AnythingFromMaybe
178− | AnythingToList
179178 | ArityMismatch Int Int
180179 | BadFlexSuper Direction Super Name.Name Type
181180 | BadRigidVar Name.Name Type
@@ -301,7 +300,7 @@ toDiff localizer ctx tipe1 tipe2 =
301300 different
302301 (toDoc localizer ctx t1)
303302 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])
304− (Bag.one AnythingToList)
303+ Bag.empty
305304
306305 (Alias home1 name1 args1 t1, t2) ->
307306 case diffAliasedRecord localizer t1 t2 of
@@ -450,6 +449,13 @@ isSuper super tipe =
450449 Appendable -> isString h n || isList h n
451450 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)
452451
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+
453459 _ ->
454460 False
455461
compiler/src/Type/Unify.hs+5−8
@@ -391,13 +391,13 @@ unifyFlexSuperStructure context super flatType =
391391
392392 Comparable ->
393393 do comparableOccursCheck context
394− merge context (Structure flatType)
395394 unifyComparableRecursive variable
395+ merge context (Structure flatType)
396396
397397 CompAppend ->
398398 do comparableOccursCheck context
399− merge context (Structure flatType)
400399 unifyComparableRecursive variable
400+ merge context (Structure flatType)
401401
402402 Tuple1 a b maybeC ->
403403 case super of
@@ -409,15 +409,12 @@ unifyFlexSuperStructure context super flatType =
409409
410410 Comparable ->
411411 do comparableOccursCheck context
412− merge context (Structure flatType)
413412 unifyComparableRecursive a
414413 unifyComparableRecursive b
415414 case maybeC of
416− Nothing ->
417− return ()
418−
419− Just c ->
420− unifyComparableRecursive c
415+ Nothing -> return ()
416+ Just c -> unifyComparableRecursive c
417+ merge context (Structure flatType)
421418
422419 CompAppend ->
423420 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
88 "source-directories": [
99 "src"
1010 ],
11− "elm-version": "0.19.0",
11+ "elm-version": "0.19.1",
1212 "dependencies": {
1313 "direct": {
1414 "elm/browser": "1.0.0",
@@ -48,7 +48,7 @@ A list of directories where Elm code lives. Most projects just use `"src"` for e
4848
4949## `"elm-version"`
5050
51−The exact version of Elm this builds with. Should be `"0.19.0"` for most people!
51+The exact version of Elm this builds with. Should be `"0.19.1"` for most people!
5252
5353<br>
5454
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
4949
5050## `"license"`
5151
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/).
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/).
5353
5454<br>
5555
upgrade-docs/0.16.md → docs/upgrade-instructions/0.16.mdrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

docs/upgrade-instructions/0.19.1.mdnew file+60
@@ -0,0 +1,60 @@
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 (..)`
upgrade-docs/earlier.md → docs/upgrade-instructions/earlier.mdrenamed

The content is the same.

elm.cabal+6−5
@@ -45,6 +45,7 @@ Executable elm
4545 Hs-Source-Dirs:
4646 compiler/src
4747 builder/src
48+ terminal/impl
4849 terminal/src
4950
5051 other-extensions:
@@ -64,11 +65,11 @@ Executable elm
6465 Repl
6566
6667 -- terminal args
67− Terminal.Args
68− Terminal.Args.Chomp
69− Terminal.Args.Error
70− Terminal.Args.Helpers
71− Terminal.Args.Internal
68+ Terminal
69+ Terminal.Chomp
70+ Terminal.Error
71+ Terminal.Helpers
72+ Terminal.Internal
7273
7374 -- from terminal/
7475 Develop.Generate.Help
hints/bad-recursion.md+26−29
@@ -5,12 +5,12 @@ There are two problems that will lead you here, both of them pretty tricky:
55
66 1. [**No Mutation**](#no-mutation) &mdash; Defining values in Elm is slightly different than defining values in languages like JavaScript.
77
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.
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.
99
1010
1111## No Mutation
1212
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?
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?
1414
1515Well, what does it mean with functions? In Elm, we write recursive functions like this:
1616
@@ -51,10 +51,11 @@ type alias Comment =
5151 , responses : Responses
5252 }
5353
54−type Responses = Responses (List Comment)
54+type Responses =
55+ Responses (List Comment)
5556```
5657
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:
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:
5859
5960```elm
6061import Json.Decode as Decode exposing (Decoder)
@@ -91,46 +92,42 @@ decodeComment =
9192-- SOLUTION
9293decodeResponses : Decoder Responses
9394decodeResponses =
94− Decode.map Responses (Decode.list (Decode.lazy (\\_ -> decodeComment)))
95+ Decode.map Responses (Decode.list (Decode.lazy (\_ -> decodeComment)))
9596```
9697
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!
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!
9899
100+This saves us from expanding the value infinitely. Instead we only expand the value if we need to.
99101
100−### Summary
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.
101103
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.
103104
104−**Solution:** put the recursion behind an anonymous function.
105+## Understanding “Bad Recursion”
105106
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:
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?
107108
108−```elm
109−import Random exposing (Generator, andThen)
110−import Random.Extra exposing (constant)
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:
111110
112−lazy : (() -> Generator a) -> Generator a
113−lazy delayedGenerator =
114− constant ()
115− |> andThen delayedGenerator
111+```elm
112+factorial =
113+ \n -> if n <= 0 then 1 else n * factorial (n - 1)
116114```
117115
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!
119−
120−
121−## Defining “Bad” Recursion
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.
122117
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?
124−
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:
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:
126119
127120```elm
128−factorial =
129− \\n -> if n <= 0 then 1 else n * factorial (n - 1)
121+x =
122+ (\_ -> x) () + 1
130123```
131124
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.
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!
126+
127+This is called [the halting problem](https://en.wikipedia.org/wiki/Halting_problem) in computer science. Computational theorists were asking:
128+
129+> Can we determine if a program will finish running (i.e. halt) or if it will continue to run forever?
133130
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).
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!
135132
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*.
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*.**
hints/comparing-custom-types.mdnew file+98
@@ -0,0 +1,98 @@
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.mdnew file+85
@@ -0,0 +1,85 @@
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+1−4
@@ -16,9 +16,6 @@ Languages that will add in implicit casts for addition include:
1616
1717These languages generally agree that an `Int` may be implicitly cast to a `Float` when necessary. So everyone is doing it, why not Elm?!
1818
19−> **Note:** Ruby does not follow the trend. They implicitly cast a `Float` to an `Int`, truncating all the decimal points!
20−
21−
2219## Type Inference + Implicit Casts
2320
2421Elm comes from the ML-family of languages. Languages in the ML-family that **never** do implicit casts include:
@@ -41,7 +38,7 @@ So for any ML-family language designed before Scala, it is safe to assume that i
4138
4239 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.
4340
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.
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.
4542
4643
4744## Conclusion
hints/import-cycles.md+1−1
@@ -55,7 +55,7 @@ type alias User =
5555 }
5656```
5757
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:
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:
5959
6060```elm
6161module 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
2121
2222```bash
2323elm 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
2525```
2626
2727After this you will have an `elm.js` and a significantly smaller `elm.min.js` file!
@@ -46,7 +46,7 @@ min="elm.min.js"
4646
4747elm make --optimize --output=$js $@
4848
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
5050
5151echo "Initial size: $(cat $js | wc -c) bytes ($js)"
5252echo "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
3939
4040## Recursive type aliases?
4141
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:
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:
4343
4444```elm
4545type alias Comment =
@@ -102,7 +102,7 @@ type Comment =
102102 }
103103```
104104
105−Now lets say you want to register an upvote on a comment:
105+Now let's say you want to register an upvote on a comment:
106106
107107```elm
108108upvote : Comment -> Comment
hints/type-annotations.md+1−3
@@ -8,7 +8,7 @@ This document is going to outline the various things that can go wrong and show
88
99## Annotation vs. Definition
1010
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:
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:
1212
1313```elm
1414addPair : (a, a) -> a
@@ -58,5 +58,3 @@ filter isOkay list =
5858This 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.
5959
6060For 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.mdnew file+32
@@ -0,0 +1,32 @@
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+33−18
@@ -1,24 +1,39 @@
1−# https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9
1+# Based initially on 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
217
3−FROM alpine:3.10
18+# Use Alpine 3.11 with GHC 8.6.5
19+FROM alpine:3.11
420
5−# branch
6−ARG branch=master
7−# commit or tag
8−ARG commit=HEAD
21+# Install packages required to build elm
22+RUN apk add --no-cache ghc cabal wget musl-dev zlib-dev zlib-static ncurses-dev ncurses-static
923
10−# Install required packages
11−RUN apk add --update ghc cabal git musl-dev zlib-dev ncurses-dev ncurses-static wget
24+WORKDIR /elm
1225
13−# Checkout elm compiler
14−WORKDIR /tmp
15−RUN git clone -b $branch https://github.com/elm/compiler.git
26+# Import source code
27+COPY builder builder
28+COPY compiler compiler
29+COPY reactor reactor
30+COPY terminal terminal
31+COPY cabal.config elm.cabal LICENSE ./
1632
17−# Build a statically linked elm binary
18−WORKDIR /tmp/compiler
19−RUN git checkout $commit
20−RUN rm worker/elm.cabal
33+# Build statically linked elm binary
2134RUN cabal new-update
22−RUN cabal new-configure --disable-executable-dynamic --ghc-option=-optl=-static --ghc-option=-optl=-pthread
23−RUN cabal new-build
24−RUN strip -s ./dist-newstyle/build/x86_64-linux/ghc-8.4.3/elm-0.19.1/x/elm/build/elm/elm
35+RUN cabal new-build --ghc-option=-optl=-static --ghc-option=-split-sections
36+RUN cp ./dist-newstyle/build/x86_64-linux/ghc-*/elm-*/x/elm/build/elm/elm /usr/local/bin/elm
37+
38+# Remove debug symbols to optimize the binary size
39+RUN strip -s /usr/local/bin/elm
installers/linux/README.mdnew file+93
@@ -0,0 +1,93 @@
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+5−3
@@ -1,6 +1,6 @@
11<?xml version="1.0" encoding="utf-8" standalone="no"?>
22<installer-script minSpecVersion="1.000000" authoringTool="com.apple.PackageMaker" authoringToolVersion="3.0.6" authoringToolBuild="201">
3− <title>Elm Platform</title>
3+ <title>Elm</title>
44 <options customize="allow" allow-external-scripts="no"/>
55 <domains enable_localSystem="true"/>
66 <volume-check script="pm_volume_check();"/>
@@ -10,7 +10,7 @@
1010function pm_volume_check() {
1111 if(!(my.target.systemVersion &amp;&amp; /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {
1212 my.result.title = 'Failure';
13− my.result.message = 'This version of Elm Platform requires Mac OS X 10.6 or later.';
13+ my.result.message = 'This version of Elm requires Mac OS X 10.6 or later.';
1414 my.result.type = 'Fatal';
1515 return false;
1616 }
@@ -18,13 +18,15 @@ function pm_volume_check() {
1818}
1919
2020</script>
21+ <!--
2122 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>
23+ -->
2224 <welcome mime-type="text/rtf" file="welcome.rtf" />
2325 <conclusion mime-type="text/rtf" file="conclusion.rtf" />
2426 <choices-outline>
2527 <line choice="choice2"/>
2628 </choices-outline>
27− <choice id="choice2" title="Elm Platform ">
29+ <choice id="choice2" title="Elm">
2830 <pkg-ref id="org.elm-lang.binaries.pkg"/>
2931 </choice>
3032 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>
installers/mac/README.mdnew file+93
@@ -0,0 +1,93 @@
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.pngdeleted

Binary file not shown.

installers/mac/Resources/en.lproj/conclusion.rtf+13−6
@@ -1,9 +1,16 @@
1−{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400
2−{\fonttbl\f0\fswiss\fcharset0 Helvetica;}
1+{\rtf1\ansi\ansicpg1252\cocoartf2509
2+\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}
33{\colortbl;\red255\green255\blue255;}
4−\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0
5−\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural
4+{\*\expandedcolortbl;;}
5+\paperw11900\paperh16840\margl1440\margr1440\vieww11180\viewh8400\viewkind0
6+\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0
67
7−\f0\fs26 \cf0 A bunch of useful programs were just placed in /usr/local/bin/\
8+\f0\fs28 \cf0 Try opening the terminal and running commands like:\
89\
9−Check out {\field{\*\fldinst HYPERLINK "http://elm-lang.org/Get-Started.elm"}{\fldrslt this tutorial}} to learn how to use them!}
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!}
installers/mac/Resources/en.lproj/welcome.rtf+9−4
@@ -1,7 +1,12 @@
1−{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400
2−{\fonttbl\f0\fswiss\fcharset0 Helvetica;}
1+{\rtf1\ansi\ansicpg1252\cocoartf2509
2+\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}
33{\colortbl;\red255\green255\blue255;}
4+{\*\expandedcolortbl;;}
45\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0
5−\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural
6+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural\partightenfactor0
67
7−\f0\fs28 \cf0 This package will install Elm on your machine.}
8+\f0\fs28 \cf0 Thank you for trying out Elm!\
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 @@
11#!/bin/sh
22
3−open 'http://elm-lang.org'
3+open 'http://guide.elm-lang.org'
installers/mac/make-installer.sh+30−3
@@ -29,7 +29,8 @@ cp $(pwd)/preinstall $pkg_scripts
2929cp $(pwd)/postinstall $pkg_scripts
3030
3131pkgbuild \
32− --identifier org.elm-lang.binaries.pkg \
32+ --sign "Developer ID Installer: <NAME>" \
33+ --identifier org.elm-lang.binary \
3334 --install-location $usr_binaries \
3435 --scripts $pkg_scripts \
3536 --filter 'Scripts.*' \
@@ -39,16 +40,42 @@ pkgbuild \
3940
4041#### BUNDLE ASSETS ####
4142
42−rm -f Elm.pkg
43+rm -f installer-for-mac.pkg
4344
4445productbuild \
46+ --sign "Developer ID Installer: <NAME>" \
47+ --identifier org.elm-lang.installer \
4548 --distribution Distribution.xml \
4649 --package-path . \
4750 --resources Resources \
48− Elm.pkg
51+ installer-for-mac.pkg
4952
5053
5154#### CLEAN UP ####
5255
5356rm binaries.pkg
5457rm -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+29−141
@@ -1,171 +1,59 @@
1−# Publishing a new release
1+# Publishing
22
3−A new version of Elm came out. Huzzah! Here's how to update the `npm` installer.
3+Here's how to update the `npm` installer.
44
5−## 1. Create tarballs of binaries
65
7−You can find a list of what binaries we'll need to tar up in `index.js`.
6+## 1. GitHub Release
87
9−For example:
8+Create a [GitHub Release](https://github.com/elm/compiler/releases) with the following files:
109
11−```javascript
12−var root =
13− "https://github.com/elm/compiler/releases/download/" +
14− binVersion +
15− "/binaries-for-";
10+1. `binary-for-mac-64-bit.gz`
11+2. `binary-for-windows-64-bit.gz`
12+3. `binary-for-linux-64-bit.gz`
1613
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:
14+Create each of these by running the `elm` executable for each platform through `gzip elm`.
2915
30−1. `binaries-for-mac.tar.gz`
31−2. `binaries-for-windows.tar.gz`
32−3. `binaries-for-linux.tar.gz`
3316
34−Each of these tarballs should have **only the Elm binary** inside them - no
35−directories!
17+## 2. Try a beta release
3618
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:
19+In `package.json`, bump the version to `"0.19.2-beta"`.
3920
40−```shell
41−$ tar cvzf binaries-for-linux.tar.gz elm
21+```bash
22+npm publish --tag beta
4223```
4324
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:
25+To test that it works, run these commands:
8026
81−```shell
82−$ git tag 0.19.0
83−$ git push origin 0.19.0
27+```bash
28+npm dist-tags ls elm
29+npm install elm@beta --ignore-scripts
8430```
8531
86−Now this tag should exist on GitHub, allowing us to upload binaries to it.
32+The `latest` tag should not be changed, and there should be an additional `beta` tag.
8733
88−## 5. Upload binaries
34+Try this on Windows, Linux, and Mac.
8935
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.
9436
95−Upload the tarballs you created in step 1.
37+## 3. Publish final release
9638
97−## 6. Publish beta release
39+Remove the `-beta` suffix from the version in `package.json`. Then run:
9840
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
105−$ npm publish --tag beta
41+```bash
42+npm publish
10643```
10744
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−```
11445
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.
46+## 4. Tag the `latest-0.19.1` version
11947
120−## 7. Verify beta installer
48+Many compiler releases have needed multiple `npm` publications. Maybe something does not work on Windows or some dependency becomes insecure. Normal `npm` problems.
12149
122−Make an empty directory and run `npm init` inside it.
50+The convention for each Elm release is to create a tag the latest one.
12351
124−Then run this:
125−
126−```shell
127−$ npm install elm@beta --ignore-scripts
52+```bash
53+npm dist-tag add elm@0.19.1-3 latest-0.19.1
12854```
12955
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`
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.
16357
164−You're done! Now whenever anyone does `npm install -g elm` they'll get the
165−version you just uploaded.
58+You can read more about dist-tags [here](https://docs.npmjs.com/cli/dist-tag).
16659
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+30−23
@@ -1,38 +1,45 @@
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−===============
1+# Elm Installer
32
4−Install the [Elm Platform](https://github.com/elm-lang/elm-platform) via [`npm`](https://www.npmjs.com).
3+[Elm](https://elm-lang.org) is a functional programming language that compiles to JavaScript.
54
6−## Installing
5+Head over to [The Official Guide](https://guide.elm-lang.org/) to start learning Elm!
76
8−Run this to get the binaries:
97
10−```
11−$ npm install -g elm
12−```
8+<br/>
139
14−## Installing behind a proxy server
10+## What is this package for?
1511
16−If you are behind a proxy server, set the environment variable "HTTPS_PROXY".
12+**Normal installs** ❌
1713
18−```
19−$ export HTTPS_PROXY=$YourProxyServer$
20−$ npm install -g elm
21−```
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+
29+
30+<br/>
31+
32+## Install Locally
2233
23−Or on Windows:
34+The following command should download the latest Elm 0.19.1 binary:
2435
2536```
26−$ set HTTPS_PROXY=$YourProxyServer$
27−$ npm install -g elm
37+npm install elm@latest-0.19.1
2838```
2939
30−## Troubleshooting
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.
3141
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.
42+Use `npm install elm@latest-0.19.0` or `npm install elm@latest-0.18.0` for earlier versions.
3543
36−## Getting Started
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.
3745
38−Once everything has installed successfully, head over to the [Get Started](http://elm-lang.org/Get-Started.elm) page!
installers/npm/bin/elm+42−17
@@ -1,29 +1,54 @@
11#!/usr/bin/env node
22
33var child_process = require('child_process');
4−var download = require('../download.js');
4+var path = require('path');
55var fs = require('fs');
66
77
8−// Some npm users enable --ignore-scripts (a good security measure)
8+// Some npm users enable --ignore-scripts (a good security measure) so
9+// they do not run the post-install hook and install.js does not run.
10+// Instead they will run this script.
911//
10−// They do not run the post-install hook, so install.js does not run.
12+// On Mac and Linux, we download the elm executable into the exact same
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.
1116//
12−// This file pretends to be the downloaded binary. It then downloads
13−// the real binary over itself. So in that case, the first run would
14−// also make an HTTPS request to fetch the real binary. From there,
15−// it calls the binary it downloaded on each run.
17+// On Windows, we must download a file named elm.exe for it to run properly.
18+// Instead of symlinks, npm creates two files:
19+//
20+// - node_modules/.bin/elm (a bash file)
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.
1626
1727
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+}
1845
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]);
2246
23−download(pathToThisFile, function() {
24− // Need double quotes and { shell: true } when there are spaces in the path on windows:
25− // https://github.com/nodejs/node/issues/7367#issuecomment-229721296
26− child_process
27− .spawn('"' + pathToThisFile + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })
28− .on('exit', process.exit);
29−});
47+function runCommand()
48+{
49+ // 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
51+ child_process
52+ .spawn('"' + binaryPath + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })
53+ .on('exit', process.exit);
54+}
installers/npm/download.js+68−68
@@ -1,7 +1,7 @@
11var fs = require('fs');
22var package = require('./package.json');
3−var URL = require('url').URL;
4−var https = require('https');
3+var path = require('path');
4+var request = require('request');
55var zlib = require('zlib');
66
77
@@ -12,88 +12,72 @@ var zlib = require('zlib');
1212// called when --ignore-scripts is enabled. That's why install.js is so weird.
1313
1414
15−module.exports = function(destinationPath, callback)
15+module.exports = function(callback)
1616{
17+ // figure out URL of binary
1718 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';
2219
23− // check if exists for bin/elm running for the Nth time on Windows
24− fs.existsSync(path)
25− ? callback()
26− : download(path, url, callback);
27−};
20+ var platform = {
21+ darwin_x64: 'mac-64-bit',
22+ darwin_arm64: 'mac-64-bit',
23+ win32_x64: 'windows-64-bit',
24+ linux_x64: 'linux-64-bit'
25+ }[process.platform + '_' + process.arch];
2826
27+ verifyPlatform(version, platform);
2928
29+ var url = 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + platform + '.gz';
3030
31−// DOWNLOAD
31+ reportDownload(version, url);
3232
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' : '');
3335
34−function download(destinationPath, url, callback)
35−{
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() {
50− exitFailure(url, 'Something went wrong while receiving the following URL:\n\n' + url);
51− });
52−
53− var gunzip = zlib.createGunzip().on('error', function(error) {
54− exitFailure(url, 'I ran into trouble decompressing the downloaded binary. It is saying:\n\n' + error);
55− });
56− var write = fs.createWriteStream(destinationPath, {
57− encoding: 'binary',
58− mode: 0o755
59− }).on('finish', callback).on('error', function(error) {
60− exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);
61− });
62−
63− response.pipe(gunzip).pipe(write);
64− }
65− );
36+ // set up handler for request failure
37+ function reportDownloadFailure(error)
38+ {
39+ exitFailure(url,'Something went wrong while fetching the following URL:\n\n' + url + '\n\nIt is saying:\n\n' + error);
40+ }
41+
42+ // set up decompression pipe
43+ 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);
45+ });
46+
47+ // set up file write pipe
48+ var write = fs.createWriteStream(binaryPath, {
49+ encoding: 'binary',
50+ mode: 0o755
51+ }).on('finish', callback).on('error', function(error) {
52+ exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);
53+ });
54+
55+ // put it all together
56+ request(url).on('error', reportDownloadFailure).pipe(gunzip).pipe(write);
6657}
6758
6859
6960
70−// HANDLE REDIRECTS
61+// VERIFY PLATFORM
7162
7263
73−function requestWithRedirects(url, maxRedirects, failure, success)
64+function verifyPlatform(version, platform)
7465{
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− });
93−
94− req.on('error', failure);
66+ if (platform) return;
9567
96− req.end();
68+ var situation = process.platform + '_' + process.arch;
69+ console.error(
70+ '-- ERROR -----------------------------------------------------------------------\n\n'
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);
9781}
9882
9983
@@ -112,3 +96,19 @@ function exitFailure(url, message)
11296 );
11397 process.exit(1);
11498}
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+1−7
@@ -1,10 +1,4 @@
11
22var download = require('./download.js');
3−var package = require('./package.json');
4−var path = require('path');
53
6−
7−// get slashes right for Windows
8−var targetPath = path.resolve(__dirname, Object.values(package.bin)[0]);
9−
10−download(targetPath, function() {});
4+download(function() {});
installers/npm/package.json+6−7
@@ -1,6 +1,6 @@
11{
22 "name": "elm",
3− "version": "0.19.0-no-deps",
3+ "version": "0.19.1-5",
44 "description": "Installer for Elm: just downloads the binary into node_modules",
55 "preferGlobal": true,
66 "license": "BSD-3-Clause",
@@ -11,9 +11,9 @@
1111 "homepage": "https://github.com/elm/compiler/tree/master/installers/npm",
1212 "bugs": "https://github.com/elm/compiler/issues",
1313 "author": {
14− "name": "Richard Feldman",
15− "email": "richard.t.feldman@gmail.com",
16− "url": "https://github.com/rtfeldman"
14+ "name": "Evan Czaplicki",
15+ "email": "evan@elm-lang.org",
16+ "url": "https://github.com/evancz"
1717 },
1818 "engines": {
1919 "node": ">=7.0.0"
@@ -35,9 +35,8 @@
3535 "install",
3636 "installer"
3737 ],
38− "bin": {
39− "elm": "bin/elm"
40− },
38+ "bin": { "elm": "bin/elm" },
4139 "dependencies": {
40+ "request": "^2.88.0"
4241 }
4342}
installers/npm/troubleshooting.mdnew file+76
@@ -0,0 +1,76 @@
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
7575FunctionEnd
7676
7777Function LaunchLink
78− ExecShell "open" "https://elm-lang.org/get-started"
78+ ExecShell "open" "https://guide.elm-lang.org"
7979FunctionEnd
8080
8181;--------------------------------
@@ -135,20 +135,20 @@ SectionEnd
135135
136136SectionGroup "Update system settings" SecGr
137137
138−Section "Associate with .elm files" SecAssoc
139−
140− SectionIn 1
141−
142− ; File associations
143− WriteRegStr HKCR ".elm" "" "elm"
144− WriteRegStr HKCR "elm" "" "Elm Source File"
145− WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"
146− ;WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'
147−
148− ;Remember that we registered associations
149− WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1
150−
151−SectionEnd
138+;Section "Associate with .elm files" SecAssoc
139+;
140+; SectionIn 1
141+;
142+; ; File associations
143+; WriteRegStr HKCR ".elm" "" "elm"
144+; WriteRegStr HKCR "elm" "" "Elm Source File"
145+; WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"
146+; WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'
147+;
148+; ;Remember that we registered associations
149+; WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1
150+;
151+;SectionEnd
152152
153153Section "Update the PATH environment variable" SecPath
154154
installers/win/README.md+18−3
@@ -1,9 +1,24 @@
1−# Building Windows installer
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
217
318You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.
419
520Once everything is installed, run something like this command:
621
7− make_installer.cmd 0.19
22+ make_installer.cmd 0.19.0
823
9−It will build an installer called `Elm-0.19-setup.exe`.
24+It will build an installer called `Elm-0.19.0-setup.exe`.
installers/win/file.icodeleted

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

roadmap.mdnew file+29
@@ -0,0 +1,29 @@
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/Terminal/Args.hs → terminal/impl/Terminal.hsrenamed+30−27
@@ -1,8 +1,7 @@
1−module Terminal.Args
2− ( simple
3− , Interface(..)
1+module Terminal
2+ ( app
3+ , Command(..)
44 , Summary(..)
5− , complex
65 , Flags, noFlags, flags, (|--)
76 , Flag, flag, onOff
87 , Parser(..)
@@ -26,22 +25,22 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P
2625import qualified Text.Read as Read
2726
2827import qualified Elm.Version as V
29−import Terminal.Args.Internal
30−import qualified Terminal.Args.Chomp as Chomp
31−import qualified Terminal.Args.Error as Error
28+import Terminal.Internal
29+import qualified Terminal.Chomp as Chomp
30+import qualified Terminal.Error as Error
3231
3332
3433
35−-- GET
34+-- COMMAND
3635
3736
38−simple :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()
39−simple details example args_ flags_ callback =
37+_command :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()
38+_command details example args_ flags_ callback =
4039 do setLocaleEncoding utf8
4140 argStrings <- Env.getArgs
4241 case argStrings of
4342 ["--version"] ->
44− do hPutStrLn stdout (V.toChars V.compiler ++ "-alpha-3")
43+ do hPutStrLn stdout (V.toChars V.compiler)
4544 Exit.exitSuccess
4645
4746 chunks ->
@@ -57,34 +56,38 @@ simple details example args_ flags_ callback =
5756 Error.exitWithError err
5857
5958
60−complex :: P.Doc -> P.Doc -> [Interface] -> IO ()
61−complex intro outro interfaces =
59+
60+-- APP
61+
62+
63+app :: P.Doc -> P.Doc -> [Command] -> IO ()
64+app intro outro commands =
6265 do setLocaleEncoding utf8
6366 argStrings <- Env.getArgs
6467 case argStrings of
6568 [] ->
66− Error.exitWithOverview intro outro interfaces
69+ Error.exitWithOverview intro outro commands
6770
6871 ["--help"] ->
69− Error.exitWithOverview intro outro interfaces
72+ Error.exitWithOverview intro outro commands
7073
7174 ["--version"] ->
72− do hPutStrLn stdout (V.toChars V.compiler ++ "-alpha-3")
75+ do hPutStrLn stdout (V.toChars V.compiler)
7376 Exit.exitSuccess
7477
7578 command : chunks ->
76− do case List.find (\iface -> toName iface == command) interfaces of
79+ do case List.find (\cmd -> toName cmd == command) commands of
7780 Nothing ->
78− Error.exitWithUnknown command (map toName interfaces)
81+ Error.exitWithUnknown command (map toName commands)
7982
80− Just (Interface _ _ details example args_ flags_ callback) ->
83+ Just (Command _ _ details example args_ flags_ callback) ->
8184 if elem "--help" chunks then
8285 Error.exitWithHelp (Just command) details example args_ flags_
8386
8487 else
8588 case snd $ Chomp.chomp Nothing chunks args_ flags_ of
86− Right (argsValue, flagValue) ->
87− callback argsValue flagValue
89+ Right (argsValue, flagsValue) ->
90+ callback argsValue flagsValue
8891
8992 Left err ->
9093 Error.exitWithError err
@@ -159,21 +162,21 @@ findIndex index point chunks =
159162 findIndex (index + 1) point cs
160163
161164
162−_complexSuggest :: [Interface] -> Int -> [String] -> IO [String]
163−_complexSuggest interfaces index strings =
165+_complexSuggest :: [Command] -> Int -> [String] -> IO [String]
166+_complexSuggest commands index strings =
164167 case strings of
165168 [] ->
166− return (map toName interfaces)
169+ return (map toName commands)
167170
168171 command : chunks ->
169172 if index == 1 then
170− return (filter (List.isPrefixOf command) (map toName interfaces))
173+ return (filter (List.isPrefixOf command) (map toName commands))
171174 else
172− case List.find (\iface -> toName iface == command) interfaces of
175+ case List.find (\cmd -> toName cmd == command) commands of
173176 Nothing ->
174177 return []
175178
176− Just (Interface _ _ _ _ args_ flags_ _) ->
179+ Just (Command _ _ _ _ args_ flags_ _) ->
177180 fst $ Chomp.chomp (Just (index-1)) chunks args_ flags_
178181
179182
terminal/src/Terminal/Args/Chomp.hs → terminal/impl/Terminal/Chomp.hsrenamed+4−5
@@ -1,6 +1,5 @@
1−{-# LANGUAGE GADTs #-}
2−{-# LANGUAGE Rank2Types #-}
3−module Terminal.Args.Chomp
1+{-# LANGUAGE GADTs, Rank2Types #-}
2+module Terminal.Chomp
43 ( chomp
54 )
65 where
@@ -8,8 +7,8 @@ module Terminal.Args.Chomp
87
98import qualified Data.List as List
109
11−import Terminal.Args.Error
12−import Terminal.Args.Internal
10+import Terminal.Error
11+import Terminal.Internal
1312
1413
1514
terminal/src/Terminal/Args/Error.hs → terminal/impl/Terminal/Error.hsrenamed+12−13
@@ -1,6 +1,5 @@
1−{-# LANGUAGE GADTs #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Terminal.Args.Error
1+{-# LANGUAGE GADTs, OverloadedStrings #-}
2+module Terminal.Error
43 ( Error(..)
54 , ArgError(..)
65 , FlagError(..)
@@ -24,7 +23,7 @@ import System.IO (hPutStrLn, stderr)
2423import qualified Text.PrettyPrint.ANSI.Leijen as P
2524
2625import Reporting.Suggest as Suggest
27−import Terminal.Args.Internal
26+import Terminal.Internal
2827
2928
3029
@@ -187,22 +186,22 @@ flagsToDocs flags docs =
187186-- OVERVIEW
188187
189188
190−exitWithOverview :: P.Doc -> P.Doc -> [Interface] -> IO a
191−exitWithOverview intro outro interfaces =
189+exitWithOverview :: P.Doc -> P.Doc -> [Command] -> IO a
190+exitWithOverview intro outro commands =
192191 do exeName <- getExeName
193192 exitSuccess
194193 [ intro
195194 , "The most common commands are:"
196− , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) interfaces
195+ , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) commands
197196 , "There are a bunch of other commands as well though. Here is a full list:"
198− , P.indent 4 $ P.dullcyan $ toCommandList exeName interfaces
197+ , P.indent 4 $ P.dullcyan $ toCommandList exeName commands
199198 , "Adding the --help flag gives a bunch of additional details about each one."
200199 , outro
201200 ]
202201
203202
204−toSummary :: String -> Interface -> Maybe P.Doc
205−toSummary exeName (Interface name summary _ _ (Args args) _ _) =
203+toSummary :: String -> Command -> Maybe P.Doc
204+toSummary exeName (Command name summary _ _ (Args args) _ _) =
206205 case summary of
207206 Uncommon ->
208207 Nothing
@@ -215,10 +214,10 @@ toSummary exeName (Interface name summary _ _ (Args args) _ _) =
215214 ]
216215
217216
218−toCommandList :: String -> [Interface] -> P.Doc
219−toCommandList exeName interfaces =
217+toCommandList :: String -> [Command] -> P.Doc
218+toCommandList exeName commands =
220219 let
221− names = map toName interfaces
220+ names = map toName commands
222221 width = maximum (map length names)
223222
224223 toExample name =
terminal/src/Terminal/Args/Helpers.hs → terminal/impl/Terminal/Helpers.hsrenamed+2−2
@@ -1,5 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2−module Terminal.Args.Helpers
2+module Terminal.Helpers
33 ( version
44 , elmFile
55 , package
@@ -14,7 +14,7 @@ import qualified Data.Map as Map
1414import qualified Data.Utf8 as Utf8
1515import qualified System.FilePath as FP
1616
17−import Terminal.Args (Parser(..))
17+import Terminal (Parser(..))
1818import qualified Deps.Registry as Registry
1919import qualified Elm.Package as Pkg
2020import qualified Elm.Version as V
terminal/src/Terminal/Args/Internal.hs → terminal/impl/Terminal/Internal.hsrenamed+8−8
@@ -1,6 +1,6 @@
11{-# LANGUAGE GADTs #-}
2−module Terminal.Args.Internal
3− ( Interface(..)
2+module Terminal.Internal
3+ ( Command(..)
44 , toName
55 , Summary(..)
66 , Flags(..)
@@ -17,11 +17,11 @@ import Text.PrettyPrint.ANSI.Leijen (Doc)
1717
1818
1919
20−-- INTERFACE
20+-- COMMAND
2121
2222
23−data Interface where
24− Interface
23+data Command where
24+ Command
2525 :: String
2626 -> Summary
2727 -> String
@@ -29,11 +29,11 @@ data Interface where
2929 -> Args args
3030 -> Flags flags
3131 -> (args -> flags -> IO ())
32− -> Interface
32+ -> Command
3333
3434
35−toName :: Interface -> String
36−toName (Interface name _ _ _ _ _ _) =
35+toName :: Command -> String
36+toName (Command name _ _ _ _ _ _) =
3737 name
3838
3939
terminal/src/Develop.hs+5−2
@@ -159,9 +159,9 @@ compile path =
159159 Just root ->
160160 BW.withScope $ \scope -> Stuff.withRootLock root $ Task.run $
161161 do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
162− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromMains Reporting.silent root details (NE.List path [])
162+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])
163163 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts
164− let (NE.List name _) = Build.getMainNames artifacts
164+ let (NE.List name _) = Build.getRootNames artifacts
165165 return $ Html.sandwich name javascript
166166
167167
@@ -218,6 +218,7 @@ mimeTypeDict =
218218 , ".m3u" ==> "audio/x-mpegurl"
219219 , ".mov" ==> "video/quicktime"
220220 , ".mp3" ==> "audio/mpeg"
221+ , ".mp4" ==> "video/mp4"
221222 , ".mpeg" ==> "video/mpeg"
222223 , ".mpg" ==> "video/mpeg"
223224 , ".ogg" ==> "application/ogg"
@@ -241,6 +242,8 @@ mimeTypeDict =
241242 , ".txt" ==> "text/plain"
242243 , ".wav" ==> "audio/x-wav"
243244 , ".wax" ==> "audio/x-ms-wax"
245+ , ".webm" ==> "video/webm"
246+ , ".webp" ==> "image/webp"
244247 , ".wma" ==> "audio/x-ms-wma"
245248 , ".wmv" ==> "video/x-ms-wmv"
246249 , ".woff" ==> "font/woff"
terminal/src/Develop/Generate/Index.hs+1−1
@@ -174,7 +174,7 @@ getExactDeps maybeOutline =
174174 Left _ ->
175175 return Map.empty
176176
177− Right (Details.Details _ validOutline _ _ _) ->
177+ Right (Details.Details _ validOutline _ _ _ _) ->
178178 case validOutline of
179179 Details.ValidApp _ ->
180180 return Map.empty
terminal/src/Develop/StaticFiles/Build.hs+3−3
@@ -42,13 +42,13 @@ buildReactorFrontEnd =
4242 do root <- Dir.getCurrentDirectory
4343 runTaskUnsafe $
4444 do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
45− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromMains Reporting.silent root details mains
45+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details paths
4646 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts
4747 return (LBS.toStrict (B.toLazyByteString javascript))
4848
4949
50−mains :: NE.List FilePath
51−mains =
50+paths :: NE.List FilePath
51+paths =
5252 NE.List
5353 ("src" </> "NotFound.elm")
5454 [ "src" </> "Errors.elm"
terminal/src/Init.hs+1−1
@@ -90,7 +90,7 @@ init =
9090 in
9191 do Dir.createDirectoryIfMissing True "src"
9292 Outline.write "." $ Outline.App $
93− Outline.AppOutline V.compiler (NE.List "src" []) directs indirects Map.empty Map.empty
93+ Outline.AppOutline V.compiler (NE.List (Outline.RelativeSrcDir "src") []) directs indirects Map.empty Map.empty
9494 putStrLn "Okay, I created it. Now read that link!"
9595 return (Right ())
9696
terminal/src/Main.hs+20−20
@@ -12,8 +12,8 @@ import Text.PrettyPrint.ANSI.Leijen ((<>))
1212import Text.Read (readMaybe)
1313
1414import qualified Elm.Version as V
15−import Terminal.Args
16−import Terminal.Args.Helpers
15+import Terminal
16+import Terminal.Helpers
1717
1818import qualified Bump
1919import qualified Develop
@@ -31,7 +31,7 @@ import qualified Repl
3131
3232main :: IO ()
3333main =
34− complex intro outro
34+ Terminal.app intro outro
3535 [ repl
3636 , init
3737 , reactor
@@ -72,7 +72,7 @@ outro =
7272-- INIT
7373
7474
75−init :: Interface
75+init :: Terminal.Command
7676init =
7777 let
7878 summary =
@@ -87,14 +87,14 @@ init =
8787 "It will ask permission to create an elm.json file, the one thing common\
8888 \ to all Elm projects. It also provides a link explaining what to do from there."
8989 in
90− Interface "init" (Common summary) details example noArgs noFlags Init.run
90+ Terminal.Command "init" (Common summary) details example noArgs noFlags Init.run
9191
9292
9393
9494-- REPL
9595
9696
97−repl :: Interface
97+repl :: Terminal.Command
9898repl =
9999 let
100100 summary =
@@ -115,7 +115,7 @@ repl =
115115 |-- flag "interpreter" interpreter "Path to a alternate JS interpreter, like node or nodejs."
116116 |-- 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."
117117 in
118− Interface "repl" (Common summary) details example noArgs replFlags Repl.run
118+ Terminal.Command "repl" (Common summary) details example noArgs replFlags Repl.run
119119
120120
121121interpreter :: Parser String
@@ -133,7 +133,7 @@ interpreter =
133133-- REACTOR
134134
135135
136−reactor :: Interface
136+reactor :: Terminal.Command
137137reactor =
138138 let
139139 summary =
@@ -154,7 +154,7 @@ reactor =
154154 flags Develop.Flags
155155 |-- flag "port" port_ "The port of the server (default: 8000)"
156156 in
157− Interface "reactor" (Common summary) details example noArgs reactorFlags Develop.run
157+ Terminal.Command "reactor" (Common summary) details example noArgs reactorFlags Develop.run
158158
159159
160160port_ :: Parser Int
@@ -172,7 +172,7 @@ port_ =
172172-- MAKE
173173
174174
175−make :: Interface
175+make :: Terminal.Command
176176make =
177177 let
178178 details =
@@ -196,14 +196,14 @@ make =
196196 |-- 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!"
197197 |-- 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."
198198 in
199− Interface "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run
199+ Terminal.Command "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run
200200
201201
202202
203203-- INSTALL
204204
205205
206−install :: Interface
206+install :: Terminal.Command
207207install =
208208 let
209209 details =
@@ -232,14 +232,14 @@ install =
232232 , require1 Install.Install package
233233 ]
234234 in
235− Interface "install" Uncommon details example installArgs noFlags Install.run
235+ Terminal.Command "install" Uncommon details example installArgs noFlags Install.run
236236
237237
238238
239239-- PUBLISH
240240
241241
242−publish :: Interface
242+publish :: Terminal.Command
243243publish =
244244 let
245245 details =
@@ -266,17 +266,17 @@ publish =
266266 \ it ends up as an experiment on GitHub only. Point is, try to be\
267267 \ respectful of the community and package ecosystem!"
268268 , 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!"
270270 ]
271271 in
272− Interface "publish" Uncommon details example noArgs noFlags Publish.run
272+ Terminal.Command "publish" Uncommon details example noArgs noFlags Publish.run
273273
274274
275275
276276-- BUMP
277277
278278
279−bump :: Interface
279+bump :: Terminal.Command
280280bump =
281281 let
282282 details =
@@ -289,14 +289,14 @@ bump =
289289 \ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\
290290 \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!"
291291 in
292− Interface "bump" Uncommon details example noArgs noFlags Bump.run
292+ Terminal.Command "bump" Uncommon details example noArgs noFlags Bump.run
293293
294294
295295
296296-- DIFF
297297
298298
299−diff :: Interface
299+diff :: Terminal.Command
300300diff =
301301 let
302302 details =
@@ -321,7 +321,7 @@ diff =
321321 , require3 Diff.GlobalInquiry package version version
322322 ]
323323 in
324− Interface "diff" Uncommon details example diffArgs noFlags Diff.run
324+ Terminal.Command "diff" Uncommon details example diffArgs noFlags Diff.run
325325
326326
327327
terminal/src/Make.hs+17−17
@@ -29,7 +29,7 @@ import qualified Reporting
2929import qualified Reporting.Exit as Exit
3030import qualified Reporting.Task as Task
3131import qualified Stuff
32−import Terminal.Args (Parser(..))
32+import Terminal (Parser(..))
3333
3434
3535
@@ -107,7 +107,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
107107 case getNoMains artifacts of
108108 [] ->
109109 do builder <- toBuilder root details desiredMode artifacts
110− generate style target builder (Build.getMainNames artifacts)
110+ generate style target builder (Build.getRootNames artifacts)
111111
112112 name:names ->
113113 Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)
@@ -139,7 +139,7 @@ getMode debug optimize =
139139
140140
141141getExposed :: Details.Details -> Task (NE.List ModuleName.Raw)
142−getExposed (Details.Details _ validOutline _ _ _) =
142+getExposed (Details.Details _ validOutline _ _ _ _) =
143143 case validOutline of
144144 Details.ValidApp _ ->
145145 Task.throw Exit.MakeAppNeedsFileNames
@@ -166,7 +166,7 @@ buildExposed style root details maybeDocs exposed =
166166buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts
167167buildPaths style root details paths =
168168 Task.eio Exit.MakeCannotBuild $
169− Build.fromMains style root details paths
169+ Build.fromPaths style root details paths
170170
171171
172172
@@ -174,13 +174,13 @@ buildPaths style root details paths =
174174
175175
176176getMains :: Build.Artifacts -> [ModuleName.Raw]
177−getMains (Build.Artifacts _ _ mains modules) =
178− Maybe.mapMaybe (getMain modules) (NE.toList mains)
177+getMains (Build.Artifacts _ _ roots modules) =
178+ Maybe.mapMaybe (getMain modules) (NE.toList roots)
179179
180180
181−getMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw
182−getMain modules main =
183− case main of
181+getMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw
182+getMain modules root =
183+ case root of
184184 Build.Inside name ->
185185 if any (isMain name) modules
186186 then Just name
@@ -207,9 +207,9 @@ isMain targetName modul =
207207
208208
209209hasOneMain :: Build.Artifacts -> Task ModuleName.Raw
210−hasOneMain (Build.Artifacts _ _ mains modules) =
211− case mains of
212− NE.List main [] -> Task.mio Exit.MakeNoMain (return $ getMain modules main)
210+hasOneMain (Build.Artifacts _ _ roots modules) =
211+ case roots of
212+ NE.List root [] -> Task.mio Exit.MakeNoMain (return $ getMain modules root)
213213 NE.List _ (_:_) -> Task.throw Exit.MakeMultipleFilesIntoHtml
214214
215215
@@ -218,13 +218,13 @@ hasOneMain (Build.Artifacts _ _ mains modules) =
218218
219219
220220getNoMains :: Build.Artifacts -> [ModuleName.Raw]
221−getNoMains (Build.Artifacts _ _ mains modules) =
222− Maybe.mapMaybe (getNoMain modules) (NE.toList mains)
221+getNoMains (Build.Artifacts _ _ roots modules) =
222+ Maybe.mapMaybe (getNoMain modules) (NE.toList roots)
223223
224224
225−getNoMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw
226−getNoMain modules main =
227− case main of
225+getNoMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw
226+getNoMain modules root =
227+ case root of
228228 Build.Inside name ->
229229 if any (isMain name) modules
230230 then Nothing
terminal/src/Publish.hs+2−7
@@ -173,7 +173,7 @@ verifyBuild :: FilePath -> Task.Task Exit.Publish Docs.Documentation
173173verifyBuild root =
174174 reportBuildCheck $ BW.withScope $ \scope ->
175175 Task.run $
176− do details@(Details.Details _ outline _ _ _) <-
176+ do details@(Details.Details _ outline _ _ _ _) <-
177177 Task.eio Exit.PublishBadDetails $
178178 Details.load Reporting.silent scope root
179179
@@ -309,7 +309,7 @@ withPrepublishDir root callback =
309309verifyZipBuild :: FilePath -> IO (Either Exit.Publish ())
310310verifyZipBuild root =
311311 BW.withScope $ \scope -> Task.run $
312− do details@(Details.Details _ outline _ _ _) <-
312+ do details@(Details.Details _ outline _ _ _ _) <-
313313 Task.eio Exit.PublishZipBadDetails $
314314 Details.load Reporting.silent scope root
315315
@@ -380,11 +380,6 @@ verifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.Kno
380380
381381register :: Http.Manager -> Pkg.Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish ()
382382register manager pkg vsn docs commitHash sha =
383− if True then
384− Task.io $ putStrLn $
385− "Publishing is disabled in the 0.19.1-alpha-3 release.\n\
386− \Publish with 0.19.0 for now.\n"
387− else
388383 let
389384 url =
390385 Website.route "/register"
terminal/src/Repl.hs+30−3
@@ -3,6 +3,16 @@
33module Repl
44 ( Flags(..)
55 , run
6+ --
7+ , Lines(..)
8+ , Input(..)
9+ , Prefill(..)
10+ , CategorizedInput(..)
11+ , categorize
12+ --
13+ , State(..)
14+ , Output(..)
15+ , toByteString
616 )
717 where
818
@@ -169,9 +179,9 @@ read =
169179 Nothing ->
170180 return Exit
171181
172− Just line ->
182+ Just chars ->
173183 let
174− lines = Lines line []
184+ lines = Lines (stripLegacyBackslash chars) []
175185 in
176186 case categorize lines of
177187 Done input -> return input
@@ -187,13 +197,30 @@ readMore previousLines prefill =
187197
188198 Just chars ->
189199 let
190− lines = addLine chars previousLines
200+ lines = addLine (stripLegacyBackslash chars) previousLines
191201 in
192202 case categorize lines of
193203 Done input -> return input
194204 Continue p -> readMore lines p
195205
196206
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+
197224data Prefill
198225 = Indent
199226 | DefStart N.Name
worker/elm.cabal+13
@@ -43,11 +43,18 @@ Executable worker
4343 src
4444 ../compiler/src
4545 ../builder/src
46+ ../terminal/src
4647
4748 Main-Is:
4849 Main.hs
4950
5051 other-modules:
52+ Artifacts
53+ Cors
54+ Endpoint.Compile
55+ Endpoint.Quotes
56+ Endpoint.Repl
57+
5158 AST.Canonical
5259 AST.Optimized
5360 AST.Source
@@ -127,6 +134,7 @@ Executable worker
127134 Parse.Type
128135 Parse.Variable
129136 Paths_elm
137+ Repl
130138 Reporting
131139 Reporting.Annotation
132140 Reporting.Doc
@@ -162,9 +170,11 @@ Executable worker
162170 Type.UnionFind
163171
164172 Build-depends:
173+ aeson,
165174 ansi-terminal >= 0.8 && < 0.9,
166175 ansi-wl-pprint >= 0.6.8 && < 0.7,
167176 base >=4.11 && <5,
177+ base64-bytestring,
168178 binary >= 0.8 && < 0.9,
169179 bytestring >= 0.9 && < 0.11,
170180 containers >= 0.5.8.2 && < 0.6,
@@ -173,6 +183,7 @@ Executable worker
173183 filelock,
174184 filepath >= 1 && < 2.0,
175185 ghc-prim >= 0.5.2,
186+ haskeline,
176187 HTTP >= 4000.2.5 && < 4000.4,
177188 http-client >= 0.6 && < 0.7,
178189 http-client-tls >= 0.3 && < 0.4,
@@ -183,6 +194,8 @@ Executable worker
183194 network >= 2.4 && < 2.7,
184195 network-uri,
185196 parsec,
197+ process,
198+ random,
186199 raw-strings-qq,
187200 scientific,
188201 SHA,
worker/elm.json+3−8
@@ -8,18 +8,13 @@
88 "direct": {
99 "elm/browser": "1.0.1",
1010 "elm/core": "1.0.2",
11− "elm/file": "1.0.5",
1211 "elm/html": "1.0.0",
13− "elm/http": "2.0.0",
1412 "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"
13+ "elm/project-metadata-utils": "1.0.0"
2014 },
2115 "indirect": {
22− "elm/bytes": "1.0.8",
16+ "elm/parser": "1.1.0",
17+ "elm/time": "1.0.0",
2318 "elm/url": "1.0.0",
2419 "elm/virtual-dom": "1.0.2"
2520 }
worker/outlines/compile/elm.jsonnew file+32
@@ -0,0 +1,32 @@
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.jsonnew file+19
@@ -0,0 +1,19 @@
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.hsnew file+155
@@ -0,0 +1,155 @@
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.hsnew file+48
@@ -0,0 +1,48 @@
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.hsnew file+323
@@ -0,0 +1,323 @@
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.hsnew file+114
@@ -0,0 +1,114 @@
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.hsnew file+244
@@ -0,0 +1,244 @@
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.elmnew file+217
@@ -0,0 +1,217 @@
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+35−264
@@ -1,54 +1,21 @@
11{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
2+{-# LANGUAGE OverloadedStrings #-}
33module Main
44 ( main
55 )
66 where
77
88
9−import Control.Concurrent (readMVar)
10−import Control.Monad (liftM2, msum)
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)
9+import Control.Monad (msum)
10+import qualified Data.ByteString as BS
2111import Snap.Core
2212import 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)
2813
29−import qualified AST.Source as Src
30−import qualified AST.Canonical as Can
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
43−import qualified Generate.Mode as Mode
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
14+import qualified Artifacts
15+import qualified Cors
16+import qualified Endpoint.Compile as Compile
17+import qualified Endpoint.Quotes as Quotes
18+import qualified Endpoint.Repl as Repl
5219
5320
5421
@@ -57,246 +24,50 @@ import qualified Reporting.Task as Task
5724
5825main :: IO ()
5926main =
60− do artifacts <- loadArtifacts
61− errorJS <- compileErrorViewer
27+ do rArtifacts <- Artifacts.loadRepl
28+ cArtifacts <- Artifacts.loadCompile
29+ errorJS <- Compile.loadErrorJS
30+ let depsInfo = Artifacts.toDepsInfo cArtifacts
31+
6232 httpServe config $ msum $
63− [ path "compile" $ compile artifacts
64− , path "compile/errors.js" $ writeBS errorJS
33+ [ ifTop $ status
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
38+ , path "compile/deps-info.json" $ serveDepsInfo depsInfo
39+ , path "quotes" $ Quotes.endpoint
6540 , notFound
6641 ]
6742
6843
6944config :: Config Snap a
7045config =
71− defaultConfig
72− |> setPort 8000
73− |> setAccessLog ConfigNoLog
74− |> setErrorLog ConfigNoLog
75−
76−
77−(|>) :: a -> (a -> b) -> b
78−(|>) value func =
79− func value
80−
46+ setPort 8000 $ setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ defaultConfig
8147
8248
83−-- NOT FOUND
49+status :: Snap ()
50+status =
51+ do modifyResponse $ setContentType "text/plain"
52+ writeBuilder "Status: OK"
8453
8554
8655notFound :: Snap ()
8756notFound =
8857 do modifyResponse $ setResponseStatus 404 "Not Found"
8958 modifyResponse $ setContentType "text/html; charset=utf-8"
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−
59+ writeBuilder "Not Found"
28460
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)
28961
62+serveJavaScript :: BS.ByteString -> Snap ()
63+serveJavaScript javascript =
64+ do modifyResponse $ setContentType "application/javascript"
65+ writeBS javascript
29066
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
29667
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
29773
298−toUnique :: OneOrMore.OneOrMore a -> Maybe a
299−toUnique oneOrMore =
300− case oneOrMore of
301− OneOrMore.One value -> Just value
302− OneOrMore.More _ _ -> Nothing