on 71fa816 help sign in
148 files changed+2100−6103
since splitsnapshots
unifiedsplit
.github/CONTRIBUTING.md+20−18 .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+25−6 README.md+5−10 builder/src/Build.hs+238−314 builder/src/Deps/Solver.hs+24−27 builder/src/Elm/Details.hs+17−51 builder/src/Elm/Outline.hs+15−103 builder/src/File.hs+3−20 builder/src/Generate.hs+7−7 builder/src/Http.hs+1−1 builder/src/Reporting.hs+7−9 builder/src/Reporting/Exit.hs+97−94 builder/src/Reporting/Exit/Help.hs+5−5 builder/src/Stuff.hs+10−3 compiler/src/AST/Canonical.hs+2−2 compiler/src/AST/Optimized.hs+8−8 compiler/src/AST/Source.hs+5−5 compiler/src/AST/Utils/Binop.hs+6−5 compiler/src/AST/Utils/Shader.hs−2 compiler/src/AST/Utils/Type.hs+1 compiler/src/Canonicalize/Environment.hs+20−50 compiler/src/Canonicalize/Environment/Dups.hs+1−1 compiler/src/Canonicalize/Environment/Foreign.hs+37−49 compiler/src/Canonicalize/Environment/Local.hs+5−5 compiler/src/Canonicalize/Expression.hs+7−6 compiler/src/Canonicalize/Module.hs+7−7 compiler/src/Canonicalize/Pattern.hs+2−3 compiler/src/Data/Name.hs+43−53 compiler/src/Data/Utf8.hs+1−3 compiler/src/Elm/Compiler/Imports.hs+3−3 compiler/src/Elm/Constraint.hs+1−1 compiler/src/Elm/Interface.hs+3−3 compiler/src/Elm/Kernel.hs+9−9 compiler/src/Elm/Licenses.hs+25−25 compiler/src/Elm/ModuleName.hs+6−2 compiler/src/Elm/Package.hs+8−1 compiler/src/Generate/Html.hs+10−11 compiler/src/Generate/JavaScript.hs+10−45 compiler/src/Json/Decode.hs+3−3 compiler/src/Json/Encode.hs+2−3 compiler/src/Json/String.hs+1 compiler/src/Optimize/DecisionTree.hs+2−2 compiler/src/Optimize/Port.hs+1−1 compiler/src/Parse/Expression.hs+32−40 compiler/src/Parse/Module.hs+35−81 compiler/src/Parse/Pattern.hs+1−1 compiler/src/Parse/Space.hs+2−2 compiler/src/Parse/String.hs+2−2 compiler/src/Parse/Variable.hs+2−2 compiler/src/Reporting/Doc.hs+3−3 compiler/src/Reporting/Error.hs+16−20 compiler/src/Reporting/Error/Canonicalize.hs+30−30 compiler/src/Reporting/Error/Docs.hs+2−2 compiler/src/Reporting/Error/Import.hs+1−1 compiler/src/Reporting/Error/Json.hs+4−16 compiler/src/Reporting/Error/Pattern.hs+2−2 compiler/src/Reporting/Error/Syntax.hs+436−975 compiler/src/Reporting/Error/Type.hs+22−38 compiler/src/Reporting/Render/Code.hs+26−67 compiler/src/Reporting/Render/Type/Localizer.hs+5−5 compiler/src/Type/Error.hs+2−8 compiler/src/Type/Solve.hs−7 compiler/src/Type/Unify.hs+8−5 docs/elm.json/application.md+2−2 docs/elm.json/package.md+1−1 docs/upgrade-instructions/0.19.1.md−60 elm.cabal+5−6 hints/bad-recursion.md−133 hints/comparing-custom-types.md−98 hints/comparing-records.md−85 hints/implicit-casts.md−50 hints/import-cycles.md−184 hints/imports.md−126 hints/infinite-type.md−42 hints/init.md−55 hints/missing-patterns.md−139 hints/optimize.md−59 hints/port-modules.md−32 hints/recursive-alias.md−162 hints/repl.md−73 hints/shadowing.md−70 hints/tuples.md−19 hints/type-annotations.md−60 installers/README.md−32 installers/linux/Dockerfile−39 installers/linux/README.md−93 installers/mac/Distribution.xml+3−5 installers/mac/README.md−93 installers/mac/Resources/en.lproj/background.png installers/mac/Resources/en.lproj/conclusion.rtf+6−13 installers/mac/Resources/en.lproj/welcome.rtf+4−9 installers/mac/helper-scripts/elm-startup.sh+1−1 installers/mac/make-installer.sh+3−30 installers/npm/PUBLISHING.md+141−29 installers/npm/README.md+23−30 installers/npm/bin/elm+17−42 installers/npm/download.js+68−68 installers/npm/install.js+7−1 installers/npm/package.json+7−6 installers/npm/troubleshooting.md−76 installers/win/Nsisfile.nsi+16−16 installers/win/README.md+3−18 installers/win/file.ico installers/win/inst.dat+2−1 installers/win/logo.ico installers/win/uninst.dat+2−1 installers/win/welcome.bmp reactor/src/Index/Navigator.elm+1−1 roadmap.md−29 terminal/src/Bump.hs+1−3 terminal/src/Develop.hs+5−13 terminal/src/Develop/Generate/Index.hs+2−4 terminal/src/Develop/StaticFiles/Build.hs+5−7 terminal/src/Diff.hs+2−3 terminal/src/Init.hs+1−1 terminal/src/Install.hs+11−13 terminal/src/Main.hs+20−20 terminal/src/Make.hs+19−23 terminal/src/Publish.hs+12−27 terminal/src/Repl.hs+60−188 terminal/impl/Terminal.hs → terminal/src/Terminal/Args.hs+25−28 terminal/impl/Terminal/Chomp.hs → terminal/src/Terminal/Args/Chomp.hs+5−4 terminal/impl/Terminal/Error.hs → terminal/src/Terminal/Args/Error.hs+18−28 terminal/impl/Terminal/Helpers.hs → terminal/src/Terminal/Args/Helpers.hs+7−20 terminal/impl/Terminal/Internal.hs → terminal/src/Terminal/Args/Internal.hs+8−8 docs/upgrade-instructions/0.16.md → upgrade-docs/0.16.md docs/upgrade-instructions/0.17.md → upgrade-docs/0.17.md docs/upgrade-instructions/0.18.md → upgrade-docs/0.18.md docs/upgrade-instructions/0.19.0.md → upgrade-docs/0.19.md docs/upgrade-instructions/earlier.md → upgrade-docs/earlier.md worker/elm.cabal−18 worker/elm.json−26 worker/nginx.conf−22 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+253−36
.github/CONTRIBUTING.md+20−18
@@ -4,15 +4,10 @@ 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
78
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−
9+You need to sign the [contributor agreement](ContributorAgreement.pdf)
10+and send it to <info@elm-lang.org> before opening your pull request.
1611
1712## Style Guide
1813
@@ -22,20 +17,27 @@ Finally, please be patient with the core team. They are trying their best with l
2217[haskell]: https://gist.github.com/evancz/0a1f3717c92fe71702be
2318[js]: https://google.github.io/styleguide/javascriptguide.xml
2419
25−
2620## Branches
2721
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!
31−
32−[master]: http://github.com/elm-lang/elm/tree/master
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!
3325
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.
3429
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:
30+[master]: http://github.com/elm-lang/elm/tree/master
31+[stable]: http://github.com/elm-lang/elm/tree/stable
3832
39−> Whenever you add Content to a repository containing notice of a license, you license that Content under the same terms, and you agree that you have the right to license that Content under those terms. If you have a separate agreement to license that Content under different terms, such as a contributor license agreement, that agreement will supersede.
33+If you are working on a fairly large feature, we will probably want to merge it
34+in as its own branch and do some testing before bringing it into the master
35+branch. This way we can keep releases of the master branch independent of new
36+features.
4037
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.
4142
43+[website]: https://github.com/elm-lang/elm-lang.org
.github/PULL_REQUEST_TEMPLATE.mddeleted−18
@@ -1,18 +0,0 @@
1−
2−**Quick Summary:** ???
3−
4−
5−## SSCCE
6−
7−```elm
8−
9−```
10−
11−- **Elm:** ???
12−- **Browser:** ???
13−- **Operating System:** ???
14−
15−
16−## Additional Details
17−
18−???
.github/workflows/set-issue-expectations.ymldeleted−21
@@ -1,21 +0,0 @@
1−name: Set Issue Expectations
2−on:
3− issues:
4− types: [opened]
5−jobs:
6− comment-on-issue:
7− name: Comment On Issue
8− runs-on: ubuntu-latest
9− steps:
10− - uses: actions/github@v1.0.0
11− env:
12− GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
13− with:
14− args: |
15− comment "Thanks for reporting this! To set expectations:
16−
17− - Issues are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.
18− - Ask questions in a [community forum](https://elm-lang.org/community). You will get an answer quicker that way!
19− - If you experience something similar, open a new issue. [We like duplicates](https://github.com/elm/expectations/blob/master/duplicates.md).
20−
21− Finally, please be patient with the core team. They are trying their best with limited resources."
.github/workflows/set-pull-expectations.ymldeleted−19
@@ -1,19 +0,0 @@
1−on:
2− pull_request_target:
3− types: [opened]
4−
5−jobs:
6− comment-on-pull:
7− name: Comment On Pull
8− runs-on: ubuntu-latest
9− steps:
10− - uses: actions/github-script@v3
11− with:
12− github-token: ${{secrets.GITHUB_TOKEN}}
13− script: |
14− github.issues.createComment({
15− issue_number: context.issue.number,
16− owner: context.repo.owner,
17− repo: context.repo.repo,
18− body: "Thanks for suggesting these code changes. To set expectations:\n\n- Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.\n- Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md).\n- Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc.\n\nFinally, please be patient with the core team. They are trying their best with limited resources."
19− })
.gitignore−1
@@ -5,4 +5,3 @@ cabal-dev
55cabal.sandbox.config
66.DS_Store
77*~
8−travis.log
.travis.ymldeleted−28
@@ -1,28 +0,0 @@
1−language: minimal
2−services: docker
3−
4−env:
5− global:
6− - LINUX_ARCHIVE=binary-for-linux-64-bit.gz
7−
8−before_install:
9− - docker build -t elm -f installers/linux/Dockerfile .
10− - docker cp $(docker create elm):/usr/local/bin/elm .
11− - gzip -9 -c elm > $LINUX_ARCHIVE
12−
13−deploy:
14− provider: releases
15− api_key:
16− secure: Yz2Lo4u9rZQ7Ee7ohAsrZpkqsYDUerCSMdSQIH8ryrf7phHhiloPEkTKsM+NupHqU/LEAVsunxbau4QrCEjA2vPavAPVk8cKomRUWK/YjbXHKa24hPkal2c+A2bnMQ6w3qYk/PjL9rW+Goq++/SNLcYZwHBV0Chl2blivMwWCSA=
17− file: $LINUX_ARCHIVE
18− skip_cleanup: true
19− on:
20− branch: master
21− tags: true
22−
23−notifications:
24− email:
25− recipients:
26− - rlefevre@dmy.fr
27− on_success: change
28− on_failure: change
ContributorAgreement.pdfnew file

Binary file not shown.

LICENSE+25−6
@@ -1,11 +1,30 @@
1−Copyright 2012-present Evan Czaplicki
1+Copyright (c) 2012-present, Evan Czaplicki
22
3−Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
3+All rights reserved.
44
5−1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
5+Redistribution and use in source and binary forms, with or without
6+modification, are permitted provided that the following conditions are met:
67
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.
8+ * Redistributions of source code must retain the above copyright
9+ notice, this list of conditions and the following disclaimer.
810
9−3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
11+ * Redistributions in binary form must reproduce the above
12+ copyright notice, this list of conditions and the following
13+ disclaimer in the documentation and/or other materials provided
14+ with the distribution.
1015
11−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
16+ * Neither the name of Evan Czaplicki nor the names of other
17+ contributors may be used to endorse or promote products derived
18+ from this software without specific prior written permission.
19+
20+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md+5−10
@@ -1,22 +1,17 @@
1−# Elm
1+# The Elm Compiler
22
3−A delightful language for reliable webapps.
3+Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/).
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>
95
106## Install
117
12−✨ [Install](https://guide.elm-lang.org/install/elm.html) ✨
8+Follow [these instructions][installer]!
139
14−For multiple versions, previous versions, and uninstallation, see the instructions [here](https://github.com/elm/compiler/blob/master/installers/README.md).
10+ [installer]: https://guide.elm-lang.org/install.html
1511
16−<br>
1712
1813## Help
1914
2015If you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!
2116
22−[slack]: http://elmlang.herokuapp.com/
17+[slack]: http://elmlang.herokuapp.com/
builder/src/Build.hs+238−314
@@ -2,15 +2,15 @@
22{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}
33module Build
44 ( fromExposed
5− , fromPaths
5+ , fromMains
66 , fromRepl
77 , Artifacts(..)
8− , Root(..)
8+ , Main(..)
99 , Module(..)
1010 , CachedInterface(..)
1111 , ReplArtifacts(..)
1212 , DocsGoal(..)
13− , getRootNames
13+ , getMainNames
1414 )
1515 where
1616
@@ -20,6 +20,7 @@ import Control.Concurrent.MVar
2020import Control.Monad (filterM, mapM_, sequence_)
2121import qualified Data.ByteString as B
2222import qualified Data.Char as Char
23+import qualified Data.Either as Either
2324import qualified Data.Graph as Graph
2425import qualified Data.List as List
2526import qualified Data.Map.Utils as Map
@@ -42,7 +43,6 @@ import qualified Elm.Details as Details
4243import qualified Elm.Docs as Docs
4344import qualified Elm.Interface as I
4445import qualified Elm.ModuleName as ModuleName
45−import qualified Elm.Outline as Outline
4646import qualified Elm.Package as Pkg
4747import qualified File
4848import qualified Json.Encode as E
@@ -50,7 +50,6 @@ import qualified Parse.Module as Parse
5050import qualified Reporting
5151import qualified Reporting.Annotation as A
5252import qualified Reporting.Error as Error
53−import qualified Reporting.Error.Docs as EDocs
5453import qualified Reporting.Error.Syntax as Syntax
5554import qualified Reporting.Error.Import as Import
5655import qualified Reporting.Exit as Exit
@@ -66,47 +65,21 @@ data Env =
6665 Env
6766 { _key :: Reporting.BKey
6867 , _root :: FilePath
69− , _project :: Parse.ProjectType
70− , _srcDirs :: [AbsoluteSrcDir]
71− , _buildID :: Details.BuildID
68+ , _pkg :: Pkg.Name
69+ , _srcDirs :: [FilePath]
7270 , _locals :: Map.Map ModuleName.Raw Details.Local
7371 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign
7472 }
7573
7674
77−makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env
78−makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =
75+makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env
76+makeEnv key root (Details.Details _ validOutline locals foreigns _) =
7977 case validOutline of
80− Details.ValidApp givenSrcDirs ->
81− do srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)
82− return $ Env key root Parse.Application srcDirs buildID locals foreigns
78+ Details.ValidApp srcDirs ->
79+ Env key root Pkg.dummyName (NE.toList srcDirs) locals foreigns
8380
8481 Details.ValidPkg pkg _ _ ->
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
82+ Env key root pkg ["src"] locals foreigns
11083
11184
11285
@@ -137,7 +110,7 @@ forkWithKey func dict =
137110fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)
138111fromExposed style root details docsGoal exposed@(NE.List e es) =
139112 Reporting.trackBuild style $ \key ->
140− do env <- makeEnv key root details
113+ do let env = makeEnv key root details
141114 dmvar <- Details.loadInterfaces root details
142115
143116 -- crawl
@@ -160,18 +133,18 @@ fromExposed style root details docsGoal exposed@(NE.List e es) =
160133 putMVar rmvar resultMVars
161134 results <- traverse readMVar resultMVars
162135 writeDetails root details results
163− finalizeExposed root docsGoal exposed results
136+ finalizeExposed docsGoal exposed results
164137
165138
166139
167−-- FROM PATHS
140+-- FROM MAINS
168141
169142
170143data Artifacts =
171144 Artifacts
172145 { _name :: Pkg.Name
173146 , _deps :: Dependencies
174− , _roots :: NE.List Root
147+ , _mains :: NE.List Main
175148 , _modules :: [Module]
176149 }
177150
@@ -185,25 +158,25 @@ type Dependencies =
185158 Map.Map ModuleName.Canonical I.DependencyInterface
186159
187160
188−fromPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
189−fromPaths style root details paths =
161+fromMains :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
162+fromMains style root details paths =
190163 Reporting.trackBuild style $ \key ->
191− do env <- makeEnv key root details
164+ do let env = makeEnv key root details
192165
193− elroots <- findRoots env paths
194− case elroots of
166+ elmains <- findMains env paths
167+ case elmains of
195168 Left problem ->
196169 return (Left (Exit.BuildProjectProblem problem))
197170
198− Right lroots ->
171+ Right lmains ->
199172 do -- crawl
200173 dmvar <- Details.loadInterfaces root details
201174 smvar <- newMVar Map.empty
202− srootMVars <- traverse (fork . crawlRoot env smvar) lroots
203− sroots <- traverse readMVar srootMVars
175+ smainMVars <- traverse (fork . crawlMain env smvar) lmains
176+ smains <- traverse readMVar smainMVars
204177 statuses <- traverse readMVar =<< readMVar smvar
205178
206− midpoint <- checkMidpointAndRoots dmvar statuses sroots
179+ midpoint <- checkMainsMidpoint dmvar statuses smains
207180 case midpoint of
208181 Left problem ->
209182 return (Left (Exit.BuildProjectProblem problem))
@@ -213,24 +186,24 @@ fromPaths style root details paths =
213186 rmvar <- newEmptyMVar
214187 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
215188 putMVar rmvar resultsMVars
216− rrootMVars <- traverse (fork . checkRoot env resultsMVars) sroots
189+ rmainMVars <- traverse (fork . checkMain env resultsMVars) smains
217190 results <- traverse readMVar resultsMVars
218191 writeDetails root details results
219− toArtifacts env foreigns results <$> traverse readMVar rrootMVars
192+ toArtifacts env foreigns results <$> traverse readMVar rmainMVars
220193
221194
222195
223−-- GET ROOT NAMES
196+-- GET MAIN NAMES
224197
225198
226−getRootNames :: Artifacts -> NE.List ModuleName.Raw
227−getRootNames (Artifacts _ _ roots _) =
228− fmap getRootName roots
199+getMainNames :: Artifacts -> NE.List ModuleName.Raw
200+getMainNames (Artifacts _ _ mains _) =
201+ fmap getMainName mains
229202
230203
231−getRootName :: Root -> ModuleName.Raw
232−getRootName root =
233− case root of
204+getMainName :: Main -> ModuleName.Raw
205+getMainName main =
206+ case main of
234207 Inside name -> name
235208 Outside name _ _ -> name
236209
@@ -266,10 +239,11 @@ crawlDeps env mvar deps blockedValue =
266239
267240
268241crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status
269−crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name =
242+crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar docsNeed name =
270243 do let fileName = ModuleName.toFilePath name <.> "elm"
244+ let inRoot path = File.exists (root </> path)
271245
272− paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)
246+ paths <- filterM inRoot (map (</> fileName) srcDirs)
273247
274248 case paths of
275249 [path] ->
@@ -278,18 +252,21 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do
278252 return $ SBadImport $ Import.Ambiguous path [] dep deps
279253
280254 Nothing ->
281− do newTime <- File.getTime path
282− case Map.lookup name locals of
283− Nothing ->
284− crawlFile env mvar docsNeed name path newTime buildID
255+ case Map.lookup name locals of
256+ Nothing ->
257+ crawlFile env mvar docsNeed name path
285258
286− Just local@(Details.Local oldPath oldTime deps _ lastChange _) ->
287− if path /= oldPath || oldTime /= newTime || needsDocs docsNeed
288− then crawlFile env mvar docsNeed name path newTime lastChange
289− else crawlDeps env mvar deps (SCached local)
259+ Just local@(Details.Local oldPath oldTime deps _) ->
260+ if path /= oldPath
261+ then crawlFile env mvar docsNeed name path
262+ else
263+ do newTime <- File.getTime path
264+ if oldTime < newTime || needsDocs docsNeed
265+ then crawlFile env mvar docsNeed name path
266+ else crawlDeps env mvar deps (SCached local)
290267
291268 p1:p2:ps ->
292− return $ SBadImport $ Import.AmbiguousLocal (FP.makeRelative root p1) (FP.makeRelative root p2) (map (FP.makeRelative root) ps)
269+ return $ SBadImport $ Import.AmbiguousLocal p1 p2 ps
293270
294271 [] ->
295272 case Map.lookup name foreigns of
@@ -302,18 +279,19 @@ crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar do
302279 return $ SBadImport $ Import.AmbiguousForeign dep d ds
303280
304281 Nothing ->
305− if Name.isKernel name && Parse.isKernel projectType then
282+ if Name.isKernel name && Pkg.isKernel pkg then
306283 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
307284 return $ if exists then SKernel else SBadImport Import.NotFound
308285 else
309286 return $ SBadImport Import.NotFound
310287
311288
312−crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> File.Time -> Details.BuildID -> IO Status
313−crawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName path time lastChange =
314− do source <- File.readUtf8 (root </> path)
289+crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> IO Status
290+crawlFile env@(Env _ root pkg _ _ _) mvar docsNeed expectedName path =
291+ do time <- File.getTime path
292+ source <- File.readUtf8 (root </> path)
315293
316− case Parse.fromByteString projectType source of
294+ case Parse.fromByteString pkg source of
317295 Left err ->
318296 return $ SBadSyntax path time source err
319297
@@ -326,7 +304,7 @@ crawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName
326304 if expectedName == actualName then
327305 let
328306 deps = map Src.getImportName imports
329− local = Details.Local path time deps (any isMain values) lastChange buildID
307+ local = Details.Local path time deps (any isMain values)
330308 in
331309 crawlDeps env mvar deps (SChanged local source modul docsNeed)
332310 else
@@ -349,7 +327,7 @@ type ResultDict =
349327data Result
350328 = RNew !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
351329 | RSame !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
352− | RCached Bool Details.BuildID (MVar CachedInterface)
330+ | RCached Bool (MVar CachedInterface)
353331 | RNotFound Import.Problem
354332 | RProblem Error.Module
355333 | RBlocked
@@ -364,15 +342,15 @@ data CachedInterface
364342
365343
366344checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result
367−checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name status =
345+checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
368346 case status of
369− SCached local@(Details.Local path time deps hasMain lastChange lastCompile) ->
347+ SCached local@(Details.Local path time deps hasMain) ->
370348 do results <- readMVar resultsMVar
371− depsStatus <- checkDeps root results deps lastCompile
349+ depsStatus <- checkDeps root results deps
372350 case depsStatus of
373351 DepsChange ifaces ->
374352 do source <- File.readUtf8 path
375− case Parse.fromByteString projectType source of
353+ case Parse.fromByteString pkg source of
376354 Right modul -> compile env (DocsNeed False) local source ifaces modul
377355 Left err ->
378356 return $ RProblem $
@@ -380,7 +358,7 @@ checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name statu
380358
381359 DepsSame _ _ ->
382360 do mvar <- newMVar Unneeded
383− return (RCached hasMain lastChange mvar)
361+ return (RCached hasMain mvar)
384362
385363 DepsBlock ->
386364 return RBlocked
@@ -388,16 +366,16 @@ checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name statu
388366 DepsNotFound problems ->
389367 do source <- File.readUtf8 path
390368 return $ RProblem $ Error.Module name path time source $
391− case Parse.fromByteString projectType source of
369+ case Parse.fromByteString pkg source of
392370 Right (Src.Module _ _ _ imports _ _ _ _ _) ->
393371 Error.BadImports (toImportErrors env results imports problems)
394372
395373 Left err ->
396374 Error.BadSyntax err
397375
398− SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) docsNeed ->
376+ SChanged local@(Details.Local path time deps _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) docsNeed ->
399377 do results <- readMVar resultsMVar
400− depsStatus <- checkDeps root results deps lastCompile
378+ depsStatus <- checkDeps root results deps
401379 case depsStatus of
402380 DepsChange ifaces ->
403381 compile env docsNeed local source ifaces modul
@@ -425,7 +403,7 @@ checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name statu
425403 SForeign home ->
426404 case foreigns ! ModuleName.Canonical home name of
427405 I.Public iface -> return (RForeign iface)
428− I.Private _ _ _ -> error $ "mistakenly seeing private interface for " ++ Pkg.toChars home ++ " " ++ ModuleName.toChars name
406+ I.Private _ _ _ -> error "loading private interface in Build"
429407
430408 SKernel ->
431409 return RKernel
@@ -442,48 +420,32 @@ data DepsStatus
442420 | DepsNotFound (NE.List (ModuleName.Raw, Import.Problem))
443421
444422
445−checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> Details.BuildID -> IO DepsStatus
446−checkDeps root results deps lastCompile =
447− checkDepsHelp root results deps [] [] [] [] False 0 lastCompile
423+checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus
424+checkDeps root results deps =
425+ checkDepsHelp root results deps [] [] [] [] False
448426
449427
450428type Dep = (ModuleName.Raw, I.Interface)
451429type CDep = (ModuleName.Raw, MVar CachedInterface)
452430
453431
454−checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> Details.BuildID -> Details.BuildID -> IO DepsStatus
455−checkDepsHelp root results deps new same cached importProblems isBlocked lastDepChange lastCompile =
432+checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> IO DepsStatus
433+checkDepsHelp root results deps new same cached importProblems isBlocked =
456434 case deps of
457435 dep:otherDeps ->
458436 do result <- readMVar (results ! dep)
459437 case result of
460− RNew (Details.Local _ _ _ _ lastChange _) iface _ _ ->
461− checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked (max lastChange lastDepChange) lastCompile
462−
463− RSame (Details.Local _ _ _ _ lastChange _) iface _ _ ->
464− checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked (max lastChange lastDepChange) lastCompile
465−
466− RCached _ lastChange mvar ->
467− checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked (max lastChange lastDepChange) lastCompile
468−
469− RNotFound prob ->
470− checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True lastDepChange lastCompile
471−
472− RProblem _ ->
473− checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile
474−
475− RBlocked ->
476− checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile
477−
478− RForeign iface ->
479− checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked lastDepChange lastCompile
480−
481− RKernel ->
482− checkDepsHelp root results otherDeps new same cached importProblems isBlocked lastDepChange lastCompile
483−
438+ RNew _ iface _ _ -> checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked
439+ RSame _ iface _ _ -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked
440+ RCached _ mvar -> checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked
441+ RNotFound prob -> checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True
442+ RProblem _ -> checkDepsHelp root results otherDeps new same cached importProblems True
443+ RBlocked -> checkDepsHelp root results otherDeps new same cached importProblems True
444+ RForeign iface -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked
445+ RKernel -> checkDepsHelp root results otherDeps new same cached importProblems isBlocked
484446
485447 [] ->
486− case reverse importProblems of
448+ case importProblems of
487449 p:ps ->
488450 return $ DepsNotFound (NE.List p ps)
489451
@@ -491,7 +453,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked lastDep
491453 if isBlocked then
492454 return $ DepsBlock
493455
494− else if null new && lastDepChange <= lastCompile then
456+ else if null new then
495457 return $ DepsSame same cached
496458
497459 else
@@ -506,7 +468,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked lastDep
506468
507469
508470toImportErrors :: Env -> ResultDict -> [Src.Import] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error
509−toImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems =
471+toImportErrors (Env _ _ _ _ locals foreigns) results imports problems =
510472 let
511473 knownModules =
512474 Set.unions
@@ -585,11 +547,11 @@ checkMidpoint dmvar statuses =
585547 return (Left (Exit.BP_Cycle name names))
586548
587549
588−checkMidpointAndRoots :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List RootStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
589−checkMidpointAndRoots dmvar statuses sroots =
550+checkMainsMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List MainStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
551+checkMainsMidpoint dmvar statuses smains =
590552 case checkForCycles statuses of
591553 Nothing ->
592− case checkUniqueRoots statuses sroots of
554+ case checkUniqueMains statuses smains of
593555 Nothing ->
594556 do maybeForeigns <- readMVar dmvar
595557 case maybeForeigns of
@@ -640,25 +602,25 @@ addToGraph name status graph =
640602 let
641603 dependencies =
642604 case status of
643− SCached (Details.Local _ _ deps _ _ _) -> deps
644− SChanged (Details.Local _ _ deps _ _ _) _ _ _ -> deps
645− SBadImport _ -> []
646− SBadSyntax _ _ _ _ -> []
647− SForeign _ -> []
648− SKernel -> []
605+ SCached (Details.Local _ _ deps _) -> deps
606+ SChanged (Details.Local _ _ deps _) _ _ _ -> deps
607+ SBadImport _ -> []
608+ SBadSyntax _ _ _ _ -> []
609+ SForeign _ -> []
610+ SKernel -> []
649611 in
650612 (name, name, dependencies) : graph
651613
652614
653615
654−-- CHECK UNIQUE ROOTS
616+-- CHECK UNIQUE MAINS
655617
656618
657−checkUniqueRoots :: Map.Map ModuleName.Raw Status -> NE.List RootStatus -> Maybe Exit.BuildProjectProblem
658−checkUniqueRoots insides sroots =
619+checkUniqueMains :: Map.Map ModuleName.Raw Status -> NE.List MainStatus -> Maybe Exit.BuildProjectProblem
620+checkUniqueMains insides smains =
659621 let
660622 outsidesDict =
661− Map.fromListWith OneOrMore.more (Maybe.mapMaybe rootStatusToNamePathPair (NE.toList sroots))
623+ Map.fromListWith OneOrMore.more (Maybe.mapMaybe mainStatusToNamePathPair (NE.toList smains))
662624 in
663625 case Map.traverseWithKey checkOutside outsidesDict of
664626 Left problem ->
@@ -670,30 +632,30 @@ checkUniqueRoots insides sroots =
670632 Left problem -> Just problem
671633
672634
673−rootStatusToNamePathPair :: RootStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
674−rootStatusToNamePathPair sroot =
675− case sroot of
676− SInside _ -> Nothing
677− SOutsideOk (Details.Local path _ _ _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
678− SOutsideErr _ -> Nothing
635+mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
636+mainStatusToNamePathPair smain =
637+ case smain of
638+ SInside _ -> Nothing
639+ SOutsideOk (Details.Local path _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
640+ SOutsideErr _ -> Nothing
679641
680642
681643checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath
682644checkOutside name paths =
683645 case OneOrMore.destruct NE.List paths of
684646 NE.List p [] -> Right p
685− NE.List p1 (p2:_) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
647+ NE.List p1 (p2:_) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
686648
687649
688650checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
689651checkInside name p1 status =
690652 case status of
691− SCached (Details.Local p2 _ _ _ _ _) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
692− SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_RootNameDuplicate name p1 p2)
693− SBadImport _ -> Right ()
694− SBadSyntax _ _ _ _ -> Right ()
695− SForeign _ -> Right ()
696− SKernel -> Right ()
653+ SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
654+ SChanged (Details.Local p2 _ _ _) _ _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
655+ SBadImport _ -> Right ()
656+ SBadSyntax _ _ _ _ -> Right ()
657+ SForeign _ -> Right ()
658+ SKernel -> Right ()
697659
698660
699661
@@ -701,57 +663,40 @@ checkInside name p1 status =
701663
702664
703665compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
704−compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =
705− let
706− pkg = projectTypeToPkg projectType
707− in
666+compile (Env key root pkg _ _ _) docsNeed local@(Details.Local path time _ _) source ifaces modul =
708667 case Compile.compile pkg ifaces modul of
709668 Right (Compile.Artifacts canonical annotations objects) ->
710− case makeDocs docsNeed canonical of
711− Left err ->
712− return $ RProblem $
713− Error.Module (Src.getName modul) path time source (Error.BadDocs err)
714−
715− Right docs ->
716− do let name = Src.getName modul
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)
669+ do let name = Src.getName modul
670+ let iface = I.fromModule pkg canonical annotations
671+ let docs = makeDocs docsNeed canonical
672+ let path = Stuff.elmi root name
673+ File.writeBinary (Stuff.elmo root name) objects
674+ maybeOldi <- File.readBinary path
675+ case maybeOldi of
676+ Just oldi | oldi == iface ->
677+ do -- iface should be fully forced by equality check
678+ Reporting.report key Reporting.BDone
679+ return (RSame local iface objects docs)
680+
681+ _ ->
682+ do -- iface may be lazy still
683+ File.writeBinary path iface
684+ Reporting.report key Reporting.BDone
685+ return (RNew local iface objects docs)
734686
735687 Left err ->
736688 return $ RProblem $
737689 Error.Module (Src.getName modul) path time source err
738690
739691
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−
747692
748693-- WRITE DETAILS
749694
750695
751696writeDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()
752−writeDetails root (Details.Details time outline buildID locals foreigns extras) results =
697+writeDetails root (Details.Details time outline locals foreigns extras) results =
753698 File.writeBinary (Stuff.details root) $
754− Details.Details time outline buildID (Map.foldrWithKey addNewLocal locals results) foreigns extras
699+ Details.Details time outline (Map.foldrWithKey addNewLocal locals results) foreigns extras
755700
756701
757702addNewLocal :: ModuleName.Raw -> Result -> Map.Map ModuleName.Raw Details.Local -> Map.Map ModuleName.Raw Details.Local
@@ -759,7 +704,7 @@ addNewLocal name result locals =
759704 case result of
760705 RNew local _ _ _ -> Map.insert name local locals
761706 RSame local _ _ _ -> Map.insert name local locals
762− RCached _ _ _ -> locals
707+ RCached _ _ -> locals
763708 RNotFound _ -> locals
764709 RProblem _ -> locals
765710 RBlocked -> locals
@@ -771,8 +716,8 @@ addNewLocal name result locals =
771716-- FINALIZE EXPOSED
772717
773718
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 =
719+finalizeExposed :: DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
720+finalizeExposed docsGoal exposed results =
776721 case foldr (addImportProblems results) [] (NE.toList exposed) of
777722 p:ps ->
778723 return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))
@@ -780,7 +725,7 @@ finalizeExposed root docsGoal exposed results =
780725 [] ->
781726 case Map.foldr addErrors [] results of
782727 [] -> Right <$> finalizeDocs docsGoal results
783− e:es -> return $ Left $ Exit.BuildBadModules root e es
728+ e:es -> return $ Left $ Exit.BuildBadModules e es
784729
785730
786731addErrors :: Result -> [Error.Module] -> [Error.Module]
@@ -788,7 +733,7 @@ addErrors result errors =
788733 case result of
789734 RNew _ _ _ _ -> errors
790735 RSame _ _ _ _ -> errors
791− RCached _ _ _ -> errors
736+ RCached _ _ -> errors
792737 RNotFound _ -> errors
793738 RProblem e -> e:errors
794739 RBlocked -> errors
@@ -801,7 +746,7 @@ addImportProblems results name problems =
801746 case results ! name of
802747 RNew _ _ _ _ -> problems
803748 RSame _ _ _ _ -> problems
804− RCached _ _ _ -> problems
749+ RCached _ _ -> problems
805750 RNotFound p -> (name, p) : problems
806751 RProblem _ -> problems
807752 RBlocked -> problems
@@ -831,14 +776,14 @@ toDocsNeed goal =
831776 KeepDocs -> DocsNeed True
832777
833778
834−makeDocs :: DocsNeed -> Can.Module -> Either EDocs.Error (Maybe Docs.Module)
779+makeDocs :: DocsNeed -> Can.Module -> Maybe Docs.Module
835780makeDocs (DocsNeed isNeeded) modul =
836781 if isNeeded then
837782 case Docs.fromModule modul of
838− Right docs -> Right (Just docs)
839− Left err -> Left err
783+ Right docs -> Just docs
784+ Left _ -> Nothing
840785 else
841− Right Nothing
786+ Nothing
842787
843788
844789finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs
@@ -859,7 +804,7 @@ toDocs result =
859804 case result of
860805 RNew _ _ _ d -> d
861806 RSame _ _ _ d -> d
862− RCached _ _ _ -> Nothing
807+ RCached _ _ -> Nothing
863808 RNotFound _ -> Nothing
864809 RProblem _ -> Nothing
865810 RBlocked -> Nothing
@@ -887,41 +832,40 @@ data ReplArtifacts =
887832
888833fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
889834fromRepl root details source =
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
835+ let
836+ env@(Env _ _ pkg _ _ _) = makeEnv Reporting.ignorer root details
837+ in
838+ case Parse.fromByteString pkg source of
839+ Left syntaxError ->
840+ return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
894841
895− Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
896− do dmvar <- Details.loadInterfaces root details
842+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
843+ do dmvar <- Details.loadInterfaces root details
897844
898− let deps = map Src.getImportName imports
899− mvar <- newMVar Map.empty
900− crawlDeps env mvar deps ()
845+ let deps = map Src.getImportName imports
846+ mvar <- newMVar Map.empty
847+ crawlDeps env mvar deps ()
901848
902− statuses <- traverse readMVar =<< readMVar mvar
903− midpoint <- checkMidpoint dmvar statuses
849+ statuses <- traverse readMVar =<< readMVar mvar
850+ midpoint <- checkMidpoint dmvar statuses
904851
905− case midpoint of
906− Left problem ->
907− return $ Left $ Exit.ReplProjectProblem problem
852+ case midpoint of
853+ Left problem ->
854+ return $ Left $ Exit.ReplProjectProblem problem
908855
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
856+ Right foreigns ->
857+ do rmvar <- newEmptyMVar
858+ resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
859+ putMVar rmvar resultMVars
860+ results <- traverse readMVar resultMVars
861+ writeDetails root details results
862+ depsStatus <- checkDeps root resultMVars deps
863+ finalizeReplArtifacts env source modul depsStatus resultMVars results
917864
918865
919866finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
920−finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
867+finalizeReplArtifacts env@(Env _ root pkg _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
921868 let
922− pkg =
923− projectTypeToPkg projectType
924−
925869 compileInput ifaces =
926870 case Compile.compile pkg ifaces modul of
927871 Right (Compile.Artifacts canonical annotations objects) ->
@@ -948,7 +892,7 @@ finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Mod
948892 DepsBlock ->
949893 case Map.foldr addErrors [] results of
950894 [] -> return $ Left $ Exit.ReplBlocked
951− e:es -> return $ Left $ Exit.ReplBadLocalDeps root e es
895+ e:es -> return $ Left $ Exit.ReplBadLocalDeps e es
952896
953897 DepsNotFound problems ->
954898 return $ Left $ Exit.ReplBadInput source $ Error.BadImports $
@@ -964,25 +908,25 @@ finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Mod
964908
965909
966910
967−-- FIND ROOT
911+-- FIND MAIN
968912
969913
970−data RootLocation
914+data MainLocation
971915 = LInside ModuleName.Raw
972916 | LOutside FilePath
973917
974918
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
919+findMains :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List MainLocation))
920+findMains env paths =
921+ do mvars <- traverse (fork . findLocation env) paths
922+ elocs <- traverse readMVar mvars
923+ return $ checkLocations =<< sequence elocs
980924
981925
982−checkRoots :: NE.List RootInfo -> Either Exit.BuildProjectProblem (NE.List RootLocation)
983−checkRoots infos =
926+checkLocations :: NE.List Location -> Either Exit.BuildProjectProblem (NE.List MainLocation)
927+checkLocations locations =
984928 let
985− toOneOrMore loc@(RootInfo absolute _ _) =
929+ toOneOrMore loc@(Location absolute _ _) =
986930 (absolute, OneOrMore.one loc)
987931
988932 fromOneOrMore loc locs =
@@ -990,82 +934,65 @@ checkRoots infos =
990934 [] -> Right ()
991935 loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))
992936 in
993− fmap (\_ -> fmap _location infos) $
937+ fmap (\_ -> fmap _location locations) $
994938 traverse (OneOrMore.destruct fromOneOrMore) $
995− Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList infos)
939+ Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList locations)
996940
997941
998942
999−-- ROOT INFO
943+-- LOCATIONS
1000944
1001945
1002−data RootInfo =
1003− RootInfo
946+data Location =
947+ Location
1004948 { _absolute :: FilePath
1005949 , _relative :: FilePath
1006− , _location :: RootLocation
950+ , _location :: MainLocation
1007951 }
1008952
1009953
1010−getRootInfo :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
1011−getRootInfo env path =
954+findLocation :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem Location)
955+findLocation env path =
1012956 do exists <- File.exists path
1013957 if exists
1014− then getRootInfoHelp env path =<< Dir.canonicalizePath path
958+ then findLoc env path <$> Dir.canonicalizePath path
1015959 else return (Left (Exit.BP_PathUnknown path))
1016960
1017961
1018−getRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
1019−getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
962+findLoc :: Env -> FilePath -> FilePath -> Either Exit.BuildProjectProblem Location
963+findLoc (Env _ root _ srcDirs _ _) path absolutePath =
1020964 let
1021965 (dirs, file) = FP.splitFileName absolutePath
1022− (final, ext) = FP.splitExtension file
966+ (final, ext) = break (=='.') file
1023967 in
1024968 if ext /= ".elm"
1025− then
1026− return $ Left $ Exit.BP_WithBadExtension path
969+ then Left (Exit.BP_WithBadExtension path)
1027970 else
1028971 let
1029− absoluteSegments = FP.splitDirectories dirs ++ [final]
972+ roots = FP.splitDirectories root
973+ segments = FP.splitDirectories dirs ++ [final]
1030974 in
1031− case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of
1032− [] ->
1033− return $ Right $ RootInfo absolutePath path (LOutside path)
1034−
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
1043−
1044− _ ->
1045− return $ Right $ RootInfo absolutePath path (LInside name)
1046−
1047− [(s, Left names)] ->
1048− return $ Left $ Exit.BP_RootNameInvalid path s names
975+ case dropPrefix roots segments of
976+ Nothing ->
977+ Right (Location absolutePath path (LOutside path))
1049978
1050− (s1,_):(s2,_):_ ->
1051− return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
979+ Just relativeSegments ->
980+ case Maybe.mapMaybe (isInsideSrcDir relativeSegments) srcDirs of
981+ [] -> Right $ Location absolutePath path (LOutside path)
982+ [(_, Right name)] -> Right $ Location absolutePath path (LInside name)
983+ [(s, Left names)] -> Left $ Exit.BP_MainNameInvalid path s names
984+ (s1,_):(s2,_):_ -> Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
1052985
1053986
1054−
1055−isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
1056−isInsideSrcDirByName names srcDir =
1057− File.exists (addRelative srcDir (FP.joinPath names <.> "elm"))
1058−
1059−
1060−isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])
1061−isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
987+isInsideSrcDir :: [String] -> FilePath -> Maybe (FilePath, Either [String] ModuleName.Raw)
988+isInsideSrcDir segments srcDir =
1062989 case dropPrefix (FP.splitDirectories srcDir) segments of
1063990 Nothing ->
1064991 Nothing
1065992
1066993 Just names ->
1067994 if all isGoodName names
1068− then Just (srcDir, Right names)
995+ then Just (srcDir, Right (Name.fromChars (List.intercalate "." names)))
1069996 else Just (srcDir, Left names)
1070997
1071998
@@ -1079,8 +1006,6 @@ isGoodName name =
10791006 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars
10801007
10811008
1082−-- INVARIANT: Dir.canonicalizePath has been run on both inputs
1083−--
10841009dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]
10851010dropPrefix roots paths =
10861011 case roots of
@@ -1089,23 +1014,23 @@ dropPrefix roots paths =
10891014
10901015 r:rs ->
10911016 case paths of
1092− [] -> Nothing
1017+ [] -> Nothing
10931018 p:ps -> if r == p then dropPrefix rs ps else Nothing
10941019
10951020
10961021
1097−-- CRAWL ROOTS
1022+-- CRAWL MAINS
10981023
10991024
1100−data RootStatus
1025+data MainStatus
11011026 = SInside ModuleName.Raw
11021027 | SOutsideOk Details.Local B.ByteString Src.Module
11031028 | SOutsideErr Error.Module
11041029
11051030
1106−crawlRoot :: Env -> MVar StatusDict -> RootLocation -> IO RootStatus
1107−crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
1108− case root of
1031+crawlMain :: Env -> MVar StatusDict -> MainLocation -> IO MainStatus
1032+crawlMain env@(Env _ _ pkg _ _ _) mvar given =
1033+ case given of
11091034 LInside name ->
11101035 do statusMVar <- newEmptyMVar
11111036 statusDict <- takeMVar mvar
@@ -1116,10 +1041,10 @@ crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
11161041 LOutside path ->
11171042 do time <- File.getTime path
11181043 source <- File.readUtf8 path
1119− case Parse.fromByteString projectType source of
1044+ case Parse.fromByteString pkg source of
11201045 Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->
11211046 do let deps = map Src.getImportName imports
1122− let local = Details.Local path time deps (any isMain values) buildID buildID
1047+ let local = Details.Local path time deps (any isMain values)
11231048 crawlDeps env mvar deps (SOutsideOk local source modul)
11241049
11251050 Left syntaxError ->
@@ -1128,27 +1053,27 @@ crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
11281053
11291054
11301055
1131−-- CHECK ROOTS
1056+-- CHECK MAINS
11321057
11331058
1134−data RootResult
1059+data MainResult
11351060 = RInside ModuleName.Raw
11361061 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph
11371062 | ROutsideErr Error.Module
11381063 | ROutsideBlocked
11391064
11401065
1141−checkRoot :: Env -> ResultDict -> RootStatus -> IO RootResult
1142−checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =
1143− case rootStatus of
1066+checkMain :: Env -> ResultDict -> MainStatus -> IO MainResult
1067+checkMain env@(Env _ root _ _ _ _) results pendingMain =
1068+ case pendingMain of
11441069 SInside name ->
11451070 return (RInside name)
11461071
11471072 SOutsideErr err ->
11481073 return (ROutsideErr err)
11491074
1150− SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
1151− do depsStatus <- checkDeps root results deps lastCompile
1075+ SOutsideOk local@(Details.Local path time deps _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
1076+ do depsStatus <- checkDeps root results deps
11521077 case depsStatus of
11531078 DepsChange ifaces ->
11541079 compileOutside env local source ifaces modul
@@ -1167,10 +1092,9 @@ checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =
11671092 Error.BadImports (toImportErrors env results imports problems)
11681093
11691094
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 =
1095+compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO MainResult
1096+compileOutside (Env key _ pkg _ _ _) (Details.Local path time _ _) source ifaces modul =
11721097 let
1173− pkg = projectTypeToPkg projectType
11741098 name = Src.getName modul
11751099 in
11761100 case Compile.compile pkg ifaces modul of
@@ -1186,35 +1110,35 @@ compileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _)
11861110-- TO ARTIFACTS
11871111
11881112
1189−data Root
1113+data Main
11901114 = Inside ModuleName.Raw
11911115 | Outside ModuleName.Raw I.Interface Opt.LocalGraph
11921116
11931117
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
1118+toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either Exit.BuildProblem Artifacts
1119+toArtifacts (Env _ _ pkg _ _ _) foreigns results mainResults =
1120+ case gatherProblemsOrMains results mainResults of
11971121 Left (NE.List e es) ->
1198− Left (Exit.BuildBadModules root e es)
1122+ Left (Exit.BuildBadModules e es)
11991123
1200− Right roots ->
1201− Right $ Artifacts (projectTypeToPkg projectType) foreigns roots $
1202− Map.foldrWithKey addInside (foldr addOutside [] rootResults) results
1124+ Right mains ->
1125+ Right $ Artifacts pkg foreigns mains $
1126+ Map.foldrWithKey addInside (foldr addOutside [] mainResults) results
12031127
12041128
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) =
1129+gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either (NE.List Error.Module) (NE.List Main)
1130+gatherProblemsOrMains results (NE.List mainResult mainResults) =
12071131 let
1208− addResult result (es, roots) =
1132+ sortMain result (es, mains) =
12091133 case result of
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)
1134+ RInside n -> ( es, Inside n : mains)
1135+ ROutsideOk n i o -> ( es, Outside n i o : mains)
1136+ ROutsideErr e -> (e:es, mains)
1137+ ROutsideBlocked -> ( es, mains)
12141138
12151139 errors = Map.foldr addErrors [] results
12161140 in
1217− case (rootResult, foldr addResult (errors, []) rootResults) of
1141+ case (mainResult, foldr sortMain (errors, []) mainResults) of
12181142 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)
12191143 (RInside _ , (e:es, _ )) -> Left (NE.List e es)
12201144 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
@@ -1229,7 +1153,7 @@ addInside name result modules =
12291153 case result of
12301154 RNew _ iface objs _ -> Fresh name iface objs : modules
12311155 RSame _ iface objs _ -> Fresh name iface objs : modules
1232− RCached main _ mvar -> Cached name main mvar : modules
1156+ RCached main mvar -> Cached name main mvar : modules
12331157 RNotFound _ -> error (badInside name)
12341158 RProblem _ -> error (badInside name)
12351159 RBlocked -> error (badInside name)
@@ -1242,9 +1166,9 @@ badInside name =
12421166 "Error from `" ++ Name.toChars name ++ "` should have been reported already."
12431167
12441168
1245−addOutside :: RootResult -> [Module] -> [Module]
1246−addOutside root modules =
1247− case root of
1169+addOutside :: MainResult -> [Module] -> [Module]
1170+addOutside main modules =
1171+ case main of
12481172 RInside _ -> modules
12491173 ROutsideOk name iface objs -> Fresh name iface objs : modules
12501174 ROutsideErr _ -> modules
builder/src/Deps/Solver.hs+24−27
@@ -94,7 +94,6 @@ data Details =
9494
9595verify :: Stuff.PackageCache -> Connection -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details))
9696verify cache connection registry constraints =
97− Stuff.withRegistryLock cache $
9897 case try constraints of
9998 Solver solver ->
10099 solver (State cache connection registry Map.empty)
@@ -131,7 +130,6 @@ data AppSolution =
131130
132131addToApp :: Stuff.PackageCache -> Connection -> Registry.Registry -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution)
133132addToApp cache connection registry pkg outline@(Outline.AppOutline _ _ direct indirect testDirect testIndirect) =
134− Stuff.withRegistryLock cache $
135133 let
136134 allIndirects = Map.union indirect testIndirect
137135 allDirects = Map.union direct testDirect
@@ -351,31 +349,30 @@ data Env =
351349
352350initEnv :: IO (Either Exit.RegistryProblem Env)
353351initEnv =
354− do mvar <- newEmptyMVar
355− _ <- forkIO $ putMVar mvar =<< Http.getManager
356− cache <- Stuff.getPackageCache
357− Stuff.withRegistryLock cache $
358− do maybeRegistry <- Registry.read cache
359− manager <- readMVar mvar
360−
361− case maybeRegistry of
362− Nothing ->
363− do eitherRegistry <- Registry.fetch manager cache
364− case eitherRegistry of
365− Right latestRegistry ->
366− return $ Right $ Env cache manager (Online manager) latestRegistry
367−
368− Left problem ->
369− return $ Left $ problem
370−
371− Just cachedRegistry ->
372− do eitherRegistry <- Registry.update manager cache cachedRegistry
373− case eitherRegistry of
374− Right latestRegistry ->
375− return $ Right $ Env cache manager (Online manager) latestRegistry
376−
377− Left _ ->
378− return $ Right $ Env cache manager Offline cachedRegistry
352+ Stuff.withRegistryLock $ \cache ->
353+ do mvar <- newEmptyMVar
354+ _ <- forkIO $ putMVar mvar =<< Http.getManager
355+ maybeRegistry <- Registry.read cache
356+ manager <- readMVar mvar
357+
358+ case maybeRegistry of
359+ Nothing ->
360+ do eitherRegistry <- Registry.fetch manager cache
361+ case eitherRegistry of
362+ Right latestRegistry ->
363+ return $ Right $ Env cache manager (Online manager) latestRegistry
364+
365+ Left problem ->
366+ return $ Left $ problem
367+
368+ Just cachedRegistry ->
369+ do eitherRegistry <- Registry.update manager cache cachedRegistry
370+ case eitherRegistry of
371+ Right latestRegistry ->
372+ return $ Right $ Env cache manager (Online manager) latestRegistry
373+
374+ Left _ ->
375+ return $ Right $ Env cache manager Offline cachedRegistry
379376
380377
381378
builder/src/Elm/Details.hs+17−51
@@ -2,7 +2,6 @@
22{-# LANGUAGE BangPatterns, OverloadedStrings #-}
33module Elm.Details
44 ( Details(..)
5− , BuildID
65 , ValidOutline(..)
76 , Local(..)
87 , Foreign(..)
@@ -16,7 +15,7 @@ module Elm.Details
1615
1716import Control.Concurrent (forkIO)
1817import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)
19−import Control.Monad (liftM, liftM2, liftM3)
18+import Control.Monad (liftM, liftM2, liftM3, liftM4)
2019import Data.Binary (Binary, get, put, getWord8, putWord8)
2120import qualified Data.Either as Either
2221import qualified Data.Map as Map
@@ -28,7 +27,6 @@ import qualified Data.NonEmptyList as NE
2827import qualified Data.OneOrMore as OneOrMore
2928import qualified Data.Set as Set
3029import qualified Data.Utf8 as Utf8
31−import Data.Word (Word64)
3230import qualified System.Directory as Dir
3331import System.FilePath ((</>), (<.>))
3432
@@ -68,42 +66,23 @@ data Details =
6866 Details
6967 { _outlineTime :: File.Time
7068 , _outline :: ValidOutline
71− , _buildID :: BuildID
7269 , _locals :: Map.Map ModuleName.Raw Local
7370 , _foreigns :: Map.Map ModuleName.Raw Foreign
7471 , _extras :: Extras
7572 }
7673
7774
78−type BuildID = Word64
79−
80−
8175data ValidOutline
82− = ValidApp (NE.List Outline.SrcDir)
76+ = ValidApp (NE.List FilePath)
8377 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})
8478
8579
86−-- NOTE: we need two ways to detect if a file must be recompiled:
87−--
88−-- (1) _time is the modification time from the last time we compiled the file.
89−-- By checking EQUALITY with the current modification time, we can detect file
90−-- saves and `git checkout` of previous versions. Both need a recompile.
91−--
92−-- (2) _lastChange is the BuildID from the last time a new interface file was
93−-- generated, and _lastCompile is the BuildID from the last time the file was
94−-- compiled. These may be different if a file is recompiled but the interface
95−-- stayed the same. When the _lastCompile is LESS THAN the _lastChange of any
96−-- imports, we need to recompile. This can happen when a project has multiple
97−-- entrypoints and some modules are compiled less often than their imports.
98−--
9980data Local =
10081 Local
10182 { _path :: FilePath
10283 , _time :: File.Time
10384 , _deps :: [ModuleName.Raw]
10485 , _main :: Bool
105− , _lastChange :: BuildID
106− , _lastCompile :: BuildID
10786 }
10887
10988
@@ -125,14 +104,14 @@ type Interfaces =
125104
126105
127106loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))
128−loadObjects root (Details _ _ _ _ _ extras) =
107+loadObjects root (Details _ _ _ _ extras) =
129108 case extras of
130109 ArtifactsFresh _ o -> newMVar (Just o)
131110 ArtifactsCached -> fork (File.readBinary (Stuff.objects root))
132111
133112
134113loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))
135−loadInterfaces root (Details _ _ _ _ _ extras) =
114+loadInterfaces root (Details _ _ _ _ extras) =
136115 case extras of
137116 ArtifactsFresh i _ -> newMVar (Just i)
138117 ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))
@@ -164,9 +143,9 @@ load style scope root =
164143 Nothing ->
165144 generate style scope root newTime
166145
167− Just details@(Details oldTime _ buildID _ _ _) ->
146+ Just details@(Details oldTime _ _ _ _) ->
168147 if oldTime == newTime
169− then return (Right details { _buildID = buildID + 1 })
148+ then return (Right details)
170149 else generate style scope root newTime
171150
172151
@@ -312,12 +291,11 @@ fork work =
312291
313292
314293verifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Task Details
315−verifyDependencies env@(Env key scope root cache _ _ _) time outline solution directDeps =
294+verifyDependencies env@(Env key scope root _ _ _ _) time outline solution directDeps =
316295 Task.eio id $
317296 do Reporting.report key (Reporting.DStart (Map.size solution))
318297 mvar <- newEmptyMVar
319− mvars <- Stuff.withRegistryLock cache $
320− Map.traverseWithKey (\k v -> fork (verifyDep env mvar solution k v)) solution
298+ mvars <- Map.traverseWithKey (\k v -> fork (verifyDep env mvar solution k v)) solution
321299 putMVar mvar mvars
322300 deps <- traverse readMVar mvars
323301 case sequence deps of
@@ -330,8 +308,8 @@ verifyDependencies env@(Env key scope root cache _ _ _) time outline solution di
330308 let
331309 objs = Map.foldr addObjects Opt.empty artifacts
332310 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts
333− foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps
334− details = Details time outline 0 Map.empty foreigns (ArtifactsFresh ifaces objs)
311+ foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty artifacts
312+ details = Details time outline Map.empty foreigns (ArtifactsFresh ifaces objs)
335313 in
336314 do BW.writeBinary scope (Stuff.objects root) objs
337315 BW.writeBinary scope (Stuff.interfaces root) ifaces
@@ -380,6 +358,7 @@ type Dep =
380358
381359verifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Pkg.Name -> Solver.Details -> IO Dep
382360verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg details@(Solver.Details vsn directDeps) =
361+ Stuff.withPackageLock cache pkg vsn $
383362 do let fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps
384363 exists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn </> "src")
385364 if exists
@@ -595,7 +574,7 @@ crawlModule foreignDeps mvar pkg src docsStatus name =
595574crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
596575crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
597576 do bytes <- File.readUtf8 path
598− case Parse.fromByteString (Parse.Package pkg) bytes of
577+ case Parse.fromByteString pkg bytes of
599578 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->
600579 do deps <- crawlImports foreignDeps mvar pkg src imports
601580 return (Just (SLocal docsStatus deps modul))
@@ -782,14 +761,8 @@ endpointDecoder =
782761
783762
784763instance Binary Details where
785− put (Details a b c d e _) = put a >> put b >> put c >> put d >> put e
786− get =
787− do a <- get
788− b <- get
789− c <- get
790− d <- get
791− e <- get
792− return (Details a b c d e ArtifactsCached)
764+ get = do { a <- get; b <- get; c <- get; d <- get; return (Details a b c d ArtifactsCached) }
765+ put (Details a b c d _) = put a >> put b >> put c >> put d
793766
794767
795768instance Binary ValidOutline where
@@ -803,19 +776,12 @@ instance Binary ValidOutline where
803776 case n of
804777 0 -> liftM ValidApp get
805778 1 -> liftM3 ValidPkg get get get
806− _ -> fail "binary encoding of ValidOutline was corrupted"
779+ _ -> error "binary encoding of ValidOutline was corrupted"
807780
808781
809782instance Binary Local where
810− put (Local a b c d e f) = put a >> put b >> put c >> put d >> put e >> put f
811− get =
812− do a <- get
813− b <- get
814− c <- get
815− d <- get
816− e <- get
817− f <- get
818− return (Local a b c d e f)
783+ get = liftM4 Local get get get get
784+ put (Local a b c d) = put a >> put b >> put c >> put d
819785
820786
821787instance Binary Foreign where
builder/src/Elm/Outline.hs+15−103
@@ -5,7 +5,6 @@ module Elm.Outline
55 , AppOutline(..)
66 , PkgOutline(..)
77 , Exposed(..)
8− , SrcDir(..)
98 , read
109 , write
1110 , encode
@@ -17,14 +16,11 @@ module Elm.Outline
1716
1817
1918import Prelude hiding (read)
20−import Control.Monad (filterM, liftM)
21−import Data.Binary (Binary, get, put, getWord8, putWord8)
19+import Control.Monad (filterM)
2220import qualified Data.Map as Map
2321import qualified Data.NonEmptyList as NE
24−import qualified Data.OneOrMore as OneOrMore
2522import Foreign.Ptr (minusPtr)
2623import qualified System.Directory as Dir
27−import qualified System.FilePath as FP
2824import System.FilePath ((</>))
2925
3026import qualified Elm.Constraint as Con
@@ -53,7 +49,7 @@ data Outline
5349data AppOutline =
5450 AppOutline
5551 { _app_elm_version :: V.Version
56− , _app_source_dirs :: NE.List SrcDir
52+ , _app_source_dirs :: NE.List FilePath
5753 , _app_deps_direct :: Map.Map Pkg.Name V.Version
5854 , _app_deps_indirect :: Map.Map Pkg.Name V.Version
5955 , _app_test_direct :: Map.Map Pkg.Name V.Version
@@ -79,11 +75,6 @@ data Exposed
7975 | ExposedDict [(Json.String, [ModuleName.Raw])]
8076
8177
82−data SrcDir
83− = AbsoluteSrcDir FilePath
84− | RelativeSrcDir FilePath
85−
86−
8778
8879-- DEFAULTS
8980
@@ -126,7 +117,7 @@ encode outline =
126117 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->
127118 E.object
128119 [ "type" ==> E.chars "application"
129− , "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs)
120+ , "source-directories" ==> E.list E.chars (NE.toList srcDirs)
130121 , "elm-version" ==> V.encode elm
131122 , "dependencies" ==>
132123 E.object
@@ -174,13 +165,6 @@ encodeDeps encodeValue deps =
174165 E.dict Pkg.toJsonString encodeValue deps
175166
176167
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−
184168
185169-- PARSE AND VERIFY
186170
@@ -200,66 +184,19 @@ read root =
200184 then Left Exit.OutlineNoPkgCore
201185 else Right outline
202186
203− App (AppOutline _ srcDirs direct indirect _ _)
204− | Map.notMember Pkg.core direct ->
205− return $ Left Exit.OutlineNoAppCore
206−
207− | Map.notMember Pkg.json direct && Map.notMember Pkg.json indirect ->
208− return $ Left Exit.OutlineNoAppJson
209−
187+ App (AppOutline _ srcDirs deps _ _ _)
188+ | Map.notMember Pkg.core deps -> return $ Left Exit.OutlineNoAppCore
189+ | Map.notMember Pkg.json deps -> return $ Left Exit.OutlineNoAppJson
210190 | otherwise ->
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−
191+ do badDirs <- filterM (isBadSrcDir root) (NE.toList srcDirs)
192+ case badDirs of
193+ [] -> return $ Right outline
194+ d:ds -> return $ Left (Exit.OutlineHasBadSrcDirs d ds)
237195
238−toAbsolute :: FilePath -> SrcDir -> FilePath
239−toAbsolute root srcDir =
240− case srcDir of
241− AbsoluteSrcDir dir -> dir
242− RelativeSrcDir dir -> root </> dir
243196
244−
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)
197+isBadSrcDir :: FilePath -> FilePath -> IO Bool
198+isBadSrcDir root dir =
199+ not <$> Dir.doesDirectoryExist (root </> dir)
263200
264201
265202
@@ -337,16 +274,9 @@ depsDecoder valueDecoder =
337274 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder
338275
339276
340−dirsDecoder :: Decoder (NE.List SrcDir)
277+dirsDecoder :: Decoder (NE.List FilePath)
341278dirsDecoder =
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
279+ fmap Json.toChars <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs
350280
351281
352282
@@ -387,21 +317,3 @@ boundParser bound tooLong =
387317 if len < bound
388318 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)
389319 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/File.hs+3−20
@@ -78,21 +78,8 @@ readBinary path =
7878 then
7979 do result <- Binary.decodeFileOrFail path
8080 case result of
81− Right a ->
82− return (Just a)
83−
84− Left (offset, message) ->
85− do IO.hPutStrLn IO.stderr $ unlines $
86− [ "+-------------------------------------------------------------------------------"
87− , "| Corrupt File: " ++ path
88− , "| Byte Offset: " ++ show offset
89− , "| Message: " ++ message
90− , "|"
91− , "| Please report this to https://github.com/elm/compiler/issues"
92− , "| Trying to continue anyway."
93− , "+-------------------------------------------------------------------------------"
94− ]
95− return Nothing
81+ Right a -> return (Just a)
82+ Left _ -> return Nothing
9683 else
9784 return Nothing
9885
@@ -190,11 +177,7 @@ writeEntry destination root entry =
190177 let
191178 path = drop root (Zip.eRelativePath entry)
192179 in
193− if List.isPrefixOf "src/" path
194− || path == "LICENSE"
195− || path == "README.md"
196− || path == "elm.json"
197− then
180+ if path == "LICENSE" || List.isPrefixOf "src/" path then
198181 if not (null path) && last path == '/'
199182 then Dir.createDirectoryIfMissing True (destination </> path)
200183 else LBS.writeFile (destination </> path) (Zip.fromEntry entry)
builder/src/Generate.hs+7−7
@@ -99,18 +99,18 @@ checkForDebugUses (Objects _ locals) =
9999-- GATHER MAINS
100100
101101
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)
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)
105105
106106
107−lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Root -> Maybe (ModuleName.Canonical, Opt.Main)
108−lookupMain pkg locals root =
107+lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Main -> Maybe (ModuleName.Canonical, Opt.Main)
108+lookupMain pkg locals buildMain =
109109 let
110110 toPair name (Opt.LocalGraph maybeMain _ _) =
111111 (,) (ModuleName.Canonical pkg name) <$> maybeMain
112112 in
113− case root of
113+ case buildMain of
114114 Build.Inside name -> toPair name =<< Map.lookup name locals
115115 Build.Outside name _ g -> toPair name g
116116
@@ -200,7 +200,7 @@ loadTypesHelp root modul =
200200 Build.Unneeded ->
201201 do mvar <- newEmptyMVar
202202 _ <- forkIO $
203− do maybeIface <- File.readBinary (Stuff.elmi root name)
203+ do maybeIface <- File.readBinary (Stuff.elmo root name)
204204 putMVar mvar (Extract.fromInterface name <$> maybeIface)
205205 return mvar
206206
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+7−9
@@ -33,7 +33,7 @@ import qualified Data.ByteString.Builder as B
3333import qualified Data.NonEmptyList as NE
3434import qualified System.Exit as Exit
3535import qualified System.Info as Info
36−import System.IO (hFlush, hPutStr, hPutStrLn, stderr, stdout)
36+import System.IO (hFlush, hPutStr, stderr, stdout)
3737
3838import qualified Elm.ModuleName as ModuleName
3939import qualified Elm.Package as Pkg
@@ -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 _ ->
@@ -446,19 +446,17 @@ reportExceptionsNicely e =
446446
447447
448448putException :: SomeException -> IO ()
449−putException e = do
450− hPutStrLn stderr ""
449+putException e =
451450 Help.toStderr $ D.stack $
452− [ D.dullyellow "-- ERROR -----------------------------------------------------------------------"
453− , D.reflow $
454− "I ran into something that bypassed the normal error reporting process!\
451+ [ D.reflow $
452+ "Oh no! I ran into something that bypassed the normal error reporting process!\
455453 \ I extracted whatever information I could from the internal error:"
456454 , D.vcat $ map (\line -> D.red ">" <> " " <> D.fromChars line) (lines (show e))
457455 , D.reflow $
458456 "These errors are usually pretty confusing, so start by asking around on one of\
459457 \ forums listed at https://elm-lang.org/community to see if anyone can get you\
460458 \ unstuck quickly."
461− , D.dullyellow "-- REQUEST ---------------------------------------------------------------------"
459+ , "------------------------------------------------------------"
462460 , D.reflow $
463461 "If you are feeling up to it, please try to get your code down to the smallest\
464462 \ version that still triggers this message. Ideally in a single Main.elm and\
builder/src/Reporting/Exit.hs+97−94
@@ -8,6 +8,7 @@ module Reporting.Exit
88 , Publish(..), publishToReport
99 , Install(..), installToReport
1010 , Reactor(..), reactorToReport
11+ , Worker(..), workerToReport
1112 , newPackageOverview
1213 --
1314 , Solver(..)
@@ -30,6 +31,9 @@ module Reporting.Exit
3031
3132
3233import qualified Data.ByteString as BS
34+import qualified Data.ByteString.Builder as B
35+import qualified Data.ByteString.Char8 as BSC
36+import qualified Data.ByteString.Lazy as LBS
3337import qualified Data.ByteString.UTF8 as BS_UTF8
3438import qualified Data.List as List
3539import qualified Data.Map as Map
@@ -174,7 +178,7 @@ diffToReport diff =
174178 \ with packages. That way there are previously published versions of the API to\
175179 \ diff against!"
176180 [ D.reflow $ "If you are just curious to see a diff, try running this command:"
177− , D.indent 4 $ D.dullyellow $ "elm diff elm/json 1.0.0 1.1.2"
181+ , D.indent 4 $ D.dullyellow $ "elm diff elm/http 1.0.0 2.0.0"
178182 ]
179183
180184 DiffNoExposed ->
@@ -747,7 +751,7 @@ data Install
747751 | InstallHadSolverTrouble Solver
748752 | InstallUnknownPackageOnline Pkg.Name [Pkg.Name]
749753 | InstallUnknownPackageOffline Pkg.Name [Pkg.Name]
750− | InstallBadDetails Details
754+ | InstallHasBadDetails Pkg.Name Encode.Value
751755
752756
753757installToReport :: Install -> Help.Report
@@ -891,8 +895,20 @@ installToReport exit =
891895 , D.reflow $ "Maybe you want one of these instead?"
892896 ]
893897
894− InstallBadDetails details ->
895− toDetailsReport details
898+ InstallHasBadDetails pkg outline ->
899+ Help.report "INSTALL PROBLEM" Nothing
900+ (
901+ "I found a version of " ++ Pkg.toChars pkg ++ " that claims to be compatible with\
902+ \ your existing dependencies, but I ran into an error when I tried to build it locally."
903+ )
904+ [ D.reflow $
905+ "Here is an elm.json that should reproduce the error with a bit more information:"
906+ , D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromChars $
907+ map BS_UTF8.toString $ BSC.lines $ LBS.toStrict $ B.toLazyByteString $
908+ Encode.encode outline
909+ , D.reflow $
910+ "Maybe that can help figure out what is going on here."
911+ ]
896912
897913
898914
@@ -947,8 +963,7 @@ toSolverReport problem =
947963
948964data Outline
949965 = OutlineHasBadStructure (Decode.Error OutlineProblem)
950− | OutlineHasMissingSrcDirs FilePath [FilePath]
951− | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath
966+ | OutlineHasBadSrcDirs FilePath [FilePath]
952967 | OutlineNoPkgCore
953968 | OutlineNoAppCore
954969 | OutlineNoAppJson
@@ -974,12 +989,12 @@ toOutlineReport problem =
974989 Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $
975990 Json.ExplicitReason "I ran into a problem with your elm.json file."
976991
977− OutlineHasMissingSrcDirs dir dirs ->
992+ OutlineHasBadSrcDirs dir dirs ->
978993 case dirs of
979994 [] ->
980995 Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")
981996 "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"
982− [ D.indent 4 $ D.red $ D.fromChars dir
997+ [ D.indent 4 $ D.dullyellow $ D.fromChars dir
983998 , D.reflow $
984999 "I cannot find it though. Is it missing? Is there a typo?"
9851000 ]
@@ -987,61 +1002,30 @@ toOutlineReport problem =
9871002 _:_ ->
9881003 Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")
9891004 "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"
990− [ D.indent 4 $ D.vcat $
991− map (D.red . D.fromChars) (dir:dirs)
1005+ [ D.indent 4 $ D.dullyellow $ D.fromChars dir
9921006 , D.reflow $
9931007 "I cannot find them though. Are they missing? Are there typos?"
9941008 ]
9951009
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−
10171010 OutlineNoPkgCore ->
10181011 Help.report "MISSING DEPENDENCY" (Just "elm.json")
1019− "I need to see an \"elm/core\" dependency your elm.json file. The default imports\
1020− \ of `List` and `Maybe` do not work without it."
1021− [ D.reflow $
1022− "If you modified your elm.json by hand, try to change it back! And if you are\
1023− \ having trouble getting back to a working elm.json, it may be easier to find a\
1024− \ working package and start fresh with their elm.json file."
1012+ "I need a valid elm.json file, so I need to see an \"elm/core\" dependency in there. Try running:"
1013+ [ D.indent 4 $ D.green $ "elm install elm/core"
1014+ , D.reflow "I need it for the default imports that make `List` and `Maybe` available."
10251015 ]
10261016
10271017 OutlineNoAppCore ->
10281018 Help.report "MISSING DEPENDENCY" (Just "elm.json")
1029− "I need to see an \"elm/core\" dependency your elm.json file. The default imports\
1030− \ of `List` and `Maybe` do not work without it."
1031− [ D.reflow $
1032− "If you modified your elm.json by hand, try to change it back! And if you are\
1033− \ having trouble getting back to a working elm.json, it may be easier to delete it\
1034− \ and use `elm init` to start fresh."
1019+ "I need a valid elm.json file, so I need to see an \"elm/core\" dependency in there. Try running:"
1020+ [ D.indent 4 $ D.green $ "elm install elm/core"
1021+ , D.reflow "It has some supporting code that is needed by every Elm application!"
10351022 ]
10361023
10371024 OutlineNoAppJson ->
10381025 Help.report "MISSING DEPENDENCY" (Just "elm.json")
1039− "I need to see an \"elm/json\" dependency your elm.json file. It helps me handle\
1040− \ flags and ports."
1041− [ D.reflow $
1042− "If you modified your elm.json by hand, try to change it back! And if you are\
1043− \ having trouble getting back to a working elm.json, it may be easier to delete it\
1044− \ and use `elm init` to start fresh."
1026+ "I need a valid elm.json file, so I need to see an \"elm/json\" dependency in there. Try running:"
1027+ [ D.indent 4 $ D.green $ "elm install elm/json"
1028+ , D.reflow "It helps me handle flags and ports."
10451029 ]
10461030
10471031
@@ -1175,16 +1159,10 @@ toOutlineProblemReport path source _ region problem =
11751159 toSnippet "HEADER TOO LONG" Nothing
11761160 ( D.reflow $
11771161 "I got stuck while reading your elm.json file. This section header is too long:"
1178− , D.stack
1179− [ D.fillSep
1180− ["I","need","it","to","be"
1181− ,D.green "under",D.green "20",D.green "bytes"
1182− ,"so","it","renders","nicely","on","the","package","website!"
1183− ]
1184− , D.toSimpleNote
1185− "I count the length in bytes, so using non-ASCII characters costs extra.\
1186− \ Please report your case at https://github.com/elm/compiler/issues if this seems\
1187− \ overly restrictive for your needs."
1162+ , D.fillSep
1163+ ["I","need","it","to","be"
1164+ ,D.green "under",D.green "20",D.green "characters"
1165+ ,"so","it","renders","nicely","on","the","package","website!"
11881166 ]
11891167 )
11901168
@@ -1229,16 +1207,10 @@ toOutlineProblemReport path source _ region problem =
12291207 toSnippet "SUMMARY TOO LONG" Nothing
12301208 ( D.reflow $
12311209 "I got stuck while reading your elm.json file. Your \"summary\" is too long:"
1232− , D.stack
1233− [ D.fillSep
1234− ["I","need","it","to","be"
1235− ,D.green "under",D.green "80",D.green "bytes"
1236− ,"so","it","renders","nicely","on","the","package","website!"
1237− ]
1238− , D.toSimpleNote
1239− "I count the length in bytes, so using non-ASCII characters costs extra.\
1240− \ Please report your case at https://github.com/elm/compiler/issues if this seems\
1241− \ overly restrictive for your needs."
1210+ , D.fillSep
1211+ ["I","need","it","to","be"
1212+ ,D.green "under",D.green "80",D.green "characters"
1213+ ,"so","it","renders","nicely","on","the","package","website!"
12421214 ]
12431215 )
12441216
@@ -1282,7 +1254,8 @@ toDetailsReport details =
12821254 "The dependencies in your elm.json are not compatible."
12831255 [ D.fillSep
12841256 ["Did","you","change","them","by","hand?","Try","to","change","it","back!"
1285− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1257+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1258+ ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
12861259 ]
12871260 , D.reflow $
12881261 "Please ask for help on the community forums if you try those paths and are still\
@@ -1299,7 +1272,8 @@ toDetailsReport details =
12991272 \ get access to the registry!"
13001273 , D.toFancyNote
13011274 ["If","you","changed","your","dependencies","by","hand,","try","to","change","them","back!"
1302− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1275+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1276+ ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
13031277 ]
13041278 ]
13051279
@@ -1335,7 +1309,8 @@ toDetailsReport details =
13351309 \ party tool) leaving them in an invalid state."
13361310 [ D.fillSep
13371311 ["Try","to","change","them","back","to","what","they","were","before!"
1338− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1312+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1313+ ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
13391314 ]
13401315 , D.reflow $
13411316 "Please ask for help on the community forums if you try those paths and are still\
@@ -1350,7 +1325,7 @@ toDetailsReport details =
13501325 "I need the list of published packages to verify your dependencies"
13511326
13521327 DetailsBadDeps cacheDir deps ->
1353− case List.sortOn toBadDepRank deps of
1328+ case deps of
13541329 [] ->
13551330 Help.report "PROBLEM BUILDING DEPENDENCIES" Nothing
13561331 "I am not sure what is going wrong though."
@@ -1390,13 +1365,6 @@ toDetailsReport details =
13901365 ]
13911366
13921367
1393−toBadDepRank :: DetailsBadDep -> Int -- lower is better
1394−toBadDepRank badDep =
1395− case badDep of
1396− BD_BadDownload _ _ _ -> 0
1397− BD_BadBuild _ _ _ -> 1
1398−
1399−
14001368
14011369-- PACKAGE PROBLEM
14021370
@@ -1522,7 +1490,7 @@ toHttpErrorReport title err context =
15221490
15231491 Http.BadHttp url httpExceptionContent ->
15241492 case httpExceptionContent of
1525− HTTP.StatusCodeException response body ->
1493+ HTTP.StatusCodeException response _ ->
15261494 let
15271495 (HTTP.Status code message) = HTTP.responseStatus response
15281496 in
@@ -1530,7 +1498,6 @@ toHttpErrorReport title err context =
15301498 [ D.fillSep $
15311499 ["But","it","came","back","as",D.red (D.fromInt code)]
15321500 ++ map D.fromChars (words (BS_UTF8.toString message))
1533− , D.indent 4 $ D.reflow $ BS_UTF8.toString body
15341501 , D.reflow $
15351502 "This may mean some online endpoint changed in an unexpected way, so if does not\
15361503 \ seem like something on your side is causing this (e.g. firewall) please report\
@@ -1756,7 +1723,7 @@ makeToReport make =
17561723
17571724
17581725data BuildProblem
1759− = BuildBadModules FilePath Error.Module [Error.Module]
1726+ = BuildBadModules Error.Module [Error.Module]
17601727 | BuildProjectProblem BuildProjectProblem
17611728
17621729
@@ -1765,8 +1732,8 @@ data BuildProjectProblem
17651732 | BP_WithBadExtension FilePath
17661733 | BP_WithAmbiguousSrcDir FilePath FilePath FilePath
17671734 | BP_MainPathDuplicate FilePath FilePath
1768− | BP_RootNameDuplicate ModuleName.Raw FilePath FilePath
1769− | BP_RootNameInvalid FilePath FilePath [String]
1735+ | BP_MainNameDuplicate ModuleName.Raw FilePath FilePath
1736+ | BP_MainNameInvalid FilePath FilePath [String]
17701737 | BP_CannotLoadDependencies
17711738 | BP_Cycle ModuleName.Raw [ModuleName.Raw]
17721739 | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))
@@ -1775,8 +1742,8 @@ data BuildProjectProblem
17751742toBuildProblemReport :: BuildProblem -> Help.Report
17761743toBuildProblemReport problem =
17771744 case problem of
1778− BuildBadModules root e es ->
1779− Help.compilerReport root e es
1745+ BuildBadModules e es ->
1746+ Help.compilerReport e es
17801747
17811748 BuildProjectProblem projectProblem ->
17821749 toProjectProblemReport projectProblem
@@ -1833,7 +1800,7 @@ toProjectProblemReport projectProblem =
18331800 \ unstuck!"
18341801 ]
18351802
1836− BP_RootNameDuplicate name outsidePath otherPath ->
1803+ BP_MainNameDuplicate name outsidePath otherPath ->
18371804 Help.report "MODULE NAME CLASH" Nothing
18381805 "These two files are causing a module name clash:"
18391806 [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]
@@ -1844,7 +1811,7 @@ toProjectProblemReport projectProblem =
18441811 "Try changing to a different module name in one of them!"
18451812 ]
18461813
1847− BP_RootNameInvalid givenPath srcDir _ ->
1814+ BP_MainNameInvalid givenPath srcDir pathSegments ->
18481815 Help.report "UNEXPECTED FILE NAME" Nothing
18491816 "I am having trouble with this file name:"
18501817 [ D.indent 4 $ D.red $ D.fromChars givenPath
@@ -1968,7 +1935,7 @@ toGenerateReport problem =
19681935 "The issue is that --optimize strips out info needed by `Debug` functions.\
19691936 \ Here are two examples:"
19701937 , D.indent 4 $ D.reflow $
1971− "(1) It shortens record field names. This makes the generated JavaScript\
1938+ "(1) It shortens record field names. This makes the generated JavaScript is\
19721939 \ smaller, but `Debug.toString` cannot know the real field names anymore."
19731940 , D.indent 4 $ D.reflow $
19741941 "(2) Values like `type Height = Height Float` are unboxed. This reduces\
@@ -2037,7 +2004,7 @@ reactorToReport problem =
20372004data Repl
20382005 = ReplBadDetails Details
20392006 | ReplBadInput BS.ByteString Error.Error
2040− | ReplBadLocalDeps FilePath Error.Module [Error.Module]
2007+ | ReplBadLocalDeps Error.Module [Error.Module]
20412008 | ReplProjectProblem BuildProjectProblem
20422009 | ReplBadGenerate Generate
20432010 | ReplBadCache
@@ -2051,10 +2018,10 @@ replToReport problem =
20512018 toDetailsReport details
20522019
20532020 ReplBadInput source err ->
2054− Help.compilerReport "/" (Error.Module N.replModule "REPL" File.zeroTime source err) []
2021+ Help.compilerReport (Error.Module N.replModule "REPL" File.zeroTime source err) []
20552022
2056− ReplBadLocalDeps root e es ->
2057− Help.compilerReport root e es
2023+ ReplBadLocalDeps e es ->
2024+ Help.compilerReport e es
20582025
20592026 ReplProjectProblem projectProblem ->
20602027 toProjectProblemReport projectProblem
@@ -2067,3 +2034,39 @@ replToReport problem =
20672034
20682035 ReplBlocked ->
20692036 corruptCacheReport
2037+
2038+
2039+
2040+-- WORKER
2041+
2042+
2043+data Worker
2044+ = WorkerInputError Error.Module
2045+ | WorkerNoMain
2046+
2047+
2048+workerToReport :: Worker -> Help.Report
2049+workerToReport problem =
2050+ case problem of
2051+ WorkerInputError err ->
2052+ Help.compilerReport err []
2053+
2054+ WorkerNoMain ->
2055+ Help.report "NO MAIN" Nothing
2056+ (
2057+ "Without a `main` value, I do not know what to show on screen!"
2058+ )
2059+ [ D.reflow $
2060+ "Adding a `main` value can be as brief as:"
2061+ , D.vcat
2062+ [ D.fillSep [D.cyan "import","Html"]
2063+ , ""
2064+ , D.fillSep [D.green "main","="]
2065+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
2066+ ]
2067+ , D.reflow $
2068+ "Try adding something like that!"
2069+ , D.toSimpleNote $
2070+ "I recommend looking through https://guide.elm-lang.org for more advice on\
2071+ \ how to fill in `main` values."
2072+ ]
builder/src/Reporting/Exit/Help.hs+5−5
@@ -29,7 +29,7 @@ import qualified Reporting.Error as Error
2929
3030
3131data Report
32− = CompilerReport FilePath Error.Module [Error.Module]
32+ = CompilerReport Error.Module [Error.Module]
3333 | Report
3434 { _title :: String
3535 , _path :: Maybe FilePath
@@ -52,7 +52,7 @@ jsonReport =
5252 Report
5353
5454
55−compilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report
55+compilerReport :: 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 root e es ->
68− Error.toDoc root e es
67+ CompilerReport e es ->
68+ Error.toDoc 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+10−3
@@ -10,6 +10,7 @@ module Stuff
1010 , findRoot
1111 , withRootLock
1212 , withRegistryLock
13+ , withPackageLock
1314 , PackageCache
1415 , getPackageCache
1516 , registry
@@ -127,9 +128,15 @@ withRootLock root work =
127128 Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)
128129
129130
130−withRegistryLock :: PackageCache -> IO a -> IO a
131−withRegistryLock (PackageCache dir) work =
132− Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)
131+withRegistryLock :: (PackageCache -> IO a) -> IO a
132+withRegistryLock callback =
133+ do cache@(PackageCache dir) <- getPackageCache
134+ Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> callback cache)
135+
136+
137+withPackageLock :: PackageCache -> Pkg.Name -> V.Version -> IO a -> IO a
138+withPackageLock cache pkg vsn work =
139+ Lock.withFileLock (package cache pkg vsn </> "lock") Lock.Exclusive (\_ -> work)
133140
134141
135142
compiler/src/AST/Canonical.hs+2−2
@@ -342,7 +342,7 @@ instance Binary CtorOpts where
342342 0 -> return Normal
343343 1 -> return Enum
344344 2 -> return Unbox
345− _ -> fail "binary encoding of CtorOpts was corrupted"
345+ _ -> error "binary encoding of CtorOpts was corrupted"
346346
347347
348348instance Binary Annotation where
@@ -393,7 +393,7 @@ instance Binary AliasType where
393393 case n of
394394 0 -> liftM Holey get
395395 1 -> liftM Filled get
396− _ -> fail "binary encoding of AliasType was corrupted"
396+ _ -> error "binary encoding of AliasType was corrupted"
397397
398398
399399instance Binary FieldType where
compiler/src/AST/Optimized.hs+8−8
@@ -308,7 +308,7 @@ instance Binary Expr where
308308 24 -> pure Unit
309309 25 -> liftM3 Tuple get get get
310310 26 -> liftM3 Shader get get get
311− _ -> fail "problem getting Opt.Expr binary"
311+ _ -> error "problem getting Opt.Expr binary"
312312
313313
314314instance Binary Def where
@@ -322,7 +322,7 @@ instance Binary Def where
322322 case word of
323323 0 -> liftM2 Def get get
324324 1 -> liftM3 TailDef get get get
325− _ -> fail "problem getting Opt.Def binary"
325+ _ -> error "problem getting Opt.Def binary"
326326
327327
328328instance Binary Destructor where
@@ -345,7 +345,7 @@ instance Binary Path where
345345 1 -> liftM2 Field get get
346346 2 -> liftM Unbox get
347347 3 -> liftM Root get
348− _ -> fail "problem getting Opt.Path binary"
348+ _ -> error "problem getting Opt.Path binary"
349349
350350
351351instance (Binary a) => Binary (Decider a) where
@@ -361,7 +361,7 @@ instance (Binary a) => Binary (Decider a) where
361361 0 -> liftM Leaf get
362362 1 -> liftM3 Chain get get get
363363 2 -> liftM3 FanOut get get get
364− _ -> fail "problem getting Opt.Decider binary"
364+ _ -> error "problem getting Opt.Decider binary"
365365
366366
367367instance Binary Choice where
@@ -375,7 +375,7 @@ instance Binary Choice where
375375 case word of
376376 0 -> liftM Inline get
377377 1 -> liftM Jump get
378− _ -> fail "problem getting Opt.Choice binary"
378+ _ -> error "problem getting Opt.Choice binary"
379379
380380
381381
@@ -400,7 +400,7 @@ instance Binary Main where
400400 case word of
401401 0 -> return Static
402402 1 -> liftM2 Dynamic get get
403− _ -> fail "problem getting Opt.Main binary"
403+ _ -> error "problem getting Opt.Main binary"
404404
405405
406406instance Binary Node where
@@ -432,7 +432,7 @@ instance Binary Node where
432432 8 -> liftM2 Kernel get get
433433 9 -> liftM2 PortIncoming get get
434434 10 -> liftM2 PortOutgoing get get
435− _ -> fail "problem getting Opt.Node binary"
435+ _ -> error "problem getting Opt.Node binary"
436436
437437
438438instance Binary EffectsType where
@@ -448,4 +448,4 @@ instance Binary EffectsType where
448448 0 -> return Cmd
449449 1 -> return Sub
450450 2 -> return Fx
451− _ -> fail "problem getting Opt.EffectsType binary"
451+ _ -> error "problem getting Opt.EffectsType binary"
compiler/src/AST/Source.hs+5−5
@@ -195,15 +195,15 @@ newtype Comment =
195195
196196data Exposing
197197 = Open
198− | Explicit [Exposed]
198+ | Explicit [A.Located Exposed]
199199
200200
201201data Exposed
202− = Lower (A.Located Name)
203− | Upper (A.Located Name) Privacy
204− | Operator A.Region Name
202+ = Lower Name
203+ | Upper Name Privacy
204+ | Operator Name
205205
206206
207207data Privacy
208− = Public A.Region
208+ = Public
209209 | Private
compiler/src/AST/Utils/Binop.hs+6−5
@@ -41,11 +41,12 @@ instance Binary Precedence where
4141instance Binary Associativity where
4242 get =
4343 do n <- getWord8
44− case n of
45− 0 -> return Left
46− 1 -> return Non
47− 2 -> return Right
48− _ -> fail "Error reading valid associativity from serialized string"
44+ return $
45+ case n of
46+ 0 -> Left
47+ 1 -> Non
48+ 2 -> Right
49+ _ -> error "Error reading valid associativity from serialized string"
4950
5051 put assoc =
5152 putWord8 $
compiler/src/AST/Utils/Shader.hs−2
@@ -74,11 +74,9 @@ escape chars =
7474 []
7575
7676 c:cs
77− | c == '\r' -> escape cs
7877 | c == '\n' -> '\\' : 'n' : escape cs
7978 | c == '\"' -> '\\' : '"' : escape cs
8079 | c == '\'' -> '\\' : '\'' : escape cs
81− | c == '\\' -> '\\' : '\\' : escape cs
8280 | otherwise -> c : escape cs
8381
8482
compiler/src/AST/Utils/Type.hs+1
@@ -1,4 +1,5 @@
11{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
23module AST.Utils.Type
34 ( delambda
45 , dealias
compiler/src/Canonicalize/Environment.hs+20−50
@@ -4,8 +4,6 @@ module Canonicalize.Environment
44 ( Env(..)
55 , Exposed
66 , Qualified
7− , Info(..)
8− , mergeInfo
97 , Var(..)
108 , Type(..)
119 , Ctor(..)
@@ -22,8 +20,8 @@ module Canonicalize.Environment
2220
2321import qualified Data.Map.Merge.Strict as Map
2422import qualified Data.Map.Strict as Map
23+import qualified Data.Map.Strict.Internal as I
2524import qualified Data.Name as Name
26−import qualified Data.OneOrMore as OneOrMore
2725
2826import qualified AST.Utils.Binop as Binop
2927import qualified AST.Canonical as Can
@@ -60,34 +58,11 @@ data Env =
6058
6159
6260type Exposed a =
63− Map.Map Name.Name (Info a)
61+ Map.Map Name.Name (Map.Map ModuleName.Canonical a)
6462
6563
6664type Qualified 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))
65+ Map.Map Name.Name (Map.Map Name.Name (Map.Map ModuleName.Canonical a))
9166
9267
9368
@@ -97,8 +72,7 @@ mergeInfo info1 info2 =
9772data Var
9873 = Local A.Region
9974 | TopLevel A.Region
100− | Foreign ModuleName.Canonical Can.Annotation
101− | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
75+ | Foreign (Map.Map ModuleName.Canonical Can.Annotation)
10276
10377
10478
@@ -165,10 +139,7 @@ addLocalLeft _ region =
165139addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
166140addLocalBoth name region var =
167141 case var of
168− Foreign _ _ ->
169− Result.ok (Local region)
170−
171− Foreigns _ _ ->
142+ Foreign _ ->
172143 Result.ok (Local region)
173144
174145 Local parentRegion ->
@@ -179,18 +150,17 @@ addLocalBoth name region var =
179150
180151
181152
182−
183153-- FIND TYPE
184154
185155
186156findType :: A.Region -> Env -> Name.Name -> Result i w Type
187157findType region (Env _ _ ts _ _ _ qts _) name =
188158 case Map.lookup name ts of
189− Just (Specific _ tipe) ->
159+ Just (I.Bin 1 _ tipe _ _) ->
190160 Result.ok tipe
191161
192− Just (Ambiguous h hs) ->
193− Result.throw (Error.AmbiguousType region Nothing name h hs)
162+ Just homes ->
163+ Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))
194164
195165 Nothing ->
196166 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
@@ -201,11 +171,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
201171 case Map.lookup prefix qts of
202172 Just qualified ->
203173 case Map.lookup name qualified of
204− Just (Specific _ tipe) ->
174+ Just (I.Bin 1 _ tipe _ _) ->
205175 Result.ok tipe
206176
207− Just (Ambiguous h hs) ->
208− Result.throw (Error.AmbiguousType region (Just prefix) name h hs)
177+ Just homes ->
178+ Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))
209179
210180 Nothing ->
211181 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
@@ -221,11 +191,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
221191findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
222192findCtor region (Env _ _ _ cs _ _ _ qcs) name =
223193 case Map.lookup name cs of
224− Just (Specific _ ctor) ->
194+ Just (I.Bin 1 _ ctor _ _) ->
225195 Result.ok ctor
226196
227− Just (Ambiguous h hs) ->
228− Result.throw (Error.AmbiguousVariant region Nothing name h hs)
197+ Just homes ->
198+ Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))
229199
230200 Nothing ->
231201 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
@@ -236,11 +206,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
236206 case Map.lookup prefix qcs of
237207 Just qualified ->
238208 case Map.lookup name qualified of
239− Just (Specific _ pattern) ->
209+ Just (I.Bin 1 _ pattern _ _) ->
240210 Result.ok pattern
241211
242− Just (Ambiguous h hs) ->
243− Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)
212+ Just homes ->
213+ Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))
244214
245215 Nothing ->
246216 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
@@ -256,11 +226,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
256226findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
257227findBinop region (Env _ _ _ _ binops _ _ _) name =
258228 case Map.lookup name binops of
259− Just (Specific _ binop) ->
229+ Just (I.Bin 1 _ binop _ _) ->
260230 Result.ok binop
261231
262− Just (Ambiguous h hs) ->
263− Result.throw (Error.AmbiguousBinop region name h hs)
232+ Just homes ->
233+ Result.throw (Error.AmbiguousBinop region name (Map.keys homes))
264234
265235 Nothing ->
266236 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 (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict
108+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict
109109
110110
111111union :: Dict a -> Dict a -> Dict a
compiler/src/Canonicalize/Environment/Foreign.hs+37−49
@@ -35,14 +35,7 @@ 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 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
38+ Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)
4639
4740
4841
@@ -68,7 +61,7 @@ emptyState =
6861
6962emptyTypes :: Env.Exposed Env.Type
7063emptyTypes =
71− Map.singleton "List" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))
64+ Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))
7265
7366
7467
@@ -109,8 +102,8 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
109102 (Map.mapMaybeWithKey (unionToType home) unions)
110103 (Map.mapMaybeWithKey (aliasToType home) aliases)
111104
112− !vars = Map.map (Env.Specific home) defs
113− !types = Map.map (Env.Specific home . fst) rawTypeInfo
105+ !vars = Map.map (Map.singleton home) defs
106+ !types = Map.map (Map.singleton home . fst) rawTypeInfo
114107 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
115108
116109 !qvs2 = addQualified prefix vars qvs
@@ -136,7 +129,7 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
136129
137130addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
138131addExposed =
139− Map.unionWith Env.mergeInfo
132+ Map.unionWith Map.union
140133
141134
142135addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
@@ -157,7 +150,7 @@ unionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type,
157150unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
158151 let
159152 addCtor dict (Can.Ctor ctor index _ args) =
160− Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict
153+ Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict
161154 in
162155 ( Env.Union (length vars) home
163156 , List.foldl' addCtor Map.empty ctors
@@ -188,7 +181,7 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
188181 (Can.TAlias home name avars (Can.Filled tipe))
189182 (Can.fieldsToList fields)
190183 in
191− Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))
184+ Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))
192185
193186 _ ->
194187 Map.empty
@@ -199,9 +192,9 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
199192-- BINOP
200193
201194
202−binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop
195+binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop
203196binopToBinop home op (I.Binop name annotation associativity precedence) =
204− Env.Specific home (Env.Binop op home name annotation associativity precedence)
197+ Map.singleton home (Env.Binop op home name annotation associativity precedence)
205198
206199
207200
@@ -214,19 +207,19 @@ addExposedValue
214207 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)
215208 -> Map.Map Name.Name I.Binop
216209 -> State
217− -> Src.Exposed
210+ -> A.Located Src.Exposed
218211 -> Result i w State
219−addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
212+addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At region exposed) =
220213 case exposed of
221− Src.Lower (A.At region name) ->
214+ Src.Lower name ->
222215 case Map.lookup name vars of
223216 Just info ->
224− Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)
217+ Result.ok (State (Map.insertWith Map.union name info vs) ts cs bs qvs qts qcs)
225218
226219 Nothing ->
227220 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
228221
229− Src.Upper (A.At region name) privacy ->
222+ Src.Upper name privacy ->
230223 case privacy of
231224 Src.Private ->
232225 case Map.lookup name types of
@@ -234,43 +227,43 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
234227 case tipe of
235228 Env.Union _ _ ->
236229 let
237− !ts2 = Map.insert name (Env.Specific home tipe) ts
230+ !ts2 = Map.insert name (Map.singleton home tipe) ts
238231 in
239232 Result.ok (State vs ts2 cs bs qvs qts qcs)
240233
241234 Env.Alias _ _ _ _ ->
242235 let
243− !ts2 = Map.insert name (Env.Specific home tipe) ts
236+ !ts2 = Map.insert name (Map.singleton home tipe) ts
244237 !cs2 = addExposed cs ctors
245238 in
246239 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
247240
248241 Nothing ->
249− case checkForCtorMistake name types of
250− tipe:_ ->
242+ case Map.lookup name (toCtors types) of
243+ Just tipe ->
251244 Result.throw $ Error.ImportCtorByName region name tipe
252245
253− [] ->
246+ Nothing ->
254247 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
255248
256− Src.Public dotDotRegion ->
249+ Src.Public ->
257250 case Map.lookup name types of
258251 Just (tipe, ctors) ->
259252 case tipe of
260253 Env.Union _ _ ->
261254 let
262− !ts2 = Map.insert name (Env.Specific home tipe) ts
255+ !ts2 = Map.insert name (Map.singleton home tipe) ts
263256 !cs2 = addExposed cs ctors
264257 in
265258 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
266259
267260 Env.Alias _ _ _ _ ->
268− Result.throw (Error.ImportOpenAlias dotDotRegion name)
261+ Result.throw (Error.ImportOpenAlias region name)
269262
270263 Nothing ->
271264 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))
272265
273− Src.Operator region op ->
266+ Src.Operator op ->
274267 case Map.lookup op binops of
275268 Just binop ->
276269 let
@@ -282,23 +275,18 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
282275 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
283276
284277
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
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
288282 where
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
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
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 = Env.Specific home (Env.Union arity home)
113+ let one = Map.singleton 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 = Env.Specific home (Env.Alias (length args) home args ctype)
136+ let one = Map.singleton 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 (Env.Info Env.Ctor)
284+type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical 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 (Env.Specific home (toRecordCtor home name vars fields))
300+ Dups.one name region (Map.singleton 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 $ Env.Specific home $
354+ Dups.one name region $ Map.singleton home $
355355 Env.Ctor home typeName union index args
compiler/src/Canonicalize/Expression.hs+7−6
@@ -14,6 +14,7 @@ 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
1718import qualified Data.Name as Name
1819
1920import qualified AST.Canonical as Can
@@ -695,15 +696,15 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =
695696 Env.TopLevel _ ->
696697 logVar name (Can.VarTopLevel localHome name)
697698
698− Env.Foreign home annotation ->
699+ Env.Foreign (I.Bin 1 home annotation _ _) ->
699700 Result.ok $
700701 if home == ModuleName.debug then
701702 Can.VarDebug localHome name annotation
702703 else
703704 Can.VarForeign home name annotation
704705
705− Env.Foreigns h hs ->
706− Result.throw (Error.AmbiguousVar region Nothing name h hs)
706+ Env.Foreign homes ->
707+ Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))
707708
708709 Nothing ->
709710 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
@@ -714,15 +715,15 @@ findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =
714715 case Map.lookup prefix qvs of
715716 Just qualified ->
716717 case Map.lookup name qualified of
717− Just (Env.Specific home annotation) ->
718+ Just (I.Bin 1 home annotation _ _) ->
718719 Result.ok $
719720 if home == ModuleName.debug then
720721 Can.VarDebug localHome name annotation
721722 else
722723 Can.VarForeign home name annotation
723724
724− Just (Env.Ambiguous h hs) ->
725− Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)
725+ Just homes ->
726+ Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))
726727
727728 Nothing ->
728729 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− -> Src.Exposed
239+ -> A.Located Src.Exposed
240240 -> Result i w (Dups.Dict (A.Located Can.Export))
241−checkExposed values unions aliases binops effects exposed =
241+checkExposed values unions aliases binops effects (A.At region exposed) =
242242 case exposed of
243− Src.Lower (A.At region name) ->
243+ Src.Lower 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 exposed =
252252 Result.throw $ Error.ExportNotFound region Error.BadVar name $
253253 ports ++ Map.keys values
254254
255− Src.Operator region name ->
255+ Src.Operator 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 (A.At region name) (Src.Public dotDotRegion) ->
262+ Src.Upper name Src.Public ->
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 dotDotRegion name
266+ Result.throw $ Error.ExportOpenAlias region name
267267 else
268268 Result.throw $ Error.ExportNotFound region Error.BadType name $
269269 Map.keys unions ++ Map.keys aliases
270270
271− Src.Upper (A.At region name) Src.Private ->
271+ Src.Upper 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+2−3
@@ -8,7 +8,6 @@ module Canonicalize.Pattern
88 where
99
1010
11−import qualified Data.List as List
1211import qualified Data.Map.Strict as Map
1312import qualified Data.Name as Name
1413
@@ -174,8 +173,8 @@ logVar name region value =
174173logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a
175174logFields fields value =
176175 let
177− addField dict (A.At region name) =
176+ addField (A.At region name) dict =
178177 Dups.insert name region region dict
179178 in
180179 Result.Result $ \bindings warnings _ ok ->
181− ok (List.foldl' addField bindings fields) warnings value
180+ ok (foldr addField bindings fields) warnings value
compiler/src/Data/Name.hs+43−53
@@ -202,11 +202,11 @@ fromVarIndex :: Int -> Name
202202fromVarIndex n =
203203 runST
204204 (
205− do let !size = 2 + getIndexSize n
205+ do let !size = getIndexSize n
206206 mba <- newByteArray size
207207 writeWord8 mba 0 0x5F {- _ -}
208208 writeWord8 mba 1 0x76 {- v -}
209− writeDigitsAtEnd mba size n
209+ writeDigits mba (size - 1) n
210210 freeze mba
211211 )
212212
@@ -214,20 +214,19 @@ fromVarIndex n =
214214{-# INLINE getIndexSize #-}
215215getIndexSize :: Int -> Int
216216getIndexSize n
217− | n < 10 = 1
218− | n < 100 = 2
219− | True = ceiling (logBase 10 (fromIntegral n + 1) :: Float)
217+ | n < 10 = 3
218+ | n < 100 = 4
219+ | True = 2 + ceiling (logBase 10 (fromIntegral n + 1) :: Float)
220220
221221
222222
223−writeDigitsAtEnd :: MBA s -> Int -> Int -> ST s ()
224−writeDigitsAtEnd !mba !oldOffset !n =
223+writeDigits :: MBA s -> Int -> Int -> ST s ()
224+writeDigits !mba !offset !n =
225225 do let (q,r) = quotRem n 10
226− let !newOffset = oldOffset - 1
227− writeWord8 mba newOffset (0x30 + fromIntegral r)
226+ writeWord8 mba offset (0x30 + fromIntegral r)
228227 if q <= 0
229228 then return ()
230− else writeDigitsAtEnd mba newOffset q
229+ else writeDigits mba (offset-1) q
231230
232231
233232
@@ -250,7 +249,7 @@ fromTypeVariable name@(Utf8.Utf8 ba#) index =
250249 mba <- newByteArray size
251250 copyToMBA name mba
252251 writeWord8 mba (I# len#) 0x5F {- _ -}
253− writeDigitsAtEnd mba size index
252+ writeDigits mba (size - 1) index
254253 freeze mba
255254 )
256255 else
@@ -259,7 +258,7 @@ fromTypeVariable name@(Utf8.Utf8 ba#) index =
259258 do let !size = I# len# + getIndexSize index
260259 mba <- newByteArray size
261260 copyToMBA name mba
262− writeDigitsAtEnd mba size index
261+ writeDigits mba (size - 1) index
263262 freeze mba
264263 )
265264
@@ -278,61 +277,52 @@ fromTypeVariableScheme scheme =
278277 freeze mba
279278 else
280279 do let (extra, letter) = quotRem scheme 26
281− let !size = 1 + getIndexSize extra
280+ let !size = getIndexSize extra
282281 mba <- newByteArray size
283282 writeWord8 mba 0 (0x61 + fromIntegral letter)
284− writeDigitsAtEnd mba size extra
283+ writeDigits mba (size - 1) extra
285284 freeze mba
286285 )
287286
288287
289288
290289-- FROM MANY NAMES
291−--
292−-- Creating a unique name by combining all the subnames can create names
293−-- longer than 256 bytes relatively easily. So instead, the first given name
294−-- (e.g. foo) is prefixed chars that are valid in JS but not Elm (e.g. _M$foo)
295−--
296−-- This should be a unique name since 0.19 disallows shadowing. It would not
297−-- be possible for multiple top-level cycles to include values with the same
298−-- name, so the important thing is to make the cycle name distinct from the
299−-- normal name. Same logic for destructuring patterns like (x,y)
300290
301291
302292fromManyNames :: [Name] -> Name
303293fromManyNames names =
304− case names of
305− [] ->
306− blank
307− -- NOTE: this case is needed for (let _ = Debug.log "x" x in ...)
308− -- but maybe unused patterns should be stripped out instead
309−
310− Utf8.Utf8 ba# : _ ->
311− let
312− len# = sizeofByteArray# ba#
313− in
314− runST
315− (
316− ST $ \s ->
317− case newByteArray# (len# +# 3#) s of
318− (# s, mba# #) ->
319− case writeWord8Array# mba# 0# 0x5F## {-_-} s of
320− s ->
321− case writeWord8Array# mba# 1# 0x4D## {-M-} s of
322− s ->
323− case writeWord8Array# mba# 2# 0x24## {-$-} s of
324− s ->
325− case copyByteArray# ba# 0# mba# 3# len# s of
326− s ->
327− case unsafeFreezeByteArray# mba# s of
328− (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)
329− )
294+ let
295+ !(I# size#) = sum (map (\(Utf8.Utf8 ba#) -> I# (sizeofByteArray# ba# +# 1#)) names)
296+ in
297+ runST
298+ (
299+ ST $ \s ->
300+ case newByteArray# size# s of
301+ (# s, mba# #) ->
302+ case writeNames mba# 0# names s of
303+ s ->
304+ case unsafeFreezeByteArray# mba# s of
305+ (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)
306+ )
330307
331308
332−{-# NOINLINE blank #-}
333−blank :: Name
334−blank =
335− fromWords [0x5F,0x4D,0x24] {-_M$-}
309+writeNames :: MutableByteArray# s -> Int# -> [Name] -> State# s -> State# s
310+writeNames mba# !offset# names s =
311+ case names of
312+ [] ->
313+ s
314+
315+ (Utf8.Utf8 ba#) : names ->
316+ case writeWord8Array# mba# offset# 0x24## {- $ -} s of
317+ s ->
318+ let
319+ !offset1# = offset# +# 1#
320+ !len# = sizeofByteArray# ba#
321+ !newOffset# = offset1# +# len#
322+ in
323+ case copyByteArray# ba# 0# mba# offset1# len# s of
324+ s ->
325+ writeNames mba# newOffset# names s
336326
337327
338328
compiler/src/Data/Utf8.hs+1−3
@@ -261,9 +261,7 @@ instance Eq (Utf8 t) where
261261
262262
263263-- COMPARE
264−--
265−-- TODO: is it fine to sort by length and only compare bytes on length ties?
266−--
264+
267265
268266instance Ord (Utf8 t) where
269267 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 [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]
52+ Src.Explicit [ A.At A.zero (Src.Upper name Src.Public) ]
5353
5454
5555typeClosed :: Name.Name -> Src.Exposing
5656typeClosed name =
57− Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]
57+ Src.Explicit [ A.At A.zero (Src.Upper name Src.Private) ]
5858
5959
6060operator :: Name.Name -> Src.Exposing
6161operator op =
62− Src.Explicit [ Src.Operator A.zero op ]
62+ Src.Explicit [ A.At A.zero (Src.Operator op) ]
compiler/src/Elm/Constraint.hs+1−1
@@ -216,7 +216,7 @@ instance Binary Op where
216216 case n of
217217 0 -> return Less
218218 1 -> return LessOrEqual
219− _ -> fail "binary encoding of Op was corrupted"
219+ _ -> error "binary encoding of Op was corrupted"
220220
221221
222222
compiler/src/Elm/Interface.hs+3−3
@@ -215,7 +215,7 @@ instance Binary Union where
215215 0 -> liftM OpenUnion get
216216 1 -> liftM ClosedUnion get
217217 2 -> liftM PrivateUnion get
218− _ -> fail "binary encoding of Union was corrupted"
218+ _ -> error "binary encoding of Union was corrupted"
219219
220220
221221instance Binary Alias where
@@ -229,7 +229,7 @@ instance Binary Alias where
229229 case n of
230230 0 -> liftM PublicAlias get
231231 1 -> liftM PrivateAlias get
232− _ -> fail "binary encoding of Alias was corrupted"
232+ _ -> error "binary encoding of Alias was corrupted"
233233
234234
235235instance Binary Binop where
@@ -251,4 +251,4 @@ instance Binary DependencyInterface where
251251 case n of
252252 0 -> liftM Public get
253253 1 -> liftM3 Private get get get
254− _ -> fail "binary encoding of DependencyInterface was corrupted"
254+ _ -> error "binary encoding of DependencyInterface was corrupted"
compiler/src/Elm/Kernel.hs+9−9
@@ -15,7 +15,7 @@ import qualified Data.ByteString.Internal as B
1515import qualified Data.List as List
1616import qualified Data.Map as Map
1717import qualified Data.Name as Name
18−import Data.Word (Word8)
18+import Data.Word (Word8, Word16)
1919import Foreign.Ptr (Ptr, plusPtr, minusPtr)
2020import Foreign.ForeignPtr (ForeignPtr)
2121import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
@@ -128,7 +128,7 @@ parseChunks vtable enums fields =
128128 cerr row col toError
129129
130130
131−chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)
131+chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
132132chompChunks vs es fs src pos end row col lastPos revChunks =
133133 if pos >= end then
134134 let !js = toByteString src lastPos end in
@@ -168,7 +168,7 @@ toByteString src pos end =
168168
169169
170170-- relies on external checks in chompChunks
171−chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)
171+chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
172172chompTag vs es fs src pos end row col revChunks =
173173 let
174174 (# newPos, newCol #) = Var.chompInnerChars pos end col
@@ -319,19 +319,19 @@ toNames exposing =
319319 map toName exposedList
320320
321321
322−toName :: Src.Exposed -> Name.Name
323−toName exposed =
322+toName :: A.Located Src.Exposed -> Name.Name
323+toName (A.At _ exposed) =
324324 case exposed of
325− Src.Lower (A.At _ name) ->
325+ Src.Lower name ->
326326 name
327327
328− Src.Upper (A.At _ name) Src.Private ->
328+ Src.Upper 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/Licenses.hs+25−25
@@ -83,61 +83,63 @@ check givenCode =
8383osiApprovedSpdxLicenses :: Map.Map Json.String [Char]
8484osiApprovedSpdxLicenses =
8585 Map.fromList
86− [ "0BSD" ==> "BSD Zero Clause License"
87− , "AAL" ==> "Attribution Assurance License"
88− , "AFL-1.1" ==> "Academic Free License v1.1"
86+ [ "AFL-1.1" ==> "Academic Free License v1.1"
8987 , "AFL-1.2" ==> "Academic Free License v1.2"
9088 , "AFL-2.0" ==> "Academic Free License v2.0"
9189 , "AFL-2.1" ==> "Academic Free License v2.1"
9290 , "AFL-3.0" ==> "Academic Free License v3.0"
93− , "AGPL-3.0" ==> "GNU Affero General Public License v3.0"
91+ , "APL-1.0" ==> "Adaptive Public License 1.0"
9492 , "Apache-1.1" ==> "Apache License 1.1"
9593 , "Apache-2.0" ==> "Apache License 2.0"
96− , "APL-1.0" ==> "Adaptive Public License 1.0"
9794 , "APSL-1.0" ==> "Apple Public Source License 1.0"
9895 , "APSL-1.1" ==> "Apple Public Source License 1.1"
9996 , "APSL-1.2" ==> "Apple Public Source License 1.2"
10097 , "APSL-2.0" ==> "Apple Public Source License 2.0"
10198 , "Artistic-1.0" ==> "Artistic License 1.0"
102− , "Artistic-1.0-cl8" ==> "Artistic License 1.0 w/clause 8"
10399 , "Artistic-1.0-Perl" ==> "Artistic License 1.0 (Perl)"
100+ , "Artistic-1.0-cl8" ==> "Artistic License 1.0 w/clause 8"
104101 , "Artistic-2.0" ==> "Artistic License 2.0"
102+ , "AAL" ==> "Attribution Assurance License"
103+ , "BSL-1.0" ==> "Boost Software License 1.0"
105104 , "BSD-2-Clause" ==> "BSD 2-clause \"Simplified\" License"
106105 , "BSD-3-Clause" ==> "BSD 3-clause \"New\" or \"Revised\" License"
107− , "BSL-1.0" ==> "Boost Software License 1.0"
108− , "CATOSL-1.1" ==> "Computer Associates Trusted Open Source License 1.1"
109− , "CDDL-1.0" ==> "Common Development and Distribution License 1.0"
106+ , "0BSD" ==> "BSD Zero Clause License"
110107 , "CECILL-2.1" ==> "CeCILL Free Software License Agreement v2.1"
111108 , "CNRI-Python" ==> "CNRI Python License"
109+ , "CDDL-1.0" ==> "Common Development and Distribution License 1.0"
112110 , "CPAL-1.0" ==> "Common Public Attribution License 1.0"
113111 , "CPL-1.0" ==> "Common Public License 1.0"
112+ , "CATOSL-1.1" ==> "Computer Associates Trusted Open Source License 1.1"
114113 , "CUA-OPL-1.0" ==> "CUA Office Public License v1.0"
114+ , "EPL-1.0" ==> "Eclipse Public License 1.0"
115115 , "ECL-1.0" ==> "Educational Community License v1.0"
116116 , "ECL-2.0" ==> "Educational Community License v2.0"
117117 , "EFL-1.0" ==> "Eiffel Forum License v1.0"
118118 , "EFL-2.0" ==> "Eiffel Forum License v2.0"
119119 , "Entessa" ==> "Entessa Public License v1.0"
120− , "EPL-1.0" ==> "Eclipse Public License 1.0"
121120 , "EUDatagrid" ==> "EU DataGrid Software License"
122121 , "EUPL-1.1" ==> "European Union Public License 1.1"
123122 , "Fair" ==> "Fair License"
124123 , "Frameworx-1.0" ==> "Frameworx Open License 1.0"
124+ , "AGPL-3.0" ==> "GNU Affero General Public License v3.0"
125125 , "GPL-2.0" ==> "GNU General Public License v2.0 only"
126126 , "GPL-3.0" ==> "GNU General Public License v3.0 only"
127+ , "LGPL-2.1" ==> "GNU Lesser General Public License v2.1 only"
128+ , "LGPL-3.0" ==> "GNU Lesser General Public License v3.0 only"
129+ , "LGPL-2.0" ==> "GNU Library General Public License v2 only"
127130 , "HPND" ==> "Historic Permission Notice and Disclaimer"
131+ , "IPL-1.0" ==> "IBM Public License v1.0"
128132 , "Intel" ==> "Intel Open Source License"
129133 , "IPA" ==> "IPA Font License"
130− , "IPL-1.0" ==> "IBM Public License v1.0"
131134 , "ISC" ==> "ISC License"
132− , "LGPL-2.0" ==> "GNU Library General Public License v2 only"
133− , "LGPL-2.1" ==> "GNU Lesser General Public License v2.1 only"
134− , "LGPL-3.0" ==> "GNU Lesser General Public License v3.0 only"
135+ , "LPPL-1.3c" ==> "LaTeX Project Public License v1.3c"
135136 , "LiLiQ-P-1.1" ==> "Licence Libre du Québec – Permissive version 1.1"
136− , "LiLiQ-R-1.1" ==> "Licence Libre du Québec – Réciprocité version 1.1"
137137 , "LiLiQ-Rplus-1.1" ==> "Licence Libre du Québec – Réciprocité forte version 1.1"
138− , "LPL-1.0" ==> "Lucent Public License Version 1.0"
138+ , "LiLiQ-R-1.1" ==> "Licence Libre du Québec – Réciprocité version 1.1"
139139 , "LPL-1.02" ==> "Lucent Public License v1.02"
140− , "LPPL-1.3c" ==> "LaTeX Project Public License v1.3c"
140+ , "LPL-1.0" ==> "Lucent Public License Version 1.0"
141+ , "MS-PL" ==> "Microsoft Public License"
142+ , "MS-RL" ==> "Microsoft Reciprocal License"
141143 , "MirOS" ==> "MirOS Licence"
142144 , "MIT" ==> "MIT License"
143145 , "Motosoto" ==> "Motosoto License"
@@ -145,40 +147,38 @@ osiApprovedSpdxLicenses =
145147 , "MPL-1.1" ==> "Mozilla Public License 1.1"
146148 , "MPL-2.0" ==> "Mozilla Public License 2.0"
147149 , "MPL-2.0-no-copyleft-exception" ==> "Mozilla Public License 2.0 (no copyleft exception)"
148− , "MS-PL" ==> "Microsoft Public License"
149− , "MS-RL" ==> "Microsoft Reciprocal License"
150150 , "Multics" ==> "Multics License"
151151 , "NASA-1.3" ==> "NASA Open Source Agreement 1.3"
152152 , "Naumen" ==> "Naumen Public License"
153− , "NCSA" ==> "University of Illinois/NCSA Open Source License"
154153 , "NGPL" ==> "Nethack General Public License"
155154 , "Nokia" ==> "Nokia Open Source License"
156155 , "NPOSL-3.0" ==> "Non-Profit Open Software License 3.0"
157156 , "NTP" ==> "NTP License"
158157 , "OCLC-2.0" ==> "OCLC Research Public License 2.0"
159− , "OFL-1.1" ==> "SIL Open Font License 1.1"
160158 , "OGTSL" ==> "Open Group Test Suite License"
161− , "OSET-PL-2.1" ==> "OSET Public License version 2.1"
162159 , "OSL-1.0" ==> "Open Software License 1.0"
163160 , "OSL-2.0" ==> "Open Software License 2.0"
164161 , "OSL-2.1" ==> "Open Software License 2.1"
165162 , "OSL-3.0" ==> "Open Software License 3.0"
163+ , "OSET-PL-2.1" ==> "OSET Public License version 2.1"
166164 , "PHP-3.0" ==> "PHP License v3.0"
167165 , "PostgreSQL" ==> "PostgreSQL License"
168166 , "Python-2.0" ==> "Python License 2.0"
169167 , "QPL-1.0" ==> "Q Public License 1.0"
168+ , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"
170169 , "RPL-1.1" ==> "Reciprocal Public License 1.1"
171170 , "RPL-1.5" ==> "Reciprocal Public License 1.5"
172− , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"
173171 , "RSCPL" ==> "Ricoh Source Code Public License"
172+ , "OFL-1.1" ==> "SIL Open Font License 1.1"
174173 , "SimPL-2.0" ==> "Simple Public License 2.0"
175− , "SISSL" ==> "Sun Industry Standards Source License v1.1"
176174 , "Sleepycat" ==> "Sleepycat License"
175+ , "SISSL" ==> "Sun Industry Standards Source License v1.1"
177176 , "SPL-1.0" ==> "Sun Public License v1.0"
177+ , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"
178178 , "UPL-1.0" ==> "Universal Permissive License v1.0"
179+ , "NCSA" ==> "University of Illinois/NCSA Open Source License"
179180 , "VSL-1.0" ==> "Vovida Software License v1.0"
180181 , "W3C" ==> "W3C Software Notice and License (2002-12-31)"
181− , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"
182182 , "Xnet" ==> "X.Net License"
183183 , "Zlib" ==> "zlib License"
184184 , "ZPL-2.0" ==> "Zope Public License 2.0"
compiler/src/Elm/ModuleName.hs+6−2
@@ -7,13 +7,12 @@ module Elm.ModuleName
77 --
88 , encode
99 , decoder
10− , parser
1110 --
1211 , Canonical(..)
1312 , basics, char, string
1413 , maybe, result, list, array, dict, tuple
1514 , platform, cmd, sub
16− , debug
15+ , debug, bitwise
1716 , virtualDom
1817 , jsonDecode, jsonEncode
1918 , webgl, texture, vector2, vector3, vector4, matrix4
@@ -226,6 +225,11 @@ debug :: Canonical
226225debug = Canonical Pkg.core Name.debug
227226
228227
228+{-# NOINLINE bitwise #-}
229+bitwise :: Canonical
230+bitwise = Canonical Pkg.core Name.bitwise
231+
232+
229233
230234-- HTML
231235
compiler/src/Elm/Package.hs+8−1
@@ -58,7 +58,6 @@ data Name =
5858 { _author :: !Author
5959 , _project :: !Project
6060 }
61− deriving (Ord)
6261
6362
6463type Author = Utf8.Utf8 AUTHOR
@@ -268,6 +267,14 @@ instance Eq Canonical where
268267 version1 == version2 && package1 == package2
269268
270269
270+instance Ord Name where
271+ compare (Name author1 project1) (Name author2 project2) =
272+ case compare project1 project2 of
273+ LT -> LT
274+ EQ -> compare author1 author2
275+ GT -> GT
276+
277+
271278
272279-- BINARY
273280
compiler/src/Generate/Html.hs+10−11
@@ -29,23 +29,22 @@ sandwich moduleName javascript =
2929
3030<body>
3131
32−<pre id="elm"></pre>
32+<pre id="elm">
33+This is a headless program, meaning there is nothing to show here.
34+
35+I started the program anyway though!
36+
37+You can access it as `app` in the developer console.
38+</pre>
3339
3440<script>
35−try {
3641|] <> javascript <> [r|
3742
43+try {
3844 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
39−}
40−catch (e)
41−{
45+} catch (e) {
4246 // display initialization errors (e.g. bad flags, infinite recursion)
43− var header = document.createElement("h1");
44− header.style.fontFamily = "monospace";
45− header.innerText = "Initialization Error";
46− var pre = document.getElementById("elm");
47− document.body.insertBefore(header, pre);
48− pre.innerText = e;
47+ document.getElementById("elm").innerText = e;
4948 throw e;
5049}
5150</script>
compiler/src/Generate/JavaScript.hs+10−45
@@ -2,7 +2,6 @@
22module Generate.JavaScript
33 ( generate
44 , generateForRepl
5− , generateForReplEndpoint
65 )
76 where
87
@@ -86,8 +85,7 @@ generateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _
8685 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")
8786 evalState = addGlobal mode graph debugState (Opt.Global home name)
8887 in
89− "process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\n'); process.exit(1); });"
90− <> Functions.functions
88+ Functions.functions
9189 <> stateToBuilder evalState
9290 <> print ansi localizer home name tipe
9391
@@ -100,47 +98,14 @@ print ansi localizer home name tipe =
10098 tipeDoc = RT.canToDoc localizer RT.None tipe
10199 bool = if ansi then "true" else "false"
102100 in
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"
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"
144109
145110
146111
@@ -292,7 +257,7 @@ generateCycle mode (Opt.Global home _) names values functions =
292257 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"
293258 <> drawCycle names
294259 <> "\\n\\nThese errors are very tricky, so read "
295− <> B.stringUtf8 (D.makeNakedLink "bad-recursion")
260+ <> B.stringUtf8 (D.makeNakedLink "halting-problem")
296261 <> " to learn how to fix it!"
297262 ]
298263
compiler/src/Json/Decode.hs+3−3
@@ -32,7 +32,7 @@ module Json.Decode
3232import qualified Data.ByteString.Internal as B
3333import qualified Data.Map as Map
3434import qualified Data.NonEmptyList as NE
35−import Data.Word (Word8)
35+import Data.Word (Word8, Word16)
3636import Foreign.Ptr (Ptr, plusPtr, minusPtr)
3737import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
3838
@@ -630,7 +630,7 @@ data StringStatus
630630 | BadString StringProblem
631631
632632
633−pStringHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# StringStatus, Ptr Word8, Row, Col #)
633+pStringHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# StringStatus, Ptr Word8, Word16, Word16 #)
634634pStringHelp pos end row col =
635635 if pos >= end then
636636 (# BadString BadStringEnd, pos, row, col #)
@@ -708,7 +708,7 @@ spaces =
708708 cok () newState
709709
710710
711−eatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Ptr Word8, Row, Col #)
711+eatSpaces :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Ptr Word8, Word16, Word16 #)
712712eatSpaces pos end row col =
713713 if pos >= end then
714714 (# pos, row, col #)
compiler/src/Json/Encode.hs+2−3
@@ -109,17 +109,16 @@ chars chrs =
109109 String (B.char7 '"' <> B.stringUtf8 (escape chrs) <> B.char7 '"')
110110
111111
112−escape :: [Char] -> [Char]
112+escape :: [Char] -> [Char] -- TODO is this correct?
113113escape chrs =
114114 case chrs of
115115 [] ->
116116 []
117117
118118 c:cs
119− | c == '\r' -> '\\' : 'r' : escape cs
120119 | c == '\n' -> '\\' : 'n' : escape cs
121120 | c == '\"' -> '\\' : '"' : escape cs
122− | c == '\\' -> '\\' : '\\' : escape cs
121+ | c == '\'' -> '\\' : '\'' : escape cs
123122 | otherwise -> c : escape cs
124123
125124
compiler/src/Json/String.hs+1
@@ -116,6 +116,7 @@ chompChunks pos end start revChunks =
116116 case word of
117117 0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks
118118 0x22 {-"-} -> chompEscape 0x22 {-"-} pos end start revChunks
119+ 0x27 {-'-} -> chompEscape 0x27 {-'-} pos end start revChunks
119120 0x5C {-\-} -> chompEscape 0x5C {-\-} pos end start revChunks
120121 0x0D {-\r-} ->
121122 let
compiler/src/Optimize/DecisionTree.hs+2−2
@@ -618,7 +618,7 @@ instance Binary Test where
618618 5 -> liftM IsStr get
619619 6 -> liftM IsInt get
620620 7 -> liftM IsBool get
621− _ -> fail "problem getting DecisionTree.Test binary"
621+ _ -> error "problem getting DecisionTree.Test binary"
622622
623623
624624instance Binary Path where
@@ -634,4 +634,4 @@ instance Binary Path where
634634 0 -> liftM2 Index get get
635635 1 -> liftM Unbox get
636636 2 -> pure Empty
637− _ -> fail "problem getting DecisionTree.Path binary"
637+ _ -> error "problem getting DecisionTree.Path binary"
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 custom type"
61+ error "toEncoder: bad union type"
6262
6363 Can.TRecord _ (Just _) ->
6464 error "toEncoder: bad record"
compiler/src/Parse/Expression.hs+32−40
@@ -128,46 +128,38 @@ chompListEnd start entries =
128128tuple :: A.Position -> Parser E.Expr Src.Expr
129129tuple start@(A.Position row col) =
130130 inContext E.Tuple (word1 0x28 {-(-} E.Start) $
131− do before <- getPosition
132− Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr1
133− after <- getPosition
134− if before /= after
135− then
136− do (entry, end) <- specialize E.TupleExpr expression
137− Space.checkIndent end E.TupleIndentEnd
138− chompTupleEnd start entry []
139− else
140− oneOf E.TupleIndentExpr1
141− [
142− do op <- Symbol.operator E.TupleIndentExpr1 E.TupleOperatorReserved
143− if op == "-"
144− then
145− oneOf E.TupleOperatorClose
146− [
147− do word1 0x29 {-)-} E.TupleOperatorClose
148− addEnd start (Src.Op op)
149− ,
150− do (entry, end) <-
151− specialize E.TupleExpr $
152− do negatedExpr@(A.At (A.Region _ end) _) <- term
153− Space.chomp E.Space
154− let exprStart = A.Position row (col + 2)
155− let expr = A.at exprStart end (Src.Negate negatedExpr)
156− chompExprEnd exprStart (State [] expr [] end)
157− Space.checkIndent end E.TupleIndentEnd
158− chompTupleEnd start entry []
159− ]
160− else
161− do word1 0x29 {-)-} E.TupleOperatorClose
162− addEnd start (Src.Op op)
163− ,
164− do word1 0x29 {-)-} E.TupleIndentExpr1
165− addEnd start Src.Unit
166− ,
167− do (entry, end) <- specialize E.TupleExpr expression
168− Space.checkIndent end E.TupleIndentEnd
169− chompTupleEnd start entry []
170− ]
131+ oneOf E.TupleIndentExpr1
132+ [
133+ do op <- Symbol.operator E.TupleIndentExpr1 E.TupleOperatorReserved
134+ if op == "-"
135+ then
136+ oneOf E.TupleOperatorClose
137+ [
138+ do word1 0x29 {-)-} E.TupleOperatorClose
139+ addEnd start (Src.Op op)
140+ ,
141+ do (entry, end) <-
142+ specialize E.TupleExpr $
143+ do negatedExpr@(A.At (A.Region _ end) _) <- term
144+ Space.chomp E.Space
145+ let exprStart = A.Position row (col + 2)
146+ let expr = A.at exprStart end (Src.Negate negatedExpr)
147+ chompExprEnd exprStart (State [] expr [] end)
148+ Space.checkIndent end E.TupleIndentEnd
149+ chompTupleEnd start entry []
150+ ]
151+ else
152+ do word1 0x29 {-)-} E.TupleOperatorClose
153+ addEnd start (Src.Op op)
154+ ,
155+ do word1 0x29 {-)-} E.TupleIndentExpr1
156+ addEnd start Src.Unit
157+ ,
158+ do Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr1
159+ (entry, end) <- specialize E.TupleExpr expression
160+ Space.checkIndent end E.TupleIndentEnd
161+ chompTupleEnd start entry []
162+ ]
171163
172164
173165chompTupleEnd :: A.Position -> Src.Expr -> [Src.Expr] -> Parser E.Tuple Src.Expr
compiler/src/Parse/Module.hs+35−81
@@ -2,8 +2,6 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Parse.Module
44 ( fromByteString
5− , ProjectType(..)
6− , isKernel
75 , chompImports
86 , chompImport
97 )
@@ -31,37 +29,14 @@ import qualified Reporting.Error.Syntax as E
3129-- FROM BYTE STRING
3230
3331
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
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
3836 Left err -> Left (E.ParseError err)
3937
4038
4139
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−
6540-- MODULE
6641
6742
@@ -74,11 +49,11 @@ data Module =
7449 }
7550
7651
77−chompModule :: ProjectType -> Parser E.Module Module
78−chompModule projectType =
52+chompModule :: Pkg.Name -> Parser E.Module Module
53+chompModule pkg =
7954 do header <- chompHeader
80− imports <- chompImports (if isCore projectType then [] else Imports.defaults)
81− infixes <- if isKernel projectType then chompInfixes [] else return []
55+ imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)
56+ infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []
8257 decls <- specialize E.Declarations $ chompDecls []
8358 return (Module header imports infixes decls)
8459
@@ -87,15 +62,15 @@ chompModule projectType =
8762-- CHECK MODULE
8863
8964
90−checkModule :: ProjectType -> Module -> Either E.Error Src.Module
91−checkModule projectType (Module maybeHeader imports infixes decls) =
65+checkModule :: Module -> Either E.Error Src.Module
66+checkModule (Module maybeHeader imports infixes decls) =
9267 let
9368 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
9469 in
9570 case maybeHeader of
9671 Just (Header name effects exports docs) ->
9772 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
98− <$> checkEffects projectType ports effects
73+ <$> checkEffects ports effects
9974
10075 Nothing ->
10176 Right $
@@ -105,37 +80,23 @@ checkModule projectType (Module maybeHeader imports infixes decls) =
10580 _:_ -> Src.Ports ports
10681
10782
108−checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects
109−checkEffects projectType ports effects =
83+checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects
84+checkEffects ports effects =
11085 case effects of
11186 NoEffects region ->
11287 case ports of
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)
88+ [] -> Right Src.NoEffects
89+ _:_ -> Left (E.UnexpectedPort region)
12090
12191 Ports region ->
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)
92+ case ports of
93+ [] -> Left (E.NoPorts region)
94+ _:_ -> Right (Src.Ports ports)
13095
13196 Manager region manager ->
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−
97+ case ports of
98+ [] -> Right (Src.Manager region manager)
99+ _:_ -> Left (E.UnexpectedPort region)
139100
140101
141102categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )
@@ -434,18 +395,18 @@ exposing =
434395 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
435396 word1 0x29 {-)-} E.ExposingEnd
436397 return Src.Open
437− , do exposed <- chompExposed
398+ , do exposed <- addLocation chompExposed
438399 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
439400 exposingHelp [exposed]
440401 ]
441402
442403
443−exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing
404+exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing
444405exposingHelp revExposed =
445406 oneOf E.ExposingEnd
446407 [ do word1 0x2C {-,-} E.ExposingEnd
447408 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
448− exposed <- chompExposed
409+ exposed <- addLocation chompExposed
449410 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
450411 exposingHelp (exposed:revExposed)
451412 , do word1 0x29 {-)-} E.ExposingEnd
@@ -455,21 +416,16 @@ exposingHelp revExposed =
455416
456417chompExposed :: Parser E.Exposing Src.Exposed
457418chompExposed =
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− ]
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+ ]
473429
474430
475431privacy :: Parser E.Exposing Src.Privacy
@@ -477,11 +433,9 @@ privacy =
477433 oneOfWithFallback
478434 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
479435 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
480− start <- getPosition
481436 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
482− end <- getPosition
483437 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
484438 word1 0x29 {-)-} E.ExposingTypePrivacy
485− return $ Src.Public (A.Region start end)
439+ return Src.Public
486440 ]
487441 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 (reverse vars))
132+ addEnd start (Src.PRecord vars)
133133 ]
134134
135135
compiler/src/Parse/Space.hs+2−2
@@ -157,7 +157,7 @@ eatSpaces pos end row col =
157157-- LINE COMMENTS
158158
159159
160−eatLineComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)
160+eatLineComment :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)
161161eatLineComment pos end row col =
162162 if pos >= end then
163163 (# Good, pos, row, col #)
@@ -208,7 +208,7 @@ data MultiStatus
208208 | MultiEndless
209209
210210
211−eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Row, Col #)
211+eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Word16, Word16 #)
212212eatMultiCommentHelp pos end row col openComments =
213213 if pos >= end then
214214 (# MultiEndless, pos, row, col #)
compiler/src/Parse/String.hs+2−2
@@ -165,7 +165,7 @@ addEscape chunk start end revChunks =
165165-- SINGLE STRINGS
166166
167167
168−singleString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [ES.Chunk] -> StringResult
168+singleString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [ES.Chunk] -> StringResult
169169singleString pos end row col initialPos revChunks =
170170 if pos >= end then
171171 Err row col E.StringEndless_Single
@@ -211,7 +211,7 @@ singleString pos end row col initialPos revChunks =
211211-- MULTI STRINGS
212212
213213
214−multiString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> Row -> Col -> [ES.Chunk] -> StringResult
214+multiString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> Word16 -> Word16 -> [ES.Chunk] -> StringResult
215215multiString pos end row col initialPos sr sc revChunks =
216216 if pos >= end then
217217 Err sr sc E.StringEndless_Multi
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− !upperName =
152+ !foreign =
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 upperName newState
159+ cok foreign newState
160160
161161
162162foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)
compiler/src/Reporting/Doc.hs+3−3
@@ -394,18 +394,18 @@ toColor layer intensity color =
394394encodeChunks :: Style -> [String] -> E.Value
395395encodeChunks (Style bold underline color) revChunks =
396396 let
397− chars = concat (reverse revChunks)
397+ str = Json.fromChars (concat (reverse revChunks))
398398 in
399399 case color of
400400 Nothing | not bold && not underline ->
401− E.chars chars
401+ E.string str
402402
403403 _ ->
404404 E.object
405405 [ "bold" ==> E.bool bold
406406 , "underline" ==> E.bool underline
407407 , "color" ==> maybe E.null encodeColor color
408− , "string" ==> E.chars chars
408+ , "string" ==> E.string str
409409 ]
410410
411411
compiler/src/Reporting/Error.hs+16−20
@@ -12,7 +12,6 @@ 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
1615
1716import qualified Elm.ModuleName as ModuleName
1817import qualified File
@@ -39,8 +38,8 @@ import qualified Reporting.Report as Report
3938data Module =
4039 Module
4140 { _name :: ModuleName.Raw
42− , _absolutePath :: FilePath
43− , _modificationTime :: File.Time
41+ , _path :: FilePath
42+ , _time :: File.Time
4443 , _source :: B.ByteString
4544 , _error :: Error
4645 }
@@ -93,26 +92,26 @@ toReports source err =
9392-- TO DOC
9493
9594
96−toDoc :: FilePath -> Module -> [Module] -> D.Doc
97−toDoc root err errs =
95+toDoc :: Module -> [Module] -> D.Doc
96+toDoc err errs =
9897 let
99− (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)
98+ (NE.List m ms) = NE.sortBy _time (NE.List err errs)
10099 in
101− D.vcat (toDocHelp root m ms)
100+ D.vcat (toDocHelp m ms)
102101
103102
104−toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]
105−toDocHelp root module1 modules =
103+toDocHelp :: Module -> [Module] -> [D.Doc]
104+toDocHelp module1 modules =
106105 case modules of
107106 [] ->
108− [moduleToDoc root module1
107+ [moduleToDoc module1
109108 ,""
110109 ]
111110
112111 module2 : otherModules ->
113− moduleToDoc root module1
112+ moduleToDoc module1
114113 : toSeparator module1 module2
115− : toDocHelp root module2 otherModules
114+ : toDocHelp module2 otherModules
116115
117116
118117toSeparator :: Module -> Module -> D.Doc
@@ -134,22 +133,19 @@ toSeparator beforeModule afterModule =
134133-- MODULE TO DOC
135134
136135
137−moduleToDoc :: FilePath -> Module -> D.Doc
138−moduleToDoc root (Module _ absolutePath _ source err) =
136+moduleToDoc :: Module -> D.Doc
137+moduleToDoc (Module _ path _ source err) =
139138 let
140139 reports =
141140 toReports (Code.toSource source) err
142−
143− relativePath =
144− FP.makeRelative root absolutePath
145141 in
146− D.vcat $ map (reportToDoc relativePath) (NE.toList reports)
142+ D.vcat $ map (reportToDoc path) (NE.toList reports)
147143
148144
149145reportToDoc :: FilePath -> Report.Report -> D.Doc
150−reportToDoc relativePath (Report.Report title _ _ message) =
146+reportToDoc path (Report.Report title _ _ message) =
151147 D.vcat
152− [ toMessageBar title relativePath
148+ [ toMessageBar title path
153149 , ""
154150 , message
155151 , ""
compiler/src/Reporting/Error/Canonicalize.hs+30−30
@@ -14,10 +14,8 @@ module Reporting.Error.Canonicalize
1414
1515
1616import qualified Data.Char as Char
17−import qualified Data.List as List
1817import qualified Data.Map as Map
1918import qualified Data.Name as Name
20−import qualified Data.OneOrMore as OneOrMore
2119import qualified Data.Set as Set
2220
2321import qualified AST.Canonical as Can
@@ -39,10 +37,10 @@ import qualified Reporting.Suggest as Suggest
3937
4038data Error
4139 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
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)
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]
4644 | BadArity A.Region BadArityContext Name.Name Int Int
4745 | Binop A.Region Name.Name Name.Name
4846 | DuplicateDecl Name.Name A.Region A.Region
@@ -166,17 +164,17 @@ toReport source err =
166164 <> " be deleted? Maybe some parentheses are missing?"
167165 )
168166
169− AmbiguousVar region maybePrefix name h hs ->
170− ambiguousName source region maybePrefix name h hs "variable"
167+ AmbiguousVar region maybePrefix name possibleHomes ->
168+ ambiguousName source region maybePrefix name possibleHomes "variable"
171169
172− AmbiguousType region maybePrefix name h hs ->
173− ambiguousName source region maybePrefix name h hs "type"
170+ AmbiguousType region maybePrefix name possibleHomes ->
171+ ambiguousName source region maybePrefix name possibleHomes "type"
174172
175− AmbiguousVariant region maybePrefix name h hs ->
176− ambiguousName source region maybePrefix name h hs "variant"
173+ AmbiguousVariant region maybePrefix name possibleHomes ->
174+ ambiguousName source region maybePrefix name possibleHomes "variant"
177175
178− AmbiguousBinop region name h hs ->
179− ambiguousName source region Nothing name h hs "operator"
176+ AmbiguousBinop region name possibleHomes ->
177+ ambiguousName source region Nothing name possibleHomes "operator"
180178
181179 BadArity region badArityContext name expected actual ->
182180 let
@@ -244,11 +242,11 @@ toReport source err =
244242
245243 DuplicateAliasArg typeName name r1 r2 ->
246244 nameClash source r1 r2 $
247− "The `" <> Name.toChars typeName <> "` type alias has multiple `" <> Name.toChars name <> "` type variables."
245+ "The `" <> Name.toChars typeName <> "` type alias has multilpe `" <> Name.toChars name <> "` type variables."
248246
249247 DuplicateUnionArg typeName name r1 r2 ->
250248 nameClash source r1 r2 $
251− "The `" <> Name.toChars typeName <> "` type has multiple `" <> Name.toChars name <> "` type variables."
249+ "The `" <> Name.toChars typeName <> "` type has multilpe `" <> Name.toChars name <> "` type variables."
252250
253251 DuplicatePattern context name r1 r2 ->
254252 nameClash source r1 r2 $
@@ -276,7 +274,7 @@ toReport source err =
276274 "You have declared that `" ++ Name.toChars name ++ "` is an effect type:"
277275 ,
278276 D.reflow $
279− "But I cannot find a custom type named `" ++ Name.toChars name ++ "` in this file!"
277+ "But I cannot find a union type named `" ++ Name.toChars name ++ "` in this file!"
280278 )
281279
282280 EffectFunctionNotFound region name ->
@@ -344,7 +342,7 @@ toReport source err =
344342 Code.toSnippet source region Nothing
345343 (
346344 D.reflow $
347− "The (..) syntax is for exposing variants of a custom type. It cannot be used with a type alias like `"
345+ "The (..) syntax is for exposing union type constructors. It cannot be used with a type alias like `"
348346 ++ Name.toChars name ++ "` though."
349347 ,
350348 D.reflow $
@@ -357,12 +355,12 @@ toReport source err =
357355 (
358356 D.reflow $
359357 "You are trying to import the `" <> Name.toChars ctor
360− <> "` variant by name:"
358+ <> "` type constructor by name:"
361359 ,
362360 D.fillSep
363361 ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."
364362 ,"The","dots","mean","“expose","the",D.fromName tipe,"type","and"
365− ,"all","its","variants","so","it","gives","you","access","to"
363+ ,"all","its","constructors”","so","it","gives","you","access","to"
366364 , D.fromName ctor <> "."
367365 ]
368366 )
@@ -388,8 +386,13 @@ toReport source err =
388386 D.reflow $
389387 "The `" <> Name.toChars name <> "` type alias cannot be followed by (..) like this:"
390388 ,
391− D.reflow $
392− "Remove the (..) and it should work."
389+ D.stack
390+ [ "Remove the (..) and it should work."
391+ , D.link "Hint"
392+ "The distinction between `type` and `type alias` is important here. Read"
393+ "types-vs-type-aliases"
394+ "to learn more."
395+ ]
393396 )
394397
395398 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->
@@ -519,7 +522,7 @@ toReport source err =
519522 <> "` as a function, but it is not available in pattern matching like this:"
520523 ,
521524 D.reflow $
522− "I recommend matching the record as a variable and unpacking it later."
525+ "I recommend matching matching the record as a variable and unpacking it later."
523526 )
524527
525528 PortPayloadInvalid region portName _badType invalidPayload ->
@@ -679,7 +682,7 @@ toReport source err =
679682 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
680683 ,
681684 D.stack
682− [ makeTheory "Are you trying to mutate a variable?" $
685+ [ makeTheory "Are you are trying to mutate a variable?" $
683686 "Elm does not have mutation, so when I see " ++ Name.toChars name
684687 ++ " defined in terms of " ++ Name.toChars name
685688 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -725,7 +728,7 @@ toReport source err =
725728 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
726729 ,
727730 D.stack
728− [ makeTheory "Are you trying to mutate a variable?" $
731+ [ makeTheory "Are you are trying to mutate a variable?" $
729732 "Elm does not have mutation, so when I see " ++ Name.toChars name
730733 ++ " defined in terms of " ++ Name.toChars name
731734 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -976,11 +979,8 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =
976979-- AMBIGUOUS NAME
977980
978981
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
982+ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> [ModuleName.Canonical] -> String -> Report.Report
983+ambiguousName source region maybePrefix name possibleHomes thing =
984984 Report.Report "AMBIGUOUS NAME" region [] $
985985 Code.toSnippet source region Nothing $
986986 case maybePrefix of
compiler/src/Reporting/Error/Docs.hs+2−2
@@ -69,7 +69,7 @@ toReports source err =
6969 \ declaration and the imports."
7070 ,
7171 D.reflow
72− "Learn more at <https://package.elm-lang.org/help/documentation-format>"
72+ "Learn more at <http://package.elm-lang.org/help/documentation-format>"
7373 )
7474
7575 ImplicitExposing region ->
@@ -116,7 +116,7 @@ toSyntaxProblemReport source problem =
116116 , D.stack $
117117 [ D.reflow details
118118 , D.toSimpleHint $
119− "Read through <https://package.elm-lang.org/help/documentation-format> for\
119+ "Read through https://package.elm-lang.org/help/documentation-format for\
120120 \ tips on how to write module documentation!"
121121 ]
122122 )
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\" listed in your elm.json,\
59+ "I checked the \"dependencies\" and \"source-directories\" listend 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+4−16
@@ -51,13 +51,9 @@ parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Re
5151parseErrorToReport path source parseError reason =
5252 let
5353 toSnippet title row col (problem, details) =
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
54+ let pos = A.Position row col in
5955 Help.jsonReport title (Just path) $
60− Code.toSnippet source surroundings (Just region)
56+ Code.toSnippet source (A.Region pos pos) Nothing
6157 ( D.reflow (because reason problem)
6258 , details
6359 )
@@ -81,20 +77,12 @@ parseErrorToReport path source parseError reason =
8177 )
8278
8379 ObjectField row col ->
84− toSnippet "EXTRA COMMA" row col
80+ toSnippet "UNFINISHED OBJECT" row col
8581 (
8682 "I was partway through parsing a JSON object when I got stuck here:"
8783 ,
8884 D.stack
89− [ D.fillSep
90− ["I","saw","a","comma","right","before","I","got","stuck","here,"
91− ,"so","I","was","expecting","to","see","a","field","name","like"
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."
85+ [ D.reflow $ "I was expecting to see a field name next."
9886 , objectNote
9987 ]
10088 )
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 possibilities:"
44+ "This pattern does not cover all possiblities:"
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 possibility.\
67+ \ `let` to deconstruct values only if there is ONE possiblity.\
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+436−975
@@ -69,9 +69,6 @@ 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
7572 | ParseError Module
7673
7774
@@ -520,7 +517,7 @@ toReport source err =
520517 ,
521518 D.stack
522519 [ D.reflow $
523− "I need it to match the file path, so I was expecting to see `"
520+ "I need it to match the file path, so I was expecting it to see `"
524521 ++ ModuleName.toChars expectedName
525522 ++ "` here. Make the following change, and you should be all set!"
526523 , D.indent 4 $
@@ -564,84 +561,10 @@ toReport source err =
564561 ]
565562 )
566563
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−
619564 ParseError modul ->
620565 toParseErrorReport source modul
621566
622567
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−
645568toParseErrorReport :: Code.Source -> Module -> Report.Report
646569toParseErrorReport source modul =
647570 case modul of
@@ -649,9 +572,64 @@ toParseErrorReport source modul =
649572 toSpaceReport source space row col
650573
651574 ModuleBadEnd row col ->
652− if col == 1
653− then toDeclStartReport source row col
654− else toWeirdEndReport source 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 ->
620+ let
621+ region = toRegion row col
622+ in
623+ Report.Report "SYNTAX PROBLEM" region [] $
624+ Code.toSnippet source region Nothing
625+ (
626+ D.reflow $
627+ "I got stuck here:"
628+ ,
629+ D.reflow $
630+ "Whatever I am running into is confusing me a lot! Normally I can give fairly\
631+ \ specific hints, but something is really tripping me up this time."
632+ )
655633
656634 ModuleProblem row col ->
657635 let
@@ -797,15 +775,15 @@ toParseErrorReport source modul =
797775 [ D.reflow $
798776 "I am not sure what is going on, but I recommend starting an Elm\
799777 \ file with the following lines:"
800− , D.indent 4 $ D.vcat $
778+ , D.vcat
801779 [ D.fillSep [D.cyan "import","Html"]
802780 , ""
803− , "main ="
804− , " Html.text " <> D.dullyellow "\"Hello!\""
781+ , D.fillSep [D.green "main","="]
782+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
805783 ]
806784 , D.reflow $
807− "You should be able to copy those lines directly into your file. Check out the\
808− \ examples at <https://elm-lang.org/examples> for more help getting started!"
785+ "You should be able to copy those lines directly into your file. Check out\
786+ \ some of the examples on https://elm-lang.org for more help getting started!"
809787 , D.toSimpleNote $
810788 "This can also happen when something is indented too much!"
811789 ]
@@ -830,12 +808,11 @@ toParseErrorReport source modul =
830808 , D.indent 4 $ D.vcat $
831809 [ D.fillSep [D.cyan "import","Dict"]
832810 , D.fillSep [D.cyan "import","Maybe"]
833− , D.fillSep [D.cyan "import","Html.Attributes",D.cyan "as","A"]
834− , D.fillSep [D.cyan "import","Json.Decode",D.cyan "exposing","(..)"]
811+ , D.fillSep [D.cyan "import","Html.Attributes"]
812+ , D.fillSep [D.cyan "import","Json.Decode"]
835813 ]
836814 , D.reflow $
837815 "Notice that the module names all start with capital letters. That is required!"
838− , D.reflowLink "Read" "imports" "to learn more."
839816 ]
840817 )
841818
@@ -846,7 +823,7 @@ toParseErrorReport source modul =
846823 let
847824 region = toRegion row col
848825 in
849− Report.Report "EXPECTING IMPORT ALIAS" region [] $
826+ Report.Report "EXECTING IMPORT ALIAS" region [] $
850827 Code.toSnippet source region Nothing
851828 (
852829 D.reflow $
@@ -862,7 +839,6 @@ toParseErrorReport source modul =
862839 ]
863840 , D.reflow $
864841 "Notice that the alias always starts with a capital letter. That is required!"
865− , D.reflowLink "Read" "imports" "to learn more."
866842 ]
867843 )
868844
@@ -925,192 +901,6 @@ toParseErrorReport source modul =
925901
926902
927903
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−
1114904-- IMPORTS
1115905
1116906
@@ -1136,7 +926,6 @@ toImportReport source row col =
1136926 ]
1137927 , D.reflow $
1138928 "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."
1140929 ]
1141930 )
1142931
@@ -1443,7 +1232,106 @@ toDeclarationsReport :: Code.Source -> Decl -> Report.Report
14431232toDeclarationsReport source decl =
14441233 case decl of
14451234 DeclStart row col ->
1446− toDeclStartReport source row col
1235+ case Code.whatIsNext source row col of
1236+ Code.Close term bracket ->
1237+ let
1238+ region = toRegion row col
1239+ in
1240+ Report.Report ("STRAY " ++ map Char.toUpper term) region [] $
1241+ Code.toSnippet source region Nothing
1242+ (
1243+ D.reflow $
1244+ "I was not expecting to see a " ++ term ++ " here:"
1245+ , D.reflow $
1246+ "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"
1247+ )
1248+
1249+ Code.Keyword keyword ->
1250+ let
1251+ region = toKeywordRegion row col keyword
1252+ in
1253+ Report.Report "RESERVED WORD" region [] $
1254+ Code.toSnippet source region Nothing
1255+ (
1256+ D.reflow $
1257+ "I was not expecting to run into the `" ++ keyword ++ "` keyword here:"
1258+ ,
1259+ case keyword of
1260+ "import" ->
1261+ D.reflow $
1262+ "It is reserved for declaring imports at the top of your module. If you want\
1263+ \ another import, try moving it up top with the other imports. If you want to\
1264+ \ define a value or function, try changing the name to something else!"
1265+
1266+ "case" ->
1267+ D.stack
1268+ [ D.reflow $
1269+ "It is reserved for writing `case` expressions. Try using a different name?"
1270+ , D.toSimpleNote $
1271+ "If you are trying to write a `case` expression, it needs to be part of a\
1272+ \ definition. So you could write something like this instead:"
1273+ , D.vcat $
1274+ [ D.indent 0 $ D.fillSep [D.green "getWidth","maybeWidth","="]
1275+ , D.indent 2 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]
1276+ , D.indent 4 $ D.fillSep [D.blue "Just","width","->"]
1277+ , D.indent 6 $ D.fillSep ["width","+",D.dullyellow "200"]
1278+ , ""
1279+ , D.indent 4 $ D.fillSep [D.blue "Nothing","->"]
1280+ , D.indent 6 $ D.fillSep [D.dullyellow "400"]
1281+ ]
1282+ , D.reflow $
1283+ "This defines a `getWidth` function that we can use elsewhere in our program."
1284+ ]
1285+
1286+ "if" ->
1287+ D.stack
1288+ [ D.reflow $
1289+ "It is reserved for writing `if` expressions. Try using a different name?"
1290+ , D.toSimpleNote $
1291+ "If you are trying to write an `if` expression, it needs to be part of a\
1292+ \ definition. So you could write something like this instead:"
1293+ , D.vcat $
1294+ [ D.indent 0 $ D.fillSep [D.green "reviewPowerLevel","powerLevel","="]
1295+ , D.indent 2 $ D.fillSep $
1296+ [D.cyan "if","powerLevel",">",D.dullyellow "9000"
1297+ ,D.cyan "then",D.dullyellow "\"OVER 9000!!!\""
1298+ ,D.cyan "else",D.dullyellow "\"not bad\""
1299+ ]
1300+ ]
1301+ , D.reflow $
1302+ "This defines a `reviewPowerLevel` function that we can use elsewhere in our program."
1303+ ]
1304+
1305+ _ ->
1306+ D.reflow $
1307+ "It is a reserved word. Try changing the name to something else?"
1308+ )
1309+
1310+ _ ->
1311+ let
1312+ region = toRegion row col
1313+ in
1314+ Report.Report "SYNTAX PROBLEM" region [] $
1315+ Code.toSnippet source region Nothing
1316+ (
1317+ D.reflow $
1318+ "I was expecting to see a new declaration here:"
1319+ ,
1320+ D.stack
1321+ [ D.reflow $
1322+ "I am not sure what is going wrong exactly, but here are a couple valid\
1323+ \ declarations for reference:"
1324+ , D.vcat
1325+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
1326+ , D.fillSep [D.green "add","x","y","="]
1327+ , D.fillSep [" ","x","+","y"]
1328+ ]
1329+ , D.fillSep [D.cyan "type",D.green "User","=","Anonymous","|","LoggedIn String"]
1330+ , D.reflow $
1331+ "Note that all declarations start with lower-case letters in Elm. Capitalization\
1332+ \ makes a difference, so be consious of that if you are working from examples!"
1333+ ]
1334+ )
14471335
14481336 DeclSpace space row col ->
14491337 toSpaceReport source space row col
@@ -1473,165 +1361,6 @@ toDeclarationsReport source decl =
14731361 )
14741362
14751363
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−
16351364
16361365-- PORT
16371366
@@ -1758,7 +1487,7 @@ toPortReport source port_ startRow startCol =
17581487 [ D.reflow $
17591488 "I was expecting to see a type next. Here are examples of outgoing and\
17601489 \ incoming ports for reference:"
1761− , D.indent 4 $ D.vcat $
1490+ , D.vcat
17621491 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
17631492 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
17641493 ]
@@ -1777,7 +1506,7 @@ portNote =
17771506 D.stack
17781507 [ D.toSimpleNote $
17791508 "Here are some example `port` declarations for reference:"
1780− , D.indent 4 $ D.vcat $
1509+ , D.vcat
17811510 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
17821511 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
17831512 ]
@@ -1907,7 +1636,7 @@ toTypeAliasReport source typeAlias startRow startCol =
19071636 ,
19081637 D.stack
19091638 [ D.reflow $
1910− "I was expecting to see a type variable or an equals sign next."
1639+ "I was expecting to see a type variable or an an equals sign next."
19111640 , typeAliasNote
19121641 ]
19131642 )
@@ -1928,7 +1657,7 @@ toTypeAliasReport source typeAlias startRow startCol =
19281657 ,
19291658 D.stack
19301659 [ D.reflow $
1931− "I was expecting to see a type variable or an equals sign next."
1660+ "I was expecting to see a type variable or an an equals sign next."
19321661 , typeAliasNote
19331662 ]
19341663 )
@@ -1960,8 +1689,8 @@ typeAliasNote =
19601689 [ D.toSimpleNote $
19611690 "Here is an example of a valid `type alias` for reference:"
19621691 , D.vcat $
1963− [ D.indent 4 $ D.fillSep [D.cyan "type",D.cyan "alias","Person","="]
1964− , D.indent 6 $ D.vcat $
1692+ [ D.indent 0 $ D.fillSep [D.cyan "type",D.cyan "alias",D.green "Person","="]
1693+ , D.indent 2 $ D.vcat $
19651694 ["{ name : String"
19661695 ,", age : Int"
19671696 ,", height : Float"
@@ -2035,7 +1764,7 @@ toCustomTypeReport source customType startRow startCol =
20351764 ,
20361765 D.stack
20371766 [ D.reflow $
2038− "I was expecting to see a type variable or an equals sign next."
1767+ "I was expecting to see a type variable or an an equals sign next."
20391768 , customTypeNote
20401769 ]
20411770 )
@@ -2095,7 +1824,7 @@ toCustomTypeReport source customType startRow startCol =
20951824 ,
20961825 D.stack
20971826 [ D.reflow $
2098− "I was expecting to see a type variable or an equals sign next."
1827+ "I was expecting to see a type variable or an an equals sign next."
20991828 , customTypeNote
21001829 ]
21011830 )
@@ -2161,10 +1890,10 @@ customTypeNote =
21611890 [ D.toSimpleNote $
21621891 "Here is an example of a valid `type` declaration for reference:"
21631892 , D.vcat $
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"]
1893+ [ D.indent 0 $ D.fillSep [D.cyan "type",D.green "Status"]
1894+ , D.indent 2 $ D.fillSep ["=","Failure"]
1895+ , D.indent 2 $ D.fillSep ["|","Waiting"]
1896+ , D.indent 2 $ D.fillSep ["|","Success","String"]
21681897 ]
21691898 , D.reflow $
21701899 "This defines a new `Status` type with three variants. This could be useful if\
@@ -2193,57 +1922,13 @@ toDeclDefReport source name declDef startRow startCol =
21931922 region = toKeywordRegion row col keyword
21941923 in
21951924 Report.Report "RESERVED WORD" region [] $
2196− Code.toSnippet source surroundings (Just region)
2197− (
2198− D.fillSep
2199− ["The","name"
2200− ,"`" <> D.cyan (D.fromChars keyword) <> "`"
2201− ,"is","reserved","in","Elm,","so","it","cannot"
2202− ,"be","used","as","an","argument","here:"
2203− ]
2204− ,
2205− D.stack
2206− [ D.reflow $
2207− "Try renaming it to something else."
2208− , case keyword of
2209− "as" ->
2210− D.toFancyNote
2211− ["This","keyword","is","reserved","for","pattern","matches","like"
2212− ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"
2213− ,"the","values","it","contains."
2214− ]
2215−
2216− _ ->
2217− D.toSimpleNote $
2218− "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."
2219− ]
2220− )
2221−
2222− Code.Operator "->" ->
2223− let
2224− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
2225− region = toWiderRegion row col 2
2226− in
2227− Report.Report "MISSING COLON?" region [] $
22281925 Code.toSnippet source surroundings (Just region)
22291926 (
22301927 D.reflow $
2231− "I was not expecting to see an arrow here:"
1928+ "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
22321929 ,
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− ]
1930+ D.reflow $
1931+ "This is a reserved word! Try using some other name?"
22471932 )
22481933
22491934 Code.Operator op ->
@@ -2261,10 +1946,10 @@ toDeclDefReport source name declDef startRow startCol =
22611946 [ D.reflow $
22621947 "I am not sure what is going wrong exactly, so here is a valid\
22631948 \ definition (with an optional type annotation) for reference:"
2264− , D.indent 4 $ D.vcat $
2265− [ "greet : String -> String"
2266− , "greet name ="
2267− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
1949+ , D.vcat
1950+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
1951+ , D.fillSep [D.green "add","x","y","="]
1952+ , D.fillSep [" ","x","+","y"]
22681953 ]
22691954 , D.reflow $
22701955 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -2286,10 +1971,10 @@ toDeclDefReport source name declDef startRow startCol =
22861971 [ D.reflow $
22871972 "I am not sure what is going wrong exactly, so here is a valid\
22881973 \ definition (with an optional type annotation) for reference:"
2289− , D.indent 4 $ D.vcat $
2290− [ "greet : String -> String"
2291− , "greet name ="
2292− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
1974+ , D.vcat
1975+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
1976+ , D.fillSep [D.green "add","x","y","="]
1977+ , D.fillSep [" ","x","+","y"]
22931978 ]
22941979 , D.reflow $
22951980 "Try to use that format!"
@@ -2404,10 +2089,10 @@ declDefNote =
24042089 D.stack
24052090 [ D.reflow $
24062091 "Here is a valid definition (with a type annotation) for reference:"
2407− , D.indent 4 $ D.vcat $
2408− [ "greet : String -> String"
2409− , "greet name ="
2410− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2092+ , D.vcat
2093+ [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2094+ , D.fillSep [D.green "add","x","y","="]
2095+ , D.fillSep [" ","x","+","y"]
24112096 ]
24122097 , D.reflow $
24132098 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -2519,40 +2204,25 @@ toExprReport source context expr startRow startCol =
25192204 )
25202205
25212206 OperatorRight op row col ->
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
2207+ let region = toRegion row col in
25272208 Report.Report "MISSING EXPRESSION" region [] $
2528− Code.toSnippet source surroundings (Just region)
2209+ Code.toSnippet source region Nothing
25292210 (
25302211 D.reflow $
2531− "I just saw a " ++ Name.toChars op ++ " "
2532− ++ (if isMath then "sign" else "operator")
2533− ++ ", so I am getting stuck here:"
2212+ "I was expecting to see an expression after this " ++ Name.toChars op ++ " operator:"
25342213 ,
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."
2214+ D.stack
2215+ [ D.fillSep $
2216+ ["You","can","just","put","anything","for","now,","like"
2217+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"" <> "."
2218+ ,"Once","there","is","something","there,","I","can","probably"
2219+ ,"give","a","more","specific","hint!"
2220+ ]
2221+ , D.toSimpleNote $
2222+ "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
2223+ \ Or if I run into operators in unexpected spots. Point is, there are a\
2224+ \ couple ways I can get confused and give sort of weird advice!"
2225+ ]
25562226 )
25572227
25582228 OperatorReserved operator row col ->
@@ -2591,7 +2261,7 @@ toExprReport source context expr startRow startCol =
25912261 ,"give","a","more","specific","hint!"
25922262 ]
25932263 , D.toSimpleNote $
2594− "This can also happen if I run into reserved words like `let` or `as` unexpectedly.\
2264+ "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
25952265 \ Or if I run into operators in unexpected spots. Point is, there are a\
25962266 \ couple ways I can get confused and give sort of weird advice!"
25972267 ]
@@ -2740,15 +2410,17 @@ toStringReport source string row col =
27402410 , D.toSimpleNote $
27412411 "For a string that spans multiple lines, you can use the multi-line string\
27422412 \ syntax like this:"
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− , "\"\"\""
2413+ , D.vcat
2414+ [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2415+ , mempty
2416+ , D.dullyellow "# Multi-line Strings"
2417+ , mempty
2418+ , D.dullyellow "- start with triple double quotes"
2419+ , D.dullyellow "- write whatever you want"
2420+ , D.dullyellow "- no need to escape newlines or double quotes"
2421+ , D.dullyellow "- end with triple double quotes"
2422+ , mempty
2423+ , D.dullyellow "\"\"\""
27522424 ]
27532425 ]
27542426 )
@@ -2767,15 +2439,17 @@ toStringReport source string row col =
27672439 [ D.reflow "Add a \"\"\" somewhere after this to end the string."
27682440 , D.toSimpleNote $
27692441 "Here is a valid multi-line string for reference:"
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− , "\"\"\""
2442+ , D.vcat
2443+ [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2444+ , mempty
2445+ , D.dullyellow "# Multi-line Strings"
2446+ , mempty
2447+ , D.dullyellow "- start with triple double quotes"
2448+ , D.dullyellow "- write whatever you want"
2449+ , D.dullyellow "- no need to escape newlines or double quotes"
2450+ , D.dullyellow "- end with triple double quotes"
2451+ , mempty
2452+ , D.dullyellow "\"\"\""
27792453 ]
27802454 ]
27812455 )
@@ -3027,7 +2701,7 @@ toOperatorReport source context operator row col =
30272701 ,
30282702 D.stack
30292703 [ D.reflow $
3030− "It makes sense to see arrows around here, so I suspect it is something earlier. Maybe this pattern is indented a bit farther than the previous patterns?"
2704+ "It makes sense to see arrows around here, so I suspect it is something earlier."
30312705 , noteForCaseIndentError
30322706 ]
30332707 )
@@ -3035,15 +2709,11 @@ toOperatorReport source context operator row col =
30352709 else
30362710 (
30372711 D.reflow $
3038− "I was partway through parsing an expression when I got stuck on this arrow:"
2712+ "I was not expecting an arrow here:"
30392713 ,
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− ]
2714+ D.reflow $
2715+ "Arrows should only appear in `case` expressions and anonymous functions. Maybe\
2716+ \ you want > or >= instead?"
30472717 )
30482718
30492719 BadEquals ->
@@ -3170,7 +2840,7 @@ toLetReport source context let_ startRow startCol =
31702840 , D.toSimpleNote $
31712841 "This can also happen if you are trying to define another value within the `let` but\
31722842 \ it is not indented enough. Make sure each definition has exactly the same amount of\
3173− \ spaces before it. They should line up exactly!"
2843+ \ spaces before it. The should line up exactly!"
31742844 ]
31752845 )
31762846
@@ -3240,8 +2910,8 @@ toUnfinishLetReport source row col startRow startCol message =
32402910 [ message
32412911 , D.toSimpleNote $
32422912 "Here is an example with a valid `let` expression for reference:"
3243− , D.indent 4 $ D.vcat $
3244− [ D.indent 0 $ D.fillSep ["viewPerson","person","="]
2913+ , D.vcat $
2914+ [ D.indent 0 $ D.fillSep [D.green "viewPerson","person","="]
32452915 , D.indent 2 $ D.fillSep [D.cyan "let"]
32462916 , D.indent 4 $ D.fillSep ["fullName","="]
32472917 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]
@@ -3316,57 +2986,13 @@ toLetDefReport source name def startRow startCol =
33162986 region = toKeywordRegion row col keyword
33172987 in
33182988 Report.Report "RESERVED WORD" region [] $
3319− Code.toSnippet source surroundings (Just region)
3320− (
3321− D.fillSep
3322− ["The","name"
3323− ,"`" <> D.cyan (D.fromChars keyword) <> "`"
3324− ,"is","reserved","in","Elm,","so","it","cannot"
3325− ,"be","used","as","an","argument","here:"
3326− ]
3327− ,
3328− D.stack
3329− [ D.reflow $
3330− "Try renaming it to something else."
3331− , case keyword of
3332− "as" ->
3333− D.toFancyNote
3334− ["This","keyword","is","reserved","for","pattern","matches","like"
3335− ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"
3336− ,"the","values","it","contains."
3337− ]
3338−
3339− _ ->
3340− D.toSimpleNote $
3341− "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."
3342− ]
3343− )
3344−
3345− Code.Operator "->" ->
3346− let
3347− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3348− region = toWiderRegion row col 2
3349− in
3350− Report.Report "MISSING COLON?" region [] $
33512989 Code.toSnippet source surroundings (Just region)
33522990 (
33532991 D.reflow $
3354− "I was not expecting to see an arrow here:"
2992+ "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
33552993 ,
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− ]
2994+ D.reflow $
2995+ "This is a reserved word! Try using some other name?"
33702996 )
33712997
33722998 Code.Operator op ->
@@ -3384,10 +3010,10 @@ toLetDefReport source name def startRow startCol =
33843010 [ D.reflow $
33853011 "I am not sure what is going wrong exactly, so here is a valid\
33863012 \ definition (with an optional type annotation) for reference:"
3387− , D.indent 4 $ D.vcat $
3388− [ "greet : String -> String"
3389− , "greet name ="
3390− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3013+ , D.vcat
3014+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3015+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3016+ , D.indent 6 $ D.fillSep ["x","+","y"]
33913017 ]
33923018 , D.reflow $
33933019 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -3409,10 +3035,10 @@ toLetDefReport source name def startRow startCol =
34093035 [ D.reflow $
34103036 "I am not sure what is going wrong exactly, so here is a valid\
34113037 \ definition (with an optional type annotation) for reference:"
3412− , D.indent 4 $ D.vcat $
3413− [ "greet : String -> String"
3414− , "greet name ="
3415− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3038+ , D.vcat
3039+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3040+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3041+ , D.indent 4 $ D.fillSep ["x","+","y"]
34163042 ]
34173043 , D.reflow $
34183044 "Try to use that format!"
@@ -3502,10 +3128,10 @@ defNote =
35023128 D.stack
35033129 [ D.reflow $
35043130 "Here is a valid definition (with a type annotation) for reference:"
3505− , D.indent 4 $ D.vcat $
3506− [ "greet : String -> String"
3507− , "greet name ="
3508− , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3131+ , D.vcat
3132+ [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3133+ , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3134+ , D.indent 6 $ D.fillSep ["x","+","y"]
35093135 ]
35103136 , D.reflow $
35113137 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -3764,9 +3390,8 @@ noteForCaseIndentError =
37643390 , D.indent 8 $ D.fillSep [D.dullyellow "400"]
37653391 ]
37663392 , D.reflow $
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!"
3393+ "Notice the indentation! Each pattern is aligned, and each branch is indented\
3394+ \ a bit more than the corresponding pattern. That is important!"
37703395 ]
37713396
37723397
@@ -3918,43 +3543,23 @@ toIfReport source context if_ startRow startCol =
39183543 )
39193544
39203545 IfIndentElse row col ->
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− )
3546+ let
3547+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3548+ region = toRegion row col
3549+ in
3550+ Report.Report "UNFINISHED IF" region [] $
3551+ Code.toSnippet source surroundings (Just region)
3552+ (
3553+ D.reflow $
3554+ "I was expecting to see an `else` branch after this:"
3555+ ,
3556+ D.stack
3557+ [ D.reflow $
3558+ "I know what to do when the condition is `True`, but not when it is `False`."
3559+ , D.fillSep
3560+ ["Add","an",D.cyan "else","branch","to","handle","that","scenario!"]
3561+ ]
3562+ )
39583563
39593564
39603565
@@ -3987,22 +3592,15 @@ toRecordReport source context record startRow startCol =
39873592 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
39883593 region = toRegion row col
39893594 in
3990− Report.Report "PROBLEM IN RECORD" region [] $
3595+ Report.Report "UNFINISHED RECORD" region [] $
39913596 Code.toSnippet source surroundings (Just region)
39923597 (
39933598 D.reflow $
39943599 "I just started parsing a record, but I got stuck here:"
39953600 ,
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
3601+ D.fillSep
3602+ ["Records","look","like",D.dullyellow "{ x = 3, y = 4 },"
3603+ ,"so","I","was","expecting","to","see","a","field","name","next."
40063604 ]
40073605 )
40083606
@@ -4011,7 +3609,7 @@ toRecordReport source context record startRow startCol =
40113609 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
40123610 region = toRegion row col
40133611 in
4014− Report.Report "PROBLEM IN RECORD" region [] $
3612+ Report.Report "UNFINISHED RECORD" region [] $
40153613 Code.toSnippet source surroundings (Just region)
40163614 (
40173615 D.reflow $
@@ -4046,67 +3644,22 @@ toRecordReport source context record startRow startCol =
40463644 \ that is a reserved word. Try using a different name!"
40473645 )
40483646
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−
40883647 _ ->
40893648 let
40903649 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
40913650 region = toRegion row col
40923651 in
4093− Report.Report "PROBLEM IN RECORD" region [] $
3652+ Report.Report "UNFINISHED RECORD" region [] $
40943653 Code.toSnippet source surroundings (Just region)
40953654 (
40963655 D.reflow $
4097− "I am partway through parsing a record, but I got stuck here:"
3656+ "I am partway through parsing a record, but I got stuck after that last comma:"
40983657 ,
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− ]
3658+ addNoteForRecordError $
3659+ D.reflow $
3660+ "Trailing commas are not allowed in records, so I was expecting to see another\
3661+ \ record field defined next. If you are done defining the record, the fix may\
3662+ \ be to delete that last comma?"
41103663 )
41113664
41123665 RecordEquals row col ->
@@ -4114,19 +3667,17 @@ toRecordReport source context record startRow startCol =
41143667 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
41153668 region = toRegion row col
41163669 in
4117− Report.Report "PROBLEM IN RECORD" region [] $
3670+ Report.Report "UNFINISHED RECORD" region [] $
41183671 Code.toSnippet source surroundings (Just region)
41193672 (
41203673 D.reflow $
41213674 "I am partway through parsing a record, but I got stuck here:"
41223675 ,
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− ]
3676+ addNoteForRecordError $
3677+ D.fillSep $
3678+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
3679+ ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"
3680+ ]
41303681 )
41313682
41323683 RecordExpr expr row col ->
@@ -4146,54 +3697,29 @@ toRecordReport source context record startRow startCol =
41463697 D.reflow $
41473698 "I just saw the opening curly brace of a record, but then I got stuck here:"
41483699 ,
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− ]
3700+ addNoteForRecordIndentError $
3701+ D.fillSep $
3702+ ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."
3703+ ,"Try","defining","some","fields","of","your","own?"
3704+ ]
41563705 )
41573706
41583707 RecordIndentEnd row col ->
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− )
3708+ let
3709+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3710+ region = toRegion row col
3711+ in
3712+ Report.Report "UNFINISHED RECORD" region [] $
3713+ Code.toSnippet source surroundings (Just region)
3714+ (
3715+ D.reflow $
3716+ "I was expecting to see a closing curly brace next:"
3717+ ,
3718+ addNoteForRecordIndentError $
3719+ D.fillSep $
3720+ ["Try","putting","an",D.green "}","and","see","if","that","helps?"
3721+ ]
3722+ )
41973723
41983724 RecordIndentField row col ->
41993725 let
@@ -4206,13 +3732,11 @@ toRecordReport source context record startRow startCol =
42063732 D.reflow $
42073733 "I am partway through parsing a record, but I got stuck after that last comma:"
42083734 ,
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− ]
3735+ addNoteForRecordError $
3736+ D.reflow $
3737+ "Trailing commas are not allowed in records, so the fix may be to\
3738+ \ delete that last comma? Or maybe you were in the middle of defining\
3739+ \ an additional field?"
42163740 )
42173741
42183742 RecordIndentEquals row col ->
@@ -4227,12 +3751,10 @@ toRecordReport source context record startRow startCol =
42273751 "I am partway through parsing a record. I just saw a record\
42283752 \ field, so I was expecting to see an equals sign next:"
42293753 ,
4230− D.stack
4231− [ D.fillSep $
4232− ["Try","putting","an",D.green "=","followed","by","an","expression?"
4233− ]
4234− , noteForRecordIndentError
4235− ]
3754+ addNoteForRecordIndentError $
3755+ D.fillSep $
3756+ ["Try","putting","an",D.green "=","followed","by","an","expression?"
3757+ ]
42363758 )
42373759
42383760 RecordIndentExpr row col ->
@@ -4246,48 +3768,52 @@ toRecordReport source context record startRow startCol =
42463768 D.reflow $
42473769 "I am partway through parsing a record, and I was expecting to run into an expression next:"
42483770 ,
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− ]
3771+ addNoteForRecordIndentError $
3772+ D.fillSep $
3773+ ["Try","putting","something","like"
3774+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"
3775+ ]
42563776 )
42573777
42583778
4259−noteForRecordError :: D.Doc
4260−noteForRecordError =
3779+addNoteForRecordError :: D.Doc -> D.Doc
3780+addNoteForRecordError normalRecommendation =
42613781 D.stack $
3782+ normalRecommendation
3783+ :
42623784 [ D.toSimpleNote
42633785 "If you are trying to define a record across multiple lines, I recommend using this format:"
42643786 , D.indent 4 $ D.vcat $
4265− [ "{ name = " <> D.dullyellow "\"Alice\""
4266− , ", age = " <> D.dullyellow "42"
4267− , ", height = " <> D.dullyellow "1.75"
3787+ [ "{ name = \"Alice\""
3788+ , ", age = 42"
3789+ , ", height = 1.75"
42683790 , "}"
42693791 ]
42703792 , D.reflow $
4271− "Notice that each line starts with some indentation. Usually two or four spaces.\
4272− \ This is the stylistic convention in the Elm ecosystem."
3793+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
3794+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
3795+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
42733796 ]
42743797
42753798
4276−noteForRecordIndentError :: D.Doc
4277−noteForRecordIndentError =
4278− D.stack
3799+addNoteForRecordIndentError :: D.Doc -> D.Doc
3800+addNoteForRecordIndentError normalRecommendation =
3801+ D.stack $
3802+ normalRecommendation
3803+ :
42793804 [ D.toSimpleNote
42803805 "I may be confused by indentation. For example, if you are trying to define\
42813806 \ a record across multiple lines, I recommend using this format:"
42823807 , D.indent 4 $ D.vcat $
4283− [ "{ name = " <> D.dullyellow "\"Alice\""
4284− , ", age = " <> D.dullyellow "42"
4285− , ", height = " <> D.dullyellow "1.75"
3808+ [ "{ name = \"Alice\""
3809+ , ", age = 42"
3810+ , ", height = 1.75"
42863811 , "}"
42873812 ]
42883813 , D.reflow $
4289− "Notice that each line starts with some indentation. Usually two or four spaces.\
4290− \ This is the stylistic convention in the Elm ecosystem!"
3814+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
3815+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
3816+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
42913817 ]
42923818
42933819
@@ -4476,14 +4002,15 @@ toListReport source context list startRow startCol =
44764002 , D.toSimpleNote
44774003 "I recommend using the following format for lists that span multiple lines:"
44784004 , D.indent 4 $ D.vcat $
4479− [ "[ " <> D.dullyellow "\"Alice\""
4480− , ", " <> D.dullyellow "\"Bob\""
4481− , ", " <> D.dullyellow "\"Chuck\""
4005+ [ "[ \"Alice\""
4006+ , ", \"Bob\""
4007+ , ", \"Chuck\""
44824008 , "]"
44834009 ]
44844010 , D.reflow $
4485− "Notice that each line starts with some indentation. Usually two or four spaces.\
4486− \ This is the stylistic convention in the Elm ecosystem."
4011+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4012+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4013+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
44874014 ]
44884015 )
44894016
@@ -4536,14 +4063,15 @@ toListReport source context list startRow startCol =
45364063 "I may be confused by indentation. For example, if you are trying to define\
45374064 \ a list across multiple lines, I recommend using this format:"
45384065 , D.indent 4 $ D.vcat $
4539− [ "[ " <> D.dullyellow "\"Alice\""
4540− , ", " <> D.dullyellow "\"Bob\""
4541− , ", " <> D.dullyellow "\"Chuck\""
4066+ [ "[ \"Alice\""
4067+ , ", \"Bob\""
4068+ , ", \"Chuck\""
45424069 , "]"
45434070 ]
45444071 , D.reflow $
4545− "Notice that each line starts with some indentation. Usually two or four spaces.\
4546− \ This is the stylistic convention in the Elm ecosystem."
4072+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4073+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4074+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
45474075 ]
45484076 )
45494077
@@ -4567,14 +4095,15 @@ toListReport source context list startRow startCol =
45674095 "I may be confused by indentation. For example, if you are trying to define\
45684096 \ a list across multiple lines, I recommend using this format:"
45694097 , D.indent 4 $ D.vcat $
4570− [ "[ " <> D.dullyellow "\"Alice\""
4571− , ", " <> D.dullyellow "\"Bob\""
4572− , ", " <> D.dullyellow "\"Chuck\""
4098+ [ "[ \"Alice\""
4099+ , ", \"Bob\""
4100+ , ", \"Chuck\""
45734101 , "]"
45744102 ]
45754103 , D.reflow $
4576− "Notice that each line starts with some indentation. Usually two or four spaces.\
4577− \ This is the stylistic convention in the Elm ecosystem."
4104+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4105+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4106+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
45784107 ]
45794108 )
45804109
@@ -4595,14 +4124,15 @@ toListReport source context list startRow startCol =
45954124 , D.toSimpleNote
45964125 "I recommend using the following format for lists that span multiple lines:"
45974126 , D.indent 4 $ D.vcat $
4598− [ "[ " <> D.dullyellow "\"Alice\""
4599− , ", " <> D.dullyellow "\"Bob\""
4600− , ", " <> D.dullyellow "\"Chuck\""
4127+ [ "[ \"Alice\""
4128+ , ", \"Bob\""
4129+ , ", \"Chuck\""
46014130 , "]"
46024131 ]
46034132 , D.reflow $
4604− "Notice that each line starts with some indentation. Usually two or four spaces.\
4605− \ This is the stylistic convention in the Elm ecosystem."
4133+ "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4134+ \ This style can be jarring for people coming from C-like syntax, but folks generally\
4135+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
46064136 ]
46074137 )
46084138
@@ -4851,7 +4381,7 @@ toPatternReport source context pattern startRow startCol =
48514381 ,"((" <> D.dullyellow "x" <> "," <> D.dullyellow "y" <> ") " <> D.cyan "as" <> D.dullyellow " point" <> ")"
48524382 ,"so","you","can","refer","to","individual","parts","of","the","tuple","with"
48534383 ,D.dullyellow "x","and",D.dullyellow "y","or","you","refer","to","the","whole"
4854− ,"thing","with",D.dullyellow "point" <> "."
4384+ ,"thing","with",D.dullyellow "point."
48554385 ]
48564386 , D.reflow $
48574387 "So I was expecting to see a variable name after the `as` keyword here. Sometimes\
@@ -5043,7 +4573,7 @@ toPTupleReport source context tuple startRow startCol =
50434573 "I just saw an open parenthesis, but I got stuck here:"
50444574 ,
50454575 D.fillSep
5046− ["I","was","expecting","to","see","a","pattern","next."
4576+ ["I","was","expecting","so","see","a","pattern","next."
50474577 ,"Maybe","it","will","end","up","being","something"
50484578 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"
50494579 ]
@@ -5152,7 +4682,7 @@ toPTupleReport source context tuple startRow startCol =
51524682 "I just saw an open parenthesis, but then I got stuck here:"
51534683 ,
51544684 D.fillSep
5155− ["I","was","expecting","to","see","a","pattern","next."
4685+ ["I","was","expecting","so","see","a","pattern","next."
51564686 ,"Maybe","it","will","end","up","being","something"
51574687 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"
51584688 ]
@@ -5171,7 +4701,7 @@ toPTupleReport source context tuple startRow startCol =
51714701 ,
51724702 D.stack
51734703 [ D.fillSep
5174− ["I","was","expecting","to","see","a","pattern","next."
4704+ ["I","was","expecting","so","see","a","pattern","next."
51754705 ,"I","am","expecting","the","final","result","to","be","something"
51764706 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "."
51774707 ]
@@ -5475,64 +5005,22 @@ toTRecordReport source context record startRow startCol =
54755005 \ that is a reserved word. Try using a different name!"
54765006 )
54775007
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−
55175008 _ ->
55185009 let
55195010 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
55205011 region = toRegion row col
55215012 in
5522− Report.Report "PROBLEM IN RECORD TYPE" region [] $
5013+ Report.Report "UNFINISHED RECORD TYPE" region [] $
55235014 Code.toSnippet source surroundings (Just region)
55245015 (
55255016 D.reflow $
5526− "I am partway through parsing a record type, but I got stuck here:"
5017+ "I am partway through parsing a record type, but I got stuck after that last comma:"
55275018 ,
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− ]
5019+ addNoteForRecordTypeError $
5020+ D.reflow $
5021+ "Trailing commas are not allowed in records, so I was expecting to see another\
5022+ \ record field defined next. If you are done defining the record, the fix may\
5023+ \ be to delete that last comma?"
55365024 )
55375025
55385026 TRecordColon row col ->
@@ -5546,13 +5034,11 @@ toTRecordReport source context record startRow startCol =
55465034 D.reflow $
55475035 "I am partway through parsing a record type, but I got stuck here:"
55485036 ,
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− ]
5037+ addNoteForRecordTypeError $
5038+ D.fillSep $
5039+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
5040+ ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"
5041+ ]
55565042 )
55575043
55585044 TRecordType tipe row col ->
@@ -5572,54 +5058,29 @@ toTRecordReport source context record startRow startCol =
55725058 D.reflow $
55735059 "I just saw the opening curly brace of a record type, but then I got stuck here:"
55745060 ,
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− ]
5061+ addNoteForRecordTypeIndentError $
5062+ D.fillSep $
5063+ ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."
5064+ ,"Try","defining","some","fields","of","your","own?"
5065+ ]
55825066 )
55835067
55845068 TRecordIndentEnd row col ->
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− )
5069+ let
5070+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5071+ region = toRegion row col
5072+ in
5073+ Report.Report "UNFINISHED RECORD TYPE" region [] $
5074+ Code.toSnippet source surroundings (Just region)
5075+ (
5076+ D.reflow $
5077+ "I was expecting to see a closing curly brace next:"
5078+ ,
5079+ addNoteForRecordTypeIndentError $
5080+ D.fillSep $
5081+ ["Try","putting","an",D.green "}","and","see","if","that","helps?"
5082+ ]
5083+ )
56235084
56245085 TRecordIndentField row col ->
56255086 let
@@ -5632,13 +5093,11 @@ toTRecordReport source context record startRow startCol =
56325093 D.reflow $
56335094 "I am partway through parsing a record type, but I got stuck after that last comma:"
56345095 ,
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− ]
5096+ addNoteForRecordTypeIndentError $
5097+ D.reflow $
5098+ "Trailing commas are not allowed in record types, so the fix may be to\
5099+ \ delete that last comma? Or maybe you were in the middle of defining\
5100+ \ an additional field?"
56425101 )
56435102
56445103 TRecordIndentColon row col ->
@@ -5653,12 +5112,10 @@ toTRecordReport source context record startRow startCol =
56535112 "I am partway through parsing a record type. I just saw a record\
56545113 \ field, so I was expecting to see a colon next:"
56555114 ,
5656− D.stack
5657− [ D.fillSep $
5658− ["Try","putting","an",D.green ":","followed","by","a","type?"
5659− ]
5660− , noteForRecordTypeIndentError
5661− ]
5115+ addNoteForRecordTypeIndentError $
5116+ D.fillSep $
5117+ ["Try","putting","an",D.green ":","followed","by","a","type?"
5118+ ]
56625119 )
56635120
56645121 TRecordIndentType row col ->
@@ -5672,19 +5129,19 @@ toTRecordReport source context record startRow startCol =
56725129 D.reflow $
56735130 "I am partway through parsing a record type, and I was expecting to run into a type next:"
56745131 ,
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− ]
5132+ addNoteForRecordTypeIndentError $
5133+ D.fillSep $
5134+ ["Try","putting","something","like"
5135+ ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"
5136+ ]
56825137 )
56835138
56845139
5685−noteForRecordTypeError :: D.Doc
5686−noteForRecordTypeError =
5140+addNoteForRecordTypeError :: D.Doc -> D.Doc
5141+addNoteForRecordTypeError normalRecommendation =
56875142 D.stack $
5143+ normalRecommendation
5144+ :
56885145 [ D.toSimpleNote
56895146 "If you are trying to define a record type across multiple lines, I recommend using this format:"
56905147 , D.indent 4 $ D.vcat $
@@ -5694,14 +5151,17 @@ noteForRecordTypeError =
56945151 , "}"
56955152 ]
56965153 , D.reflow $
5697− "Notice that each line starts with some indentation. Usually two or four spaces.\
5698− \ This is the stylistic convention in the Elm ecosystem."
5154+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
5155+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
5156+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
56995157 ]
57005158
57015159
5702−noteForRecordTypeIndentError :: D.Doc
5703−noteForRecordTypeIndentError =
5160+addNoteForRecordTypeIndentError :: D.Doc -> D.Doc
5161+addNoteForRecordTypeIndentError normalRecommendation =
57045162 D.stack $
5163+ normalRecommendation
5164+ :
57055165 [ D.toSimpleNote
57065166 "I may be confused by indentation. For example, if you are trying to define\
57075167 \ a record type across multiple lines, I recommend using this format:"
@@ -5712,8 +5172,9 @@ noteForRecordTypeIndentError =
57125172 , "}"
57135173 ]
57145174 , D.reflow $
5715− "Notice that each line starts with some indentation. Usually two or four spaces.\
5716− \ This is the stylistic convention in the Elm ecosystem."
5175+ "Notice that each line starts with some indentation. Usually two or four spaces. I\
5176+ \ know this style can be jarring for people coming from C-like syntax, but folks generally\
5177+ \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
57175178 ]
57185179
57195180
@@ -5765,7 +5226,7 @@ toTTupleReport source context tuple startRow startCol =
57655226 Code.toSnippet source surroundings (Just region)
57665227 (
57675228 D.reflow $
5768− "I was expecting to see a closing parenthesis next, but I got stuck here:"
5229+ "I was expecting to see a closing parentheses next, but I got stuck here:"
57695230 ,
57705231 D.stack
57715232 [ D.fillSep ["Try","adding","a",D.dullyellow ")","to","see","if","that","helps?"]
compiler/src/Reporting/Error/Type.hs+22−38
@@ -231,7 +231,7 @@ toPatternReport source localizer patternRegion category tipe expected =
231231 "But all the previous patterns match:"
232232 [ D.link "Note"
233233 "A `case` expression can only handle one type of value, so you may want to use"
234− "custom-types"
234+ "union-types"
235235 "to handle “mixing” types."
236236 ]
237237 )
@@ -253,11 +253,11 @@ toPatternReport source localizer patternRegion category tipe expected =
253253 , patternTypeComparison localizer tipe expectedType
254254 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)
255255 "But all the previous patterns in the list are:"
256− [ D.link "Hint"
257− "Everything in a list must be the same type of value. This way, we never\
258− \ run into unexpected values partway through a List.map, List.foldl, etc. Read"
259− "custom-types"
260− "to learn how to “mix” types."
256+ [ D.toSimpleHint $
257+ "Everything in the list needs to be the same type of value.\
258+ \ This way you never run into unexpected values partway through.\
259+ \ To mix different types in a single list, create a \"union type\" as\
260+ \ described in: <http://guide.elm-lang.org/types/union_types.html>"
261261 ]
262262 )
263263
@@ -431,6 +431,10 @@ problemToHint problem =
431431 ]
432432 ]
433433
434+ T.AnythingToList ->
435+ [ D.toSimpleHint "Did you forget to add [] around it?"
436+ ]
437+
434438 T.ArityMismatch x y ->
435439 [ D.toSimpleHint $
436440 if x < y then
@@ -559,31 +563,11 @@ badFlexSuper :: T.Direction -> T.Super -> T.Type -> [D.Doc]
559563badFlexSuper direction super tipe =
560564 case super of
561565 T.Comparable ->
562− case tipe of
563− T.Record _ _ ->
564− [ D.link "Hint"
565− "I do not know how to compare records. I can only compare ints, floats,\
566− \ chars, strings, lists of comparable values, and tuples of comparable values.\
567− \ Check out" "comparing-records" "for ideas on how to proceed."
568− ]
569−
570− T.Type _ name _ ->
571− [ D.toSimpleHint $
572− "I do not know how to compare `" ++ Name.toChars name ++ "` values. I can only\
573− \ compare ints, floats, chars, strings, lists of comparable values, and tuples\
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− ]
566+ [ D.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable."
567+ ]
584568
585569 T.Appendable ->
586− [ D.toSimpleHint "I only know how to append strings and lists."
570+ [ D.toSimpleHint "Only strings and lists are appendable."
587571 ]
588572
589573 T.CompAppend ->
@@ -710,11 +694,11 @@ toExprReport source localizer exprRegion category tipe expected =
710694 , "The " <> ith <> " element of this list does not match all the previous elements:"
711695 , "The " <> ith <> " element is"
712696 , "But all the previous elements in the list are:"
713− , [ D.link "Hint"
714− "Everything in a list must be the same type of value. This way, we never\
715− \ run into unexpected values partway through a List.map, List.foldl, etc. Read"
716− "custom-types"
717− "to learn how to “mix” types."
697+ , [ D.toSimpleHint $
698+ "Everything in the list needs to be the same type of value.\
699+ \ This way you never run into unexpected values partway through.\
700+ \ To mix different types in a single list, create a \"union type\" as\
701+ \ described in: <http://guide.elm-lang.org/types/union_types.html>"
718702 ]
719703 )
720704
@@ -761,7 +745,7 @@ toExprReport source localizer exprRegion category tipe expected =
761745 , [ D.link "Hint"
762746 "All branches in an `if` must produce the same type of values. This way, no\
763747 \ matter which branch we take, the result is always a consistent shape. Read"
764− "custom-types"
748+ "union-types"
765749 "to learn how to “mix” types."
766750 ]
767751 )
@@ -776,7 +760,7 @@ toExprReport source localizer exprRegion category tipe expected =
776760 , [ D.link "Hint"
777761 "All branches in a `case` must produce the same type of values. This way, no\
778762 \ matter which branch we take, the result is always a consistent shape. Read"
779− "custom-types"
763+ "union-types"
780764 "to learn how to “mix” types."
781765 ]
782766 )
@@ -1093,7 +1077,7 @@ opRightToDocs localizer category op tipe expected =
10931077 ( D.reflow $ "I cannot send this through the (<|) pipe:"
10941078 , typeComparison localizer tipe expected
10951079 "The argument is:"
1096− "But (<|) is piping it to a function that expects:"
1080+ "But (<|) is piping it a function that expects:"
10971081 []
10981082 )
10991083
@@ -1104,7 +1088,7 @@ opRightToDocs localizer category op tipe expected =
11041088 ( D.reflow $ "This function cannot handle the argument sent through the (|>) pipe:"
11051089 , typeComparison localizer argType expectedArgType
11061090 "The argument is:"
1107− "But (|>) is piping it to a function that expects:"
1091+ "But (|>) is piping it a function that expects:"
11081092 []
11091093 )
11101094
compiler/src/Reporting/Render/Code.hs+26−67
@@ -7,8 +7,6 @@ module Reporting.Render.Code
77 , toPair
88 , Next(..)
99 , whatIsNext
10− , nextLineStartsWithKeyword
11− , nextLineStartsWithCloseCurly
1210 )
1311 where
1412
@@ -122,7 +120,7 @@ makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end
122120 spaces = replicate (fromIntegral c1 + width + 1) ' '
123121 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
124122 in
125− Just (D.fromChars spaces <> D.red (D.fromChars zigzag))
123+ Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
126124
127125
128126drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
@@ -148,7 +146,7 @@ addLineNumber addZigZag width start end n line =
148146
149147 spacer =
150148 if addZigZag && start <= n && n <= end then
151− D.red ">"
149+ D.dullred ">"
152150 else
153151 " "
154152 in
@@ -183,8 +181,8 @@ renderPair source@(Source sourceLines) region1 region2 =
183181 OneLine $
184182 D.vcat
185183 [ D.fromChars lineNumber <> "| " <> D.fromChars line
186− , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>
187− D.fromChars spaces2 <> D.red (D.fromChars zigzag2)
184+ , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
185+ D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
188186 ]
189187
190188 else
@@ -201,46 +199,35 @@ data Next
201199 = Keyword [Char]
202200 | Operator [Char]
203201 | Close [Char] Char
204− | Upper Char [Char]
205− | Lower Char [Char]
206− | Other (Maybe Char)
202+ | Other
207203
208204
209205whatIsNext :: Source -> Row -> Col -> Next
210206whatIsNext (Source sourceLines) row col =
211207 case List.lookup row sourceLines of
212208 Nothing ->
213− Other Nothing
209+ Other
214210
215211 Just line ->
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 == '_'
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
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
244231
245232
246233isSymbol :: Char -> Bool
@@ -257,32 +244,4 @@ startsWithKeyword restOfLine keyword =
257244 True
258245
259246 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
247+ not (Char.isAlphaNum c || c == '_')
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 :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
116−addType exposed types =
115+addType :: A.Located Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
116+addType (A.At _ exposed) types =
117117 case exposed of
118− Src.Lower _ -> types
119− Src.Upper (A.At _ name) _ -> Set.insert name types
120− Src.Operator _ _ -> types
118+ Src.Lower _ -> types
119+ Src.Upper name _ -> Set.insert name types
120+ Src.Operator _ -> types
compiler/src/Type/Error.hs+2−8
@@ -175,6 +175,7 @@ data Problem
175175 | StringToFloat
176176 | AnythingToBool
177177 | AnythingFromMaybe
178+ | AnythingToList
178179 | ArityMismatch Int Int
179180 | BadFlexSuper Direction Super Name.Name Type
180181 | BadRigidVar Name.Name Type
@@ -300,7 +301,7 @@ toDiff localizer ctx tipe1 tipe2 =
300301 different
301302 (toDoc localizer ctx t1)
302303 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])
303− Bag.empty
304+ (Bag.one AnythingToList)
304305
305306 (Alias home1 name1 args1 t1, t2) ->
306307 case diffAliasedRecord localizer t1 t2 of
@@ -449,13 +450,6 @@ isSuper super tipe =
449450 Appendable -> isString h n || isList h n
450451 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)
451452
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−
459453 _ ->
460454 False
461455
compiler/src/Type/Solve.hs−7
@@ -427,13 +427,6 @@ typeToVariable rank pools tipe =
427427 typeToVar rank pools Map.empty tipe
428428
429429
430−-- PERF working with @mgriffith we noticed that a 784 line entry in a `let` was
431−-- causing a ~1.5 second slowdown. Moving it to the top-level to be a function
432−-- saved all that time. The slowdown seems to manifest in `typeToVar` and in
433−-- `register` in particular. Have not explored further yet. Top-level definitions
434−-- are recommended in cases like this anyway, so there is at least a safety
435−-- valve for now.
436−--
437430typeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Type -> IO Variable
438431typeToVar rank pools aliasDict tipe =
439432 let go = typeToVar rank pools aliasDict in
compiler/src/Type/Unify.hs+8−5
@@ -391,13 +391,13 @@ unifyFlexSuperStructure context super flatType =
391391
392392 Comparable ->
393393 do comparableOccursCheck context
394− unifyComparableRecursive variable
395394 merge context (Structure flatType)
395+ unifyComparableRecursive variable
396396
397397 CompAppend ->
398398 do comparableOccursCheck context
399− unifyComparableRecursive variable
400399 merge context (Structure flatType)
400+ unifyComparableRecursive variable
401401
402402 Tuple1 a b maybeC ->
403403 case super of
@@ -409,12 +409,15 @@ unifyFlexSuperStructure context super flatType =
409409
410410 Comparable ->
411411 do comparableOccursCheck context
412+ merge context (Structure flatType)
412413 unifyComparableRecursive a
413414 unifyComparableRecursive b
414415 case maybeC of
415− Nothing -> return ()
416− Just c -> unifyComparableRecursive c
417− merge context (Structure flatType)
416+ Nothing ->
417+ return ()
418+
419+ Just c ->
420+ unifyComparableRecursive c
418421
419422 CompAppend ->
420423 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.1",
11+ "elm-version": "0.19.0",
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.1"` for most people!
51+The exact version of Elm this builds with. Should be `"0.19.0"` 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, and BSD-3-Clause is a good default. But you can see the full list of options [here](https://spdx.org/licenses/).
52+An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, but you can see the full list of options [here](https://spdx.org/licenses/).
5353
5454<br>
5555
docs/upgrade-instructions/0.19.1.mddeleted−60
@@ -1,60 +0,0 @@
1−# Upgrading to 0.19.1
2−
3−**There are no language changes**, so once you swap to `"elm-version": "0.19.1"` in your `elm.json`, most users should be able to proceed without any further code changes. **You may run into a handful of bugfixes though!** These cases are outlined below!
4−
5−
6−<br>
7−
8−## Improvements
9−
10−- Parse error message quality (like [this](https://github.com/elm/error-message-catalog/issues/255) and [this](https://github.com/elm/error-message-catalog/issues/225))
11−- Faster compilation, especially for incremental compiles
12−- Uses filelocks so that cached files are not corrupted when plugins run `elm make` multiple times on the same project at the same time. (Still worth avoiding that though!)
13−- More intuitive multiline declarations in REPL
14−- Various bug fixes (e.g. `--debug`, `x /= 0`, `type Height = Height Float` in `--optimize`)
15−
16−
17−<br>
18−
19−## Detectable Bug Fixes
20−
21−There are three known cases where code that compiled with 0.19.0 will not compile with 0.19.1 due to bug fixes:
22−
23−
24−### 1. Ambiguous Imports
25−
26−Say you have an import like this:
27−
28−```elm
29−import Html exposing (min)
30−import Regex exposing (never)
31−
32−x = min
33−y = never
34−```
35−
36−These should be reported as ambiguous usages since the names are also exposed by `Basics`, but there was a regression in 0.19.0 described [here](https://github.com/elm/compiler/issues/1945) such that they weren't caught in specific circumstances.
37−
38−The fix is to use a qualified name like `Html.min` or `Regex.never` to make it unambiguous.
39−
40−We found a couple instances of this in packages and have submitted PRs to the relevant authors in August 2019. You may run into this in your own code as well.
41−
42−For more details on why this is considered a regression, check out the details [here](https://github.com/elm/compiler/issues/1945#issuecomment-507871919) or try it in 0.18.0 to see how it worked before.
43−
44−
45−### 2. Tabs in Comments
46−
47−The 0.19.0 binaries did not catch tab characters in comments. The new parser is better at checking for tabs, so it will object when it finds these.
48−
49−Again, we found this in some packages and reached out to the relevant authors with PRs so patches would be published before the 0.19.1 release.
50−
51−
52−### 3. Port Module with no Ports
53−
54−If you have any files that start with:
55−
56−```elm
57−port module Main exposing (..)
58−```
59−
60−But they do not actually have any `port` declarations, the 0.19.1 binary will ask you to switch to a normal module declaration like `module Main exposing (..)`
elm.cabal+5−6
@@ -45,7 +45,6 @@ Executable elm
4545 Hs-Source-Dirs:
4646 compiler/src
4747 builder/src
48− terminal/impl
4948 terminal/src
5049
5150 other-extensions:
@@ -65,11 +64,11 @@ Executable elm
6564 Repl
6665
6766 -- terminal args
68− Terminal
69− Terminal.Chomp
70− Terminal.Error
71− Terminal.Helpers
72− Terminal.Internal
67+ Terminal.Args
68+ Terminal.Args.Chomp
69+ Terminal.Args.Error
70+ Terminal.Args.Helpers
71+ Terminal.Args.Internal
7372
7473 -- from terminal/
7574 Develop.Generate.Help
hints/bad-recursion.mddeleted−133
@@ -1,133 +0,0 @@
1−
2−# Hints for Bad Recursion
3−
4−There are two problems that will lead you here, both of them pretty tricky:
5−
6− 1. [**No Mutation**](#no-mutation) &mdash; Defining values in Elm is slightly different than defining values in languages like JavaScript.
7−
8− 2. [**Tricky Recursion**](#tricky-recursion) &mdash; Sometimes you need to define recursive values when creating generators, decoders, and parsers. A common case is a JSON decoder a discussion forums where a comment may have replies, which may have replies, which may have replies, etc.
9−
10−
11−## No Mutation
12−
13−Languages like JavaScript let you “reassign” variables. When you say `x = x + 1` it means: whatever `x` was pointing to, have it point to `x + 1` instead. This is called *mutating* a variable. All values are immutable in Elm, so reassigning variables does not make any sense! Okay, so what *should* `x = x + 1` mean in Elm?
14−
15−Well, what does it mean with functions? In Elm, we write recursive functions like this:
16−
17−```elm
18−factorial : Int -> Int
19−factorial n =
20− if n <= 0 then 1 else n * factorial (n - 1)
21−```
22−
23−One cool thing about Elm is that whenever you see `factorial 3`, you can always replace that expression with `if 3 <= 0 then 1 else 3 * factorial (3 - 1)` and it will work exactly the same. So when Elm code gets evaluated, we will keep expanding `factorial` until the `if` produces a 1. At that point, we are done expanding and move on.
24−
25−The thing that surprises newcomers is that recursion works the same way with values too. So take the following definition:
26−
27−```elm
28−x = x + 1
29−```
30−
31−We are actually defining `x` in terms of itself. So it would expand out to `x = ... + 1 + 1 + 1 + 1`, trying to add one to `x` an infinite number of times! This means your program would just run forever, endlessly expanding `x`. In practice, this means the page freezes and the computer starts to get kind of warm. No good! We can detect cases like this with the compiler, so we give an error at compile time so this does not happen in the wild.
32−
33−The fix is usually to just give the new value a new name. So you could rewrite it to:
34−
35−```elm
36−x1 = x + 1
37−```
38−
39−Now `x` is the old value and `x1` is the new value. Again, one cool thing about Elm is that whenever you see a `factorial 3` you can safely replace it with its definition. Well, the same is true of values. Wherever I see `x1`, I can replace it with `x + 1`. Thanks to the way definitions work in Elm, this is always safe!
40−
41−
42−## Tricky Recursion
43−
44−Now, there are some cases where you *do* want a recursive value. Say you are building a website with comments and replies. You may define a comment like this:
45−
46−```elm
47−type alias Comment =
48− { message : String
49− , upvotes : Int
50− , downvotes : Int
51− , responses : Responses
52− }
53−
54−type Responses =
55− Responses (List Comment)
56−```
57−
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:
59−
60−```elm
61−import Json.Decode as Decode exposing (Decoder)
62−
63−decodeComment : Decoder Comment
64−decodeComment =
65− Decode.map4 Comment
66− (Decode.field "message" Decode.string)
67− (Decode.field "upvotes" Decode.int)
68− (Decode.field "downvotes" Decode.int)
69− (Decode.field "responses" decodeResponses)
70−
71−-- PROBLEM
72−decodeResponses : Decoder Responses
73−decodeResponses =
74− Decode.map Responses (Decode.list decodeComment)
75−```
76−
77−The problem is that now `decodeComment` is defined in terms of itself! To know what `decodeComment` is, I need to expand `decodeResponses`. To know what `decodeResponses` is, I need to expand `decodeComment`. This loop will repeat endlessly!
78−
79−In this case, the trick is to use `Json.Decode.lazy` which delays the evaluation of a decoder until it is needed. So the valid definition would look like this:
80−
81−```elm
82−import Json.Decode as Decode exposing (Decoder)
83−
84−decodeComment : Decoder Comment
85−decodeComment =
86− Decode.map4 Comment
87− (Decode.field "message" Decode.string)
88− (Decode.field "upvotes" Decode.int)
89− (Decode.field "downvotes" Decode.int)
90− (Decode.field "responses" decodeResponses)
91−
92−-- SOLUTION
93−decodeResponses : Decoder Responses
94−decodeResponses =
95− Decode.map Responses (Decode.list (Decode.lazy (\_ -> decodeComment)))
96−```
97−
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!
99−
100−This saves us from expanding the value infinitely. Instead we only expand the value if we need to.
101−
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.
103−
104−
105−## Understanding “Bad Recursion”
106−
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?
108−
109−**Elm will allow recursive definitions as long as there is at least one lambda before you get back to yourself.** So if we write `factorial` without any pretty syntax, it looks like this:
110−
111−```elm
112−factorial =
113− \n -> if n <= 0 then 1 else n * factorial (n - 1)
114−```
115−
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.
117−
118−**This rule is nice, but it does not catch everything.** It is pretty easy to write a definition where the recursion is hidden behind a lambda, but it still immediately expands forever:
119−
120−```elm
121−x =
122− (\_ -> x) () + 1
123−```
124−
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?
130−
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!
132−
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.mddeleted−98
@@ -1,98 +0,0 @@
1−# Comparing Custom Types
2−
3−The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare custom types?
4−
5−This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
6−
7−
8−## Wrapped Types
9−
10−It is common to try to get some extra type safety by creating really simple custom types:
11−
12−```elm
13−type Id = Id Int
14−type Age = Age Int
15−
16−type Comment = Comment String
17−type Description = Description String
18−```
19−
20−By wrapping the primitive values like this, the type system can now help you make sure that you never mix up a `Id` and an `Age`. Those are different types! This trick is extra cool because it has no runtime cost in `--optimize` mode. The compiler can just use an `Int` or `String` directly when you use that flag!
21−
22−The problem arises when you want to use a `Id` as a key in a dictionary. This is a totally reasonable thing to do, but the current version of Elm cannot handle this scenario.
23−
24−Instead of creating a `Dict Id Info` type, one thing you can do is create a custom data structure like this:
25−
26−```elm
27−module User exposing (Id, Table, empty, get, add)
28−
29−import Dict exposing (Dict)
30−
31−
32−-- USER
33−
34−type Id = Id Int
35−
36−
37−-- TABLE
38−
39−type Table info =
40− Table Int (Dict Int info)
41−
42−empty : Table info
43−empty =
44− Table 0 Dict.empty
45−
46−get : Id -> Table info -> Maybe info
47−get (Id id) (Table _ dict) =
48− Dict.get id dict
49−
50−add : info -> Table info -> (Table info, Id)
51−add info (Table nextId dict) =
52− ( Table (nextId + 1) (Dict.insert nextId info dict)
53− , Id nextId
54− )
55−```
56−
57−There are a couple nice things about this approach:
58−
59−1. The only way to get a new `User.Id` is to `add` information to a `User.Table`.
60−2. All the operations on a `User.Table` are explicit. Does it make sense to remove users? To merge two tables together? Are there any special details to consider in those cases? This will always be captured explicitly in the interface of the `User` module.
61−3. If you ever want to switch the internal representation from `Dict` to `Array` or something else, it is no problem. All the changes will be within the `User` module.
62−
63−So while this approach is not as convenient as using a `Dict` directly, it has some benefits of its own that can be helpful in some cases.
64−
65−
66−## Enumerations to Ints
67−
68−Say you need to define a `trafficLightToInt` function:
69−
70−```elm
71−type TrafficLight = Green | Yellow | Red
72−
73−trafficLightToInt : TrafficLight -> Int
74−trafficLightToInt trafficLight =
75− ???
76−```
77−
78−We have heard that some people would prefer to use a dictionary for this sort of thing. That way you do not need to write the numbers yourself, they can be generated such that you never have a typo.
79−
80−I would recommend using a `case` expression though:
81−
82−```elm
83−type TrafficLight = Green | Yellow | Red
84−
85−trafficLightToInt : TrafficLight -> Int
86−trafficLightToInt trafficLight =
87− case trafficLight of
88− Green -> 1
89− Yellow -> 2
90− Red -> 3
91−```
92−
93−This is really straight-forward while avoiding questions like “is `Green` less than or greater than `Red`?”
94−
95−
96−## Something else?
97−
98−If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!
hints/comparing-records.mddeleted−85
@@ -1,85 +0,0 @@
1−# Comparing Records
2−
3−The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare records?
4−
5−This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
6−
7−
8−## Sorting Records
9−
10−Say we want a `view` function that can show a list of students sorted by different characteristics.
11−
12−We could create something like this:
13−
14−```elm
15−import Html exposing (..)
16−
17−type alias Student =
18− { name : String
19− , age : Int
20− , gpa : Float
21− }
22−
23−type Order = Name | Age | GPA
24−
25−viewStudents : Order -> List Student -> Html msg
26−viewStudents order students =
27− let
28− orderlyStudents =
29− case order of
30− Name -> List.sortBy .name students
31− Age -> List.sortBy .age students
32− GPA -> List.sortBy .gpa students
33− in
34− ul [] (List.map viewStudent orderlyStudents)
35−
36−viewStudent : Student -> Html msg
37−viewStudent student =
38− li [] [ text student.name ]
39−```
40−
41−If you are worried about the performance of changing the order or updating information about particular students, you can start using the [`Html.Lazy`](https://package.elm-lang.org/packages/elm/html/latest/Html-Lazy) and [`Html.Keyed`](https://package.elm-lang.org/packages/elm/html/latest/Html-Keyed) modules. The updated code would look something like this:
42−
43−```elm
44−import Html exposing (..)
45−import Html.Lazy exposing (lazy)
46−import Html.Keyed as Keyed
47−
48−type Order = Name | Age | GPA
49−
50−type alias Student =
51− { name : String
52− , age : Int
53− , gpa : Float
54− }
55−
56−viewStudents : Order -> List Student -> Html msg
57−viewStudents order students =
58− let
59− orderlyStudents =
60− case order of
61− Name -> List.sortBy .name students
62− Age -> List.sortBy .age students
63− GPA -> List.sortBy .gpa students
64− in
65− Keyed.ul [] (List.map viewKeyedStudent orderlyStudents)
66−
67−viewKeyedStudent : Student -> (String, Html msg)
68−viewKeyedStudent student =
69− ( student.name, lazy viewStudent student )
70−
71−viewStudent : Student -> Html msg
72−viewStudent student =
73− li [] [ text student.name ]
74−```
75−
76−By using `Keyed.ul` we help the renderer move the DOM nodes around based on their key. This makes it much cheaper to reorder a bunch of students. And by using `lazy` we help the renderer skip a bunch of work. If the `Student` is the same as last time, the render can skip over it.
77−
78−> **Note:** Some people are skeptical of having logic like this in `view` functions, but I think the alternative (maintaining sort order in your `Model`) has some serious downsides. Say a colleague is adding a message to `Add` students, but they do not know about the sort order rules needed for presentation. Bug! So in this alternate design, you must diligently test your `update` function to make sure that no message disturbs the sort order. This is bound to lead to bugs over time!
79−>
80−> With all the optimizations possible with `Html.Lazy` and `Html.Keyed`, I would always be inclined to work on optimizing my `view` functions rather than making my `update` functions more complicated and error prone.
81−
82−
83−## Something else?
84−
85−If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!
hints/implicit-casts.mddeleted−50
@@ -1,50 +0,0 @@
1−
2−# Implicit Casts
3−
4−Many languages automatically convert from `Int` to `Float` when they think it is necessary. This conversion is often called an [implicit cast](https://en.wikipedia.org/wiki/Type_conversion).
5−
6−Languages that will add in implicit casts for addition include:
7−
8− - JavaScript
9− - Python
10− - Ruby
11− - C
12− - C++
13− - C#
14− - Java
15− - Scala
16−
17−These languages generally agree that an `Int` may be implicitly cast to a `Float` when necessary. So everyone is doing it, why not Elm?!
18−
19−## Type Inference + Implicit Casts
20−
21−Elm comes from the ML-family of languages. Languages in the ML-family that **never** do implicit casts include:
22−
23− - Standard ML
24− - OCaml
25− - Elm
26− - F#
27− - Haskell
28−
29−Why would so many languages from this lineage require explicit conversions though?
30−
31−Well, we have to go back to the 1970s for some background. J. Roger Hindley and Robin Milner independently discovered an algorithm that could _efficiently_ figure out the type of everything in your program without any type annotations. Type Inference! Every ML-family language has some variation of this algorithm at the center of its design.
32−
33−For decades, the problem was that nobody could figure out how to combine type inference with implicit casts AND make the resulting algorithm efficient enough for daily use. As far as I know, Scala was the first widely known language to figure out how to combine these two things! Its creator, Martin Odersky did a lot of work on combining type inference and subtyping to make this possible.
34−
35−So for any ML-family language designed before Scala, it is safe to assume that implicit conversions just was not an option. Okay, but what about Elm?! It comes after Scala, so why not do it like them?!
36−
37− 1. You pay performance cost to mix type inference and implicit conversions. At least as far as anyone knows, it defeats an optimization that is crucial to getting _reliably_ good performance. It is fine in most cases, but it can be a real issue in very large code bases.
38−
39− 2. Based on experience reports from Scala users, it seemed like the convenience was not worth the hidden cost. Yes, you can convert `n` in `(n + 1.5)` and everything is nice, but when you are in larger programs that are sparsely annotated, it can be quite difficult to figure out what is going on.
40−
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.
42−
43−
44−## Conclusion
45−
46−First, based on the landscape of design possibilities, it seems like requiring _explicit_ conversions is a pretty nice balance. We can have type inference, it can produce friendly error messages, the algorithm is snappy, and an unintended implicit cast will not flow hundreds of lines before manifesting to the user.
47−
48−Second, Elm very much favors explicit code, so this also fits in with the overall spirit of the language and libraries.
49−
50−I hope that clarifies why you have to add those `toFloat` and `round` functions! It definitely can take some getting used to, but there are tons of folks who get past that acclimation period and really love the tradeoffs!
hints/import-cycles.mddeleted−184
@@ -1,184 +0,0 @@
1−
2−# Import Cycles
3−
4−What is an import cycle? In practice you may see it if you create two modules with interrelated `User` and `Comment` types like this:
5−
6−```elm
7−module Comment exposing (..)
8−
9−import User
10−
11−type alias Comment =
12− { comment : String
13− , author : User.User
14− }
15−```
16−
17−```elm
18−module User exposing (..)
19−
20−import Comment
21−
22−type alias User =
23− { name : String
24− , comments : List Comment.Comment
25− }
26−```
27−
28−Notice that to compile `Comment` we need to `import User`. And notice that to compile `User` we need to `import Comment`. We need both to compile either!
29−
30−Now this is *possible* if the compiler figures out any module cycles and puts them all in one big file to compile them together. That seems fine in our small example, but imagine we have a cycle of 20 modules. If you change *one* of them, you must now recompile *all* of them. In a large code base, this causes extremely long compile times. It is also very hard to disentangle them in practice, so you just end up with slow builds. That is your life now.
31−
32−The thing is that you can always write the code *without* cycles by shuffling declarations around, and the resulting code is often much clearer.
33−
34−
35−# How to Break Cycles
36−
37−There are quite a few ways to break our `Comment` and `User` cycle from above, so let’s go through four useful strategies. The first one is by far the most common solution!
38−
39−
40−## 1. Combine the Modules
41−
42−One approach is to just combine the two modules. If we check out the resulting code, we have actually revealed a problem in how we are representing our data:
43−
44−```elm
45−module BadCombination1 exposing (..)
46−
47−type alias Comment =
48− { comment : String
49− , author : User
50− }
51−
52−type alias User =
53− { name : String
54− , comments : List Comment
55− }
56−```
57−
58−Notice that the `Comment` type alias is defined in terms of the `User` type alias and vice versa. Having recursive type aliases like this does not work! That problem is described in depth [here](recursive-alias.md), but the quick takeaway is that one `type alias` needs to become a `type` to break the recursion. So let’s try again:
59−
60−```elm
61−module BadCombination2 exposing (..)
62−
63−type alias Comment =
64− { comment : String
65− , author : User
66− }
67−
68−type alias User =
69− { name : String
70− , comments : AllUserComments
71− }
72−
73−type AllUserComments = AllUserComments (List Comment)
74−```
75−
76−Okay, now we have broken the recursion, but we need to ask ourselves, how are we going to actually instantiate these `Comment` and `User` types that we have described. A `Comment` will always have an author, and that `User` will always refer back to the `Comment`. So we seem to want cyclic data here. If we were in JavaScript we might instantiate all the comments in one pass, and then go back through and mutate the users to point to all the relevant comments. In other words, we need *mutation* to create this cyclic data!
77−
78−All values are immutable in Elm, so we need to use a more functional strategy. One common approach is to use unique identifiers. Instead of referring directly to “the user object” we can refer to a user ID:
79−
80−```elm
81−module GoodCombination exposing (..)
82−
83−import Dict
84−
85−type alias Comment =
86− { comment : String
87− , author : UserId
88− }
89−
90−type alias UserId = String
91−
92−type alias AllComments =
93− Dict.Dict UserId (List Comment)
94−```
95−
96−Now in this world, we do not even have cycles in our types anymore! That means we can actually break these out into separate modules again:
97−
98−```elm
99−module Comment exposing (..)
100−
101−import Dict
102−import User
103−
104−type alias Comment =
105− { comment : String
106− , author : User.Id
107− }
108−
109−type alias AllComments =
110− Dict.Dict User.Id (List Comment)
111−```
112−
113−```elm
114−module User exposing (..)
115−
116−type alias Id = String
117−```
118−
119−So now we are back to the two modules we wanted, but we have data structures that are going to work much better in a functional language like Elm! **This is the common approach, and it is what you hope will happen!**
120−
121−
122−## 2. Make a New Module
123−
124−Now say there are actually a ton of functions and values in the `Comment` and `User` modules. Combining them into one does not seem like a good strategy. Instead you can create a *third* module that just has the shared types and functions. Let’s pretend we call that third module `GoodCombination`. So rather than having `Comment` and `User` depend on each other, they now both depend on `GoodCombination`. We broke our cycle!
125−
126−**This strategy is less common.** You generally want to keep the core `type` of a module with all the functions that act upon it directly, so separating a `type` from everything else is a bad sign. So maybe there is a `User` module that contains a bunch of helper functions, but you *use* all those helper functions in a bunch of other modules that interact with users in various ways. In that scenario, it is still more sophisticated than “just throw the types in a module together” and hope it turns out alright.
127−
128−
129−## 3. Use Type Variables
130−
131−Another way to avoid module cycles is to be more generic in how you represent your data:
132−
133−```elm
134−module Comment exposing (..)
135−
136−type alias Comment author =
137− { comment : String
138− , author : author
139− }
140−```
141−
142−```elm
143−module User exposing (..)
144−
145−type alias User comment =
146− { name : String
147− , comments : List comment
148− }
149−```
150−
151−Notice that `Comment` and `User` no longer need to import each other! Instead, whenever we use these modules, we need to fill in the type variable. So we may import both `Comment` and `User` and try to combine them into a `Comment (User (Comment (User ...)))`. Gah, we ran into the recursive type alias thing again!
152−
153−So this strategy fails pretty badly with our particular example. The code is more complicated and it still does not work! So **this strategy is rarely useful**, but when it works, it can simplify things quite a lot.
154−
155−
156−## 4. Hiding Implementation Details in Packages
157−
158−This gets a little bit trickier when you are creating a package like `elm-lang/parser` which is built around the `Parser` type.
159−
160−That package has a couple exposed modules: `Parser`, `Parser.LanguageKit`, and `Parser.LowLevel`. All of these modules want access to the internal details of the `Parser` type, but we do not want to ever expose those internal details to the *users* of this package. So where should the `Parser` type live?!
161−
162−Usually you know which module should expose the type for the best public API. In this case, it makes sense for it to live in the `Parser` module. The way to manage this is to create a `Parser.Internal` module with a definition like:
163−
164−```elm
165−module Parser.Internal exposing (..)
166−
167−type Parser a =
168− Parser ...
169−```
170−
171−Now we can `import Parser.Internal` and use it in any of the modules in our package. The trick is that we never expose the `Parser.Internal` module to the *users* of our package. We can see what is inside, but they cannot! Then in the `Parser` module we can say:
172−
173−```elm
174−module Parser exposing (..)
175−
176−import Parser.Internal as Internal
177−
178−type alias Parser a =
179− Internal.Parser a
180−```
181−
182−So now folks see a `Parser` type exposed by the `Parser` module, and it is the one that is used throughout all the modules in the package. Do not screw up your data representation to avoid this trick! I think we can improve how this appears in documentation, but overall this is the best way to go.
183−
184−Now again, this strategy is particularly useful in packages. It is not as worthwhile in application code.
hints/imports.mddeleted−126
@@ -1,126 +0,0 @@
1−
2−# Hints for Imports
3−
4−When getting started with Elm, it is pretty common to have questions about how the `import` declarations work exactly. These questions usually arise when you start playing with the `Html` library so we will focus on that.
5−
6−
7−<br>
8−
9−## `import`
10−
11−An Elm file is called a **module**. To access code in other files, you need to `import` it!
12−
13−So say you want to use the [`div`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#div) function from the [`elm-lang/html`](http://package.elm-lang.org/packages/elm-lang/html/latest) package. The simplest way is to import it like this:
14−
15−```elm
16−import Html
17−
18−main =
19− Html.div [] []
20−```
21−
22−After saying `import Html` we can refer to anything inside that module as long as it is *qualified*. This works for:
23−
24− - **Values** &mdash; we can refer to `Html.text`, `Html.h1`, etc.
25− - **Types** &mdash; We can refer to [`Attribute`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#Attribute) as `Html.Attribute`.
26−
27−So if we add a type annotation to `main` it would look like this:
28−
29−```elm
30−import Html
31−
32−main : Html.Html msg
33−main =
34− Html.div [] []
35−```
36−
37−We are referring to the [`Html`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#Html) type, using its *qualified* name `Html.Html`. This can feel weird at first, but it starts feeling natural quite quickly!
38−
39−> **Note:** Modules do not contain other modules. So the `Html` module *does not* contain the `Html.Attributes` module. Those are separate names that happen to have some overlap. So if you say `import Html` you *do not* get access to `Html.Attributes.style`. You must `import Html.Attributes` module separately.
40−
41−
42−<br>
43−
44−## `as`
45−
46−It is best practice to always use *qualified* names, but sometimes module names are so long that it becomes unwieldy. This is common for the `Html.Attributes` module. We can use the `as` keyword to help with this:
47−
48−```elm
49−import Html
50−import Html.Attributes as A
51−
52−main =
53− Html.div [ A.style "color" "red" ] [ Html.text "Hello!" ]
54−```
55−
56−Saying `import Html.Attributes as A` lets us refer to any value or type in `Html.Attributes` as long as it is qualified with an `A`. So now we can refer to [`style`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#style) as `A.style`.
57−
58−
59−<br>
60−
61−## `exposing`
62−
63−In quick drafts, maybe you want to use *unqualified* names. You can do that with the `exposing` keyword like this:
64−
65−```elm
66−import Html exposing (..)
67−import Html.Attributes exposing (style)
68−
69−main : Html msg
70−main =
71− div [ style "color" "red" ] [ text "Hello!" ]
72−```
73−
74−Saying `import Html exposing (..)` means I can refer to any value or type from the `Html` module without qualification. Notice that I use the `Html` type, the `div` function, and the `text` function without qualification in the example above.
75−
76−> **Note:** It seems neat to expose types and values directly, but it can get out of hand. Say you `import` ten modules `exposing` all of their content. It quickly becomes difficult to figure out what is going on in your code. “Wait, where is this function from?” And then trying to sort through all the imports to find it. Point is, use `exposing (..)` sparingly!
77−
78−Saying `import Html.Attributes exposing (style)` is a bit more reasonable. It means I can refer to the `style` function without qualification, but that is it. You are still importing the `Html.Attributes` module like normal though, so you would say `Html.Attributes.class` or `Html.Attributes.id` to refer to other values and types from that module.
79−
80−
81−<br>
82−
83−## `as` and `exposing`
84−
85−There is one last way to import a module. You can combine `as` and `exposing` to try to get a nice balance of qualified names:
86−
87−```elm
88−import Html exposing (Html, div, text)
89−import Html.Attributes as A exposing (style)
90−
91−main : Html msg
92−main =
93− div [ A.class "greeting", style "color" "red" ] [ text "Hello!" ]
94−```
95−
96−Notice that I refer to `A.class` which is qualified and `style` which is unqualified.
97−
98−
99−<br>
100−
101−## Default Imports
102−
103−We just learned all the variations of the `import` syntax in Elm. You will use some version of that syntax to `import` any module you ever write.
104−
105−It would be the best policy to make it so every module in the whole ecosystem works this way. We thought so in the past at least, but there are some modules that are so commonly used that the Elm compiler automatically adds the imports to every file. These default imports include:
106−
107−```elm
108−import Basics exposing (..)
109−import List exposing (List, (::))
110−import Maybe exposing (Maybe(..))
111−import Result exposing (Result(..))
112−import String
113−import Tuple
114−
115−import Debug
116−
117−import Platform exposing (Program)
118−import Platform.Cmd as Cmd exposing (Cmd)
119−import Platform.Sub as Sub exposing (Sub)
120−```
121−
122−You can think of these imports being at the top of any module you write.
123−
124−One could argue that `Maybe` is so fundamental to how we handle errors in Elm code that it is *basically* part of the language. One could also argue that it is extraordinarily annoying to have to import `Maybe` once you get past your first couple weeks with Elm. Either way, we know that default imports are not ideal in some sense, so we have tried to keep the default imports as minimal as possible.
125−
126−> **Note:** Elm performs dead code elimination, so if you do not use something from a module, it is not included in the generated code. So if you `import` a module with hundreds of functions, you do not need to worry about the size of your assets. You will only get what you use!
hints/infinite-type.mddeleted−42
@@ -1,42 +0,0 @@
1−
2−# Hints for Infinite Types
3−
4−Infinite types are probably the trickiest kind of bugs to track down. **Writing down type annotations is usually the fastest way to figure them out.** Let's work through an example to get a feel for how these errors usually work though!
5−
6−
7−## Example
8−
9−A common way to get an infinite type error is very small typos. For example, do you see the problem in the following code?
10−
11−```elm
12−incrementNumbers list =
13− List.map incrementNumbers list
14−
15−incrementNumber n =
16− n + 1
17−```
18−
19−The issue is that `incrementNumbers` calls itself, not the `incrementNumber` function defined below. So there is an extra `s` in this program! Let's focus on that:
20−
21−```elm
22−incrementNumbers list =
23− List.map incrementNumbers list -- BUG extra `s` makes this self-recursive
24−```
25−
26−Now the compiler does not know that anything is wrong yet. It just tries to figure out the types like normal. It knows that `incrementNumbers` is a function. The definition uses `List.map` so we can deduce that `list : List t1` and the result of this function call should be some other `List t2`. This also means that `incrementNumbers : List t1 -> List t2`.
27−
28−The issue is that `List.map` uses `incrementNumbers` on `list`! That means that each element of `list` (which has type `t1`) must be fed into `incrementNumbers` (which takes `List t1`)
29−
30−That means that `t1 = List t1`, which is an infinite type! If we start expanding this, we get `List (List (List (List (List ...))))` out to infinity!
31−
32−The point is mainly that we are in a confusing situation. The types are confusing. This explanation is confusing. The compiler is confused. It is a bad time. But luckily, the more type annotations you add, the better chance there is that you and the compiler can figure things out! So say we change our definition to:
33−
34−```elm
35−incrementNumbers : List Int -> List Int
36−incrementNumbers list =
37− List.map incrementNumbers list -- STILL HAS BUG
38−```
39−
40−Now we are going to get a pretty normal type error. Hey, you said that each element in the `list` is an `Int` but I cannot feed that into a `List Int -> List Int` function! Something like that.
41−
42−In summary, the root issue is often some small typo, and the best way out is to start adding type annotations on everything!
hints/init.mddeleted−55
@@ -1,55 +0,0 @@
1−
2−# Creating an Elm project
3−
4−The main goal of `elm init` is to get you to this page!
5−
6−It just creates an `elm.json` file and a `src/` directory for your code.
7−
8−
9−## What is `elm.json`?
10−
11−This file describes your project. It lists all of the packages you depend upon, so it will say the particular version of [`elm/core`](https://package.elm-lang.org/packages/elm/core/latest/) and [`elm/html`](https://package.elm-lang.org/packages/elm/html/latest/) that you are using. It makes builds reproducible! You can read a bit more about it [here](https://github.com/elm/compiler/blob/master/docs/elm.json/application.md).
12−
13−You should generally not edit it by hand. It is better to add new dependencies with commands like `elm install elm/http` or `elm install elm/json`.
14−
15−
16−## What goes in `src/`?
17−
18−This is where all of your Elm files live. It is best to start with a file called `src/Main.elm`. As you work through [the official guide](https://guide.elm-lang.org/), you can put the code examples in that `src/Main.elm` file.
19−
20−
21−## How do I compile it?
22−
23−Run `elm reactor` in your project. Now you can go to [`http://localhost:8000`](http://localhost:8000) and browse through all the files in your project. If you navigate to `.elm` files, it will compile them for you!
24−
25−If you want to do things more manually, you can run `elm make src/Main.elm` and it will produce an `index.html` file that you can look at in your browser.
26−
27−
28−## How do I structure my directories?
29−
30−Many folks get anxious about their project structure. “If I get it wrong, I am doomed!” This anxiety makes sense in languages where refactoring is risky, but Elm is not one of those languages!
31−
32−So we recommend that newcomers staying in one file until you get into the 600 to 1000 range. Push out of your comfort zone. Having the experience of being fine in large files will help you understand the boundaries in Elm, rather than just defaulting to the boundaries you learned in another language.
33−
34−The talk [The Life of a File](https://youtu.be/XpDsk374LDE) gets into this a lot more. The advice about building modules around a specific [custom type](https://guide.elm-lang.org/types/custom_types.html) is particularly important! You will see that emphasized a lot as you work through the official guide.
35−
36−
37−## How do I write tests?
38−
39−Elm will catch a bunch of errors statically, and I think it is worth skipping tests at first to get a feeling for when tests will actually help you _in Elm_.
40−
41−From there, we have a great testing package called [`elm-explorations/test`](https://github.com/elm-explorations/test) that can help you out! It is particularly helpful for teams working on a large codebase. When you are editing code you have never seen before, tests can capture additional details and constraints that are not otherwise apparent!
42−
43−
44−## How do I start fancier projects?
45−
46−I wanted `elm init` to generate as little code as possible. It is mainly meant to get you to this page! If you would like a more elaborate starting point, I recommend starting projects with commands like these:
47−
48−```bash
49−git clone https://github.com/evancz/elm-todomvc.git
50−git clone https://github.com/rtfeldman/elm-spa-example.git
51−```
52−
53−The idea is that Elm projects should be so simple that nobody needs a tool to generate a bunch of stuff. This also captures the fact that project structure _should_ evolve organically as your application develops, never ending up exactly the same as other projects.
54−
55−But if you have something particular you want, I recommend creating your own starter recipe and using `git clone` when you start new projects. That way (1) you can get exactly what you want and (2) we do not end up with a complex `elm init` that ends up being confusing for beginners!
hints/missing-patterns.mddeleted−139
@@ -1,139 +0,0 @@
1−
2−# Hints for Missing Patterns
3−
4−Elm checks to make sure that all possible inputs to a function or `case` are handled. This gives us the guarantee that no Elm code is ever going to crash because data had an unexpected shape.
5−
6−There are a couple techniques for making this work for you in every scenario.
7−
8−
9−## The danger of wildcard patterns
10−
11−A common scenario is that you want to add a tag to a custom type that is used in a bunch of places. For example, maybe you are working different variations of users in a chat room:
12−
13−```elm
14−type User
15− = Regular String Int
16− | Anonymous
17−
18−toName : User -> String
19−toName user =
20− case user of
21− Regular name _ ->
22− name
23−
24− _ ->
25− "anonymous"
26−```
27−
28−Notice the wildcard pattern in `toName`. This will hurt us! Say we add a `Visitor String` variant to `User` at some point. Now we have a bug that visitor names are reported as `"anonymous"`, and the compiler cannot help us!
29−
30−So instead, it is better to explicitly list all possible variants, like this:
31−
32−```elm
33−type User
34− = Regular String Int
35− | Visitor String
36− | Anonymous
37−
38−toName : User -> String
39−toName user =
40− case user of
41− Regular name _ ->
42− name
43−
44− Anonymous ->
45− "anonymous"
46−```
47−
48−Now the compiler will say "hey, what should `toName` do when it sees a `Visitor`?" This is a tiny bit of extra work, but it is very worth it!
49−
50−
51−## I want to go fast!
52−
53−Imagine that the `User` type appears in 20 or 30 functions across your project. When we add a `Visitor` variant, the compiler points out all the places that need to be updated. That is very convenient, but in a big project, maybe you want to get through it extra quickly.
54−
55−In that case, it can be helpful to use [`Debug.todo`](https://package.elm-lang.org/packages/elm-lang/core/latest/Debug#todo) to leave some code incomplete:
56−
57−```elm
58−type User
59− = Regular String Int
60− | Visitor String
61− | Anonymous
62−
63−toName : User -> String
64−toName user =
65− case user of
66− Regular name _ ->
67− name
68−
69− Visitor _ ->
70− Debug.todo "give the visitor name"
71−
72− Anonymous ->
73− "anonymous"
74−
75−-- and maybe a bunch of other things
76−```
77−
78−In this case it is easier to just write the implementation, but the point is that on more complex functions, you can put things off a bit.
79−
80−The Elm compiler is actually aware of `Debug.todo` so when it sees it in a `case` like this, it will crash with a bunch of helpful information. It will tell you:
81−
82− 1. The name of the module that contains the code.
83− 2. The line numbers of the `case` containing the TODO.
84− 3. The particular value that led to this TODO.
85−
86−From that information you have a pretty good idea of what went wrong and can go fix it.
87−
88−I tend to use `Debug.todo` as the message when my goal is to go quick because it makes it easy to go and find all remaining todos in my code before a release.
89−
90−
91−## A list that definitely is not empty
92−
93−This can come up from time to time, but Elm **will not** let you write code like this:
94−
95−```elm
96−last : List a -> a
97−last list =
98− case list of
99− [x] ->
100− x
101−
102− _ :: rest ->
103− last rest
104−```
105−
106−This is no good. It does not handle the empty list. There are two ways to handle this. One is to make the function return a `Maybe` like this:
107−
108−```elm
109−last : List a -> Maybe a
110−last list =
111− case list of
112− [] ->
113− Nothing
114−
115− [x] ->
116− Just x
117−
118− _ :: rest ->
119− last rest
120−```
121−
122−This is nice because it lets users know that there might be a failure, so they can recover from it however they want.
123−
124−The other option is to “unroll the list” one level to ensure that no one can ever provide an empty list in the first place:
125−
126−```elm
127−last : a -> List a -> a
128−last first rest =
129− case rest of
130− [] ->
131− first
132−
133− newFirst :: newRest ->
134− last newFirst newRest
135−```
136−
137−By demanding the first element of the list as an argument, it becomes impossible to call this function if you have an empty list!
138−
139−This “unroll the list” trick is quite useful. I recommend using it directly, not through some external library. It is nothing special. Just a useful idea!
hints/optimize.mddeleted−59
@@ -1,59 +0,0 @@
1−
2−# How to optimize Elm code
3−
4−When you are serving a website, there are two kinds of optimizations you want to do:
5−
6−1. **Asset Size** &mdash; How can we send as few bits as possible?
7−2. **Performance** &mdash; How can those bits run as quickly as possible?
8−
9−It turns out that Elm does really well on both! We have [very small assets](https://elm-lang.org/news/small-assets-without-the-headache) and [very fast code](https://elm-lang.org/news/blazing-fast-html-round-two) when compared to the popular alternatives.
10−
11−Okay, but how do we get those numbers?
12−
13−
14−## Instructions
15−
16−Step one is to compile with the `--optimize` flag. This does things like shortening record field names and unboxing values.
17−
18−Step two is to call `uglifyjs` with a bunch of special flags. The flags unlock optimizations that are unreliable in normal JS code, but because Elm does not have side-effects, they work fine for us!
19−
20−Putting those together, here is how I would optimize `src/Main.elm` with two terminal commands:
21−
22−```bash
23−elm 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
25−```
26−
27−After this you will have an `elm.js` and a significantly smaller `elm.min.js` file!
28−
29−**Note 1:** `uglifyjs` is called twice there. First to `--compress` and second to `--mangle`. This is necessary! Otherwise `uglifyjs` will ignore our `pure_funcs` flag.
30−
31−**Note 2:** If the `uglifyjs` command is not available in your terminal, you can run the command `npm install uglify-js --global` to download it. You probably already have `npm` from getting `elm repl` working, but if not, it is bundled with [nodejs](https://nodejs.org/).
32−
33−## Scripts
34−
35−It is hard to remember all that, so it is probably a good idea to write a script that does it.
36−
37−I would maybe want to run `./optimize.sh src/Main.elm` and get out `elm.js` and `elm.min.js`, so on Mac or Linux, I would make a script called `optimize.sh` like this:
38−
39−```bash
40−#!/bin/sh
41−
42−set -e
43−
44−js="elm.js"
45−min="elm.min.js"
46−
47−elm make --optimize --output=$js $@
48−
49−uglifyjs $js --compress "pure_funcs=[F2,F3,F4,F5,F6,F7,F8,F9,A2,A3,A4,A5,A6,A7,A8,A9],pure_getters,keep_fargs=false,unsafe_comps,unsafe" | uglifyjs --mangle --output $min
50−
51−echo "Initial size: $(cat $js | wc -c) bytes ($js)"
52−echo "Minified size:$(cat $min | wc -c) bytes ($min)"
53−echo "Gzipped size: $(cat $min | gzip -c | wc -c) bytes"
54−```
55−
56−It also prints out all the asset sizes for you! Your server should be configured to gzip the assets it sends, so the last line is telling you how many bytes would _actually_ get sent to the user.
57−
58−Again, the important commands are `elm` and `uglifyjs` which work on any platform, so it should not be too tough to do something similar on Windows.
59−
hints/port-modules.mddeleted−32
@@ -1,32 +0,0 @@
1−
2−# No Ports in Packages
3−
4−The package ecosystem is one of the most important parts of Elm. Right now, our ecosystem has some compelling benefits:
5−
6− - There are many obvious default packages that work well.
7− - Adding dependencies cannot introduce runtime exceptions.
8− - Patch changes cannot lead to surprise build failures.
9−
10−These are really important factors if you want to *quickly* create *reliable* applications. The Elm community thinks this is valuable.
11−
12−Other communities think that the *number* of packages is a better measure of ecosystem health. That is a fine metric to use, but it is not the one we use for Elm. We would rather have 50 great packages than 100k packages of wildly varying quality.
13−
14−
15−## So what about ports?
16−
17−Imagine you install a new package that claims to support `localStorage`. You get it set up, working through any compile errors. You run it, but it does not seem to work! After trying to figure it out for hours, you realize there is some poorly documented `port` to hook up...
18−
19−Okay, now you need to hook up some JavaScript code. Is that JS file in the Elm package? Or is it on `npm`? Wait, what version on `npm` though? And is this patch version going to work as well? Also, how does this file fit into my build process? And assuming we get through all that, maybe the `port` has the same name as one of the ports in your project. Or it clashes with a `port` name in another package.
20−
21−**Suddenly adding dependencies is much more complicated and risky!** An experienced developer would always check for ports up front, spending a bunch of time manually classifying unacceptable packages. Most people would not know to do that and learn all the pitfalls through personal experience, ultimately spending even *more* time than the person who defensively checks to avoid these issues.
22−
23−So “ports in packages” would impose an enormous cost on application developers, and in the end, we would have a less reliable package ecosystem overall.
24−
25−
26−## Conclusion
27−
28−Our wager with the Elm package ecosystem is that it is better to get a package *right* than to get it *right now*. So while we could use “ports in packages” as a way to get twenty `localStorage` packages of varying quality *right now*, we are choosing not to go that route. Instead we ask that developers use ports directly in their application code, getting the same result a different way.
29−
30−Now this may not be the right choice for your particular project, and that is okay! We will be expanding our core libraries over time, as explained [here](https://github.com/elm-lang/projects/blob/master/roadmap.md#where-is-the-localstorage-package), and we hope you will circle back later to see if Elm has grown into a better fit!
31−
32−If you have more questions about this choice or what it means for your application, please come ask in [the Elm slack](http://elmlang.herokuapp.com/). Folks are friendly and happy to help out! Chances are that a `port` in your application will work great for your case once you learn more about how they are meant to be used.
hints/recursive-alias.mddeleted−162
@@ -1,162 +0,0 @@
1−
2−# Hints for Recursive Type Aliases
3−
4−At the root of this issue is the distinction between a `type` and a `type alias`.
5−
6−
7−## What is a type alias?
8−
9−When you create a type alias, you are just creating a shorthand to refer to an existing type. So when you say the following:
10−
11−```elm
12−type alias Time = Float
13−
14−type alias Degree = Float
15−
16−type alias Weight = Float
17−```
18−
19−You have not created any *new* types, you just made some alternate names for `Float`. You can write down things like this and it'll work fine:
20−
21−```elm
22−add : Time -> Degree -> Weight
23−add time degree =
24− time + degree
25−```
26−
27−This is kind of a weird way to use type aliases though. The typical usage would be for records, where you do not want to write out the whole thing every time. Stuff like this:
28−
29−```elm
30−type alias Person =
31− { name : String
32− , age : Int
33− , height : Float
34− }
35−```
36−
37−It is much easier to write down `Person` in a type, and then it will just expand out to the underlying type when the compiler checks the program.
38−
39−
40−## Recursive type aliases?
41−
42−Okay, so let's say you have some type that may contain itself. In Elm, a common example of this is a comment that might have subcomments:
43−
44−```elm
45−type alias Comment =
46− { message : String
47− , upvotes : Int
48− , downvotes : Int
49− , responses : List Comment
50− }
51−```
52−
53−Now remember that type *aliases* are just alternate names for the real type. So to make `Comment` into a concrete type, the compiler would start expanding it out.
54−
55−```elm
56− { message : String
57− , upvotes : Int
58− , downvotes : Int
59− , responses :
60− List
61− { message : String
62− , upvotes : Int
63− , downvotes : Int
64− , responses :
65− List
66− { message : String
67− , upvotes : Int
68− , downvotes : Int
69− , responses : List ...
70− }
71− }
72− }
73−```
74−
75−The compiler cannot deal with values like this. It would just keep expanding forever.
76−
77−
78−## Recursive types!
79−
80−In cases where you want a recursive type, you need to actually create a brand new type. This is what the `type` keyword is for. A simple example of this can be seen when defining a linked list:
81−
82−```elm
83−type List
84− = Empty
85− | Node Int List
86−```
87−
88−No matter what, the type of `Node n xs` is going to be `List`. There is no expansion to be done. This means you can represent recursive structures with types that do not explode into infinity.
89−
90−So let's return to wanting to represent a `Comment` that may have responses. There are a couple ways to do this:
91−
92−
93−### Obvious, but kind of annoying
94−
95−```elm
96−type Comment =
97− Comment
98− { message : String
99− , upvotes : Int
100− , downvotes : Int
101− , responses : List Comment
102− }
103−```
104−
105−Now let's say you want to register an upvote on a comment:
106−
107−```elm
108−upvote : Comment -> Comment
109−upvote (Comment comment) =
110− Comment { comment | upvotes = 1 + comment.upvotes }
111−```
112−
113−It is kind of annoying that we now have to unwrap and wrap the record to do anything with it.
114−
115−
116−### Less obvious, but nicer
117−
118−```elm
119−type alias Comment =
120− { message : String
121− , upvotes : Int
122− , downvotes : Int
123− , responses : Responses
124− }
125−
126−type Responses = Responses (List Comment)
127−```
128−
129−In this world, we introduce the `Responses` type to capture the recursion, but `Comment` is still an alias for a record. This means the `upvote` function looks nice again:
130−
131−```elm
132−upvote : Comment -> Comment
133−upvote comment =
134− { comment | upvotes = 1 + comment.upvotes }
135−```
136−
137−So rather than having to unwrap a `Comment` to do *anything* to it, you only have to do some unwrapping in the cases where you are doing something recursive. In practice, this means you will do less unwrapping which is nice.
138−
139−
140−## Mutually recursive type aliases
141−
142−It is also possible to build type aliases that are *mutually* recursive. That might be something like this:
143−
144−```elm
145−type alias Comment =
146− { message : String
147− , upvotes : Int
148− , downvotes : Int
149− , responses : Responses
150− }
151−
152−type alias Responses =
153− { sortBy : SortBy
154− , responses : List Comment
155− }
156−
157−type SortBy = Time | Score | MostResponses
158−```
159−
160−When you try to expand `Comment` you have to expand `Responses` which needs to expand `Comment` which needs to expand `Responses`, etc.
161−
162−So this is just a fancy case of a self-recursive type alias. The solution is the same. Somewhere in that cycle, you need to define an actual `type` to end the infinite expansion.
hints/repl.mddeleted−73
@@ -1,73 +0,0 @@
1−
2−# REPL
3−
4−The REPL lets you interact with Elm values and functions in your terminal.
5−
6−
7−## Use
8−
9−You can type in expressions, definitions, custom types, and module imports using normal Elm syntax.
10−
11−```elm
12−> 1 + 1
13−2 : number
14−
15−> "hello" ++ "world"
16−"helloworld" : String
17−```
18−
19−The same can be done with definitions and custom types:
20−
21−```elm
22−> fortyTwo = 42
23−42 : number
24−
25−> increment n = n + 1
26−<function> : number -> number
27−
28−> increment 41
29−42 : number
30−
31−> factorial n =
32−| if n < 1 then
33−| 1
34−| else
35−| n * factorial (n-1)
36−|
37−<function> : number -> number
38−
39−> factorial 5
40−120 : number
41−
42−> type User
43−| = Regular String
44−| | Visitor String
45−|
46−
47−> case Regular "Tom" of
48−| Regular name -> "Hey again!"
49−| Visitor name -> "Nice to meet you!"
50−|
51−"Hey again!" : String
52−```
53−
54−When you run `elm repl` in a project with an [`elm.json`](https://github.com/elm/compiler/blob/master/docs/elm.json/application.md) file, you can import any module available in the project. So if your project has an `elm/html` dependency, you could say:
55−
56−```elm
57−> import Html exposing (Html)
58−
59−> Html.text "hello"
60−<internals> : Html msg
61−
62−> Html.text
63−<function> : String -> Html msg
64−```
65−
66−If you create a module in your project named `MyThing` in your project, you can say `import MyThing` in the REPL as well. Any module that is accessible in your project should be accessible in the REPL.
67−
68−
69−## Exit
70−
71−To exit the REPL, you can type `:exit`.
72−
73−You can also press `ctrl-d` or `ctrl-c` on some platforms.
hints/shadowing.mddeleted−70
@@ -1,70 +0,0 @@
1−
2−# Variable Shadowing
3−
4−Variable shadowing is when you define the same variable name twice in an ambiguous way. Here is a pretty reasonable use of shadowing:
5−
6−```elm
7−viewName : Maybe String -> Html msg
8−viewName name =
9− case name of
10− Nothing ->
11− ...
12−
13− Just name ->
14− ...
15−```
16−
17−I define a `name` with type `Maybe String` and then in that second branch, I define a `name` that is a `String`. Now that there are two `name` values, it is not 100% obvious which one you want in that second branch.
18−
19−Most linters produce warnings on variable shadowing, so Elm makes “best practices” the default. Just rename the first one to `maybeName` and move on.
20−
21−This choice is relatively uncommon in programming languages though, so I want to provide the reasoning behind it.
22−
23−
24−## The Cost of Shadowing
25−
26−The code snippet from above is the best case scenario for variable shadowing. It is pretty clear really. But that is because it is a fake example. It does not even compile.
27−
28−In a large module that is evolving over time, this is going to cause bugs in a very predictable way. You will have two definitions, separated by hundreds of lines. For example:
29−
30−```elm
31−name : String
32−name =
33− "Tom"
34−
35−-- hundreds of lines
36−
37−viewName : String -> Html msg
38−viewName name =
39− ... name ... name ... name ...
40−```
41−
42−Okay, so the `viewName` function has an argument `name` and it uses it three times. Maybe the `viewName` function is 50 lines long in total, so those uses are not totally easy to see. This is fine so far, but say your colleague comes along five months later and wants to support first and last names. They refactor the code like this:
43−
44−```elm
45−viewName : String -> String -> Html msg
46−viewName firstName lastName =
47− ... name ... name ... name ...
48−```
49−
50−The code compiles, but it does not work as intended. They forgot to change all the uses of `name`, and because it shadows the top-level `name` value, it always shows up as `"Tom"`. It is a simple mistake, but it is always the last thing I think of.
51−
52−> Is the data being fetched properly? Let me log all of the JSON requests. Maybe the JSON decoders are messed up? Hmm. Maybe someone is transforming the name in a bad way at some point? Let me check my `update` code.
53−
54−Basically, a bunch of time gets wasted on something that could easily be detected by the compiler. But this bug is rare, right?
55−
56−
57−## Aggregate Cost
58−
59−Thinking of a unique and helpful name takes some extra time. Maybe 30 seconds. But it means that:
60−
61− 1. Your code is easier to read and understand later on. So you spend 30 seconds once `O(1)` rather than spending 10 seconds each time someone reads that code in the future `O(n)`.
62−
63− 2. The tricky shadowing bug described above is impossible. Say there is a 5% chance that any given edit produces a shadowing bug, and that resolving that shadowing bug takes one hour. That means the expected time for each edit increases by three minutes.
64−
65−If you are still skeptical, I encourage you can play around with the number of edits, time costs, and probabilities here. When shadowing is not allowed, the resulting overhead for the entire lifetime of the code is the 30 seconds it takes to pick a better name, so that is what you need to beat!
66−
67−
68−## Summary
69−
70−Without shadowing, the code easier to read and folks spend less time on pointless debugging. The net outcome is that folks have more time to make something wonderful with Elm!
hints/tuples.mddeleted−19
@@ -1,19 +0,0 @@
1−
2−# From Tuples to Records
3−
4−The largest tuple possible in Elm has three entries. Once you get to four, it is best to make a record with named entries.
5−
6−For example, it is _conceivable_ to represent a rectangle as four numbers like `(10,10,100,100)` but it would be more self-documenting to use a record like this:
7−
8−```elm
9−type alias Rectangle =
10− { x : Float
11− , y : Float
12− , width : Float
13− , height : Float
14− }
15−```
16−
17−Now it is clear that the dimensions should be `Float` values. It is also clear that we are not using the convention of specifying the top-left and bottom-right corners. It could be clearer about whether the `x` and `y` is the point in the top-left or in the middle though!
18−
19−Anyway, using records like this also gives you access to syntax like `rect.x`, `.x`, and `{ rect | x = 40 }`. It is not clear how to design features like that for arbitrarily sized tuples, so we did not. We already have a way, and it is more self-documenting!
hints/type-annotations.mddeleted−60
@@ -1,60 +0,0 @@
1−
2−# Hints for Type Annotation Problems
3−
4−At the root of this kind of issue is always the fact that a type annotation in your code does not match the corresponding definition. Now that may mean that the type annotation is "wrong" or it may mean that the definition is "wrong". The compiler cannot figure out your intent, only that there is some mismatch.
5−
6−This document is going to outline the various things that can go wrong and show some examples.
7−
8−
9−## Annotation vs. Definition
10−
11−The most common issue is with user-defined type variables that are too general. So let's say you have defined a function like this:
12−
13−```elm
14−addPair : (a, a) -> a
15−addPair (x, y) =
16− x + y
17−```
18−
19−The issue is that the type annotation is saying "I will accept a tuple containing literally *anything*" but the definition is using `(+)` which requires things to be numbers. So the compiler is going to infer that the true type of the definition is this:
20−
21−```elm
22−addPair : (number, number) -> number
23−```
24−
25−So you will probably see an error saying "I cannot match `a` with `number`" which is essentially saying, you are trying to provide a type annotation that is **too general**. You are saying `addPair` accepts anything, but in fact, it can only handle numbers.
26−
27−In cases like this, you want to go with whatever the compiler inferred. It is good at figuring this kind of stuff out ;)
28−
29−
30−## Annotation vs. Itself
31−
32−It is also possible to have a type annotation that clashes with itself. This is probably more rare, but someone will run into it eventually. Let's use another version of `addPair` with problems:
33−
34−```elm
35−addPair : (Int, Int) -> number
36−addPair (x, y) =
37− x + y
38−```
39−
40−In this case the annotation says we should get a `number` out, but because we were specific about the inputs being `Int`, the output should also be an `Int`.
41−
42−
43−## Annotation vs. Internal Annotation
44−
45−A quite tricky case is when an outer type annotation clashes with an inner type annotation. Here is an example of this:
46−
47−```elm
48−filter : (a -> Bool) -> List a -> List a
49−filter isOkay list =
50− let
51− keepIfOkay : a -> Maybe a
52− keepIfOkay x =
53− if isOkay x then Just x else Nothing
54− in
55− List.filterMap keepIfOkay list
56−```
57−
58−This case is very unfortunate because all the type annotations are correct, but there is a detail of how type inference works right now that **user-defined type variables are not shared between annotations**. This can lead to probably the worst type error messages we have because the problem here is that `a` in the outer annotation does not equal `a` in the inner annotation.
59−
60−For 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.
installers/README.mddeleted−32
@@ -1,32 +0,0 @@
1−# Installing Elm
2−
3−The normal path is to work through [the guide](https://guide.elm-lang.org/) until you need to install, but you can skip to installation directly by going [here](https://guide.elm-lang.org/install/terminal.html).
4−
5−
6−<br/>
7−
8−## Installing Multiple Versions
9−
10−The secret is that Elm is just a single executable file. If you are developing a project in `~/Desktop/project/` you can download this file into that directory and run commands like `~/Desktop/project/elm make src/Main.elm` or `./elm make src/Main.elm`. You just run the local copy of the executable file!
11−
12−The instructions for [Mac][mac] and [Linux][lin] explain how to do this in more detail. You can follow the same steps on Windows, but you need to do each step by hand. (E.g. download the file through your browser rather than with a terminal command.)
13−
14−[mac]: https://github.com/elm/compiler/blob/master/installers/mac/README.md
15−[lin]: https://github.com/elm/compiler/blob/master/installers/linux/README.md
16−
17−<br/>
18−
19−## Installing Previous Versions
20−
21−The past binaries for Mac, Linux, and Windows are hosted [here](https://github.com/elm/compiler/releases).
22−
23−You can download the executable files directly and use them locally.
24−
25−
26−<br/>
27−
28−## Uninstall
29−
30−- [Mac](https://github.com/elm/compiler/blob/master/installers/mac/README.md#uninstall)
31−- [Linux](https://github.com/elm/compiler/blob/master/installers/linux/README.md#uninstall)
32−- [Windows](https://github.com/elm/compiler/blob/master/installers/win/README.md#uninstall)
installers/linux/Dockerfiledeleted−39
@@ -1,39 +0,0 @@
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
17−
18−# Use Alpine 3.11 with GHC 8.6.5
19−FROM alpine:3.11
20−
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
23−
24−WORKDIR /elm
25−
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 ./
32−
33−# Build statically linked elm binary
34−RUN cabal new-update
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.mddeleted−93
@@ -1,93 +0,0 @@
1−# Install Instructions
2−
3−The pre-compiled binary for Linux works on a very wide range of distributions.
4−
5−It should be possible to install it by running the following commands in your terminal:
6−
7−```bash
8−# Move to your Desktop so you can see what is going on easier.
9−#
10−cd ~/Desktop/
11−
12−# Download the 0.19.1 binary for Linux.
13−#
14−# +-----------+----------------------+
15−# | FLAG | MEANING |
16−# +-----------+----------------------+
17−# | -L | follow redirects |
18−# | -o elm.gz | name the file elm.gz |
19−# +-----------+----------------------+
20−#
21−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz
22−
23−# There should now be a file named `elm.gz` on your Desktop.
24−#
25−# The downloaded file is compressed to make it faster to download.
26−# This next command decompresses it, replacing `elm.gz` with `elm`.
27−#
28−gunzip elm.gz
29−
30−# There should now be a file named `elm` on your Desktop!
31−#
32−# Every file has "permissions" about whether it can be read, written, or executed.
33−# So before we use this file, we need to mark this file as executable:
34−#
35−chmod +x elm
36−
37−# The `elm` file is now executable. That means running `~/Desktop/elm --help`
38−# should work. Saying `./elm --help` works the same.
39−#
40−# But we want to be able to say `elm --help` without specifying the full file
41−# path every time. We can do this by moving the `elm` binary to one of the
42−# directories listed in your `PATH` environment variable:
43−#
44−sudo mv elm /usr/local/bin/
45−
46−# Now it should be possible to run the `elm` binary just by saying its name!
47−#
48−elm --help
49−```
50−
51−<br/>
52−
53−## Wait, what is the `PATH` variable?
54−
55−When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.
56−
57−The `PATH` is the list of directories that get searched. You can see these directories by running:
58−
59−```bash
60−echo $PATH
61−```
62−
63−This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.
64−
65−When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.
66−
67−So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.
68−
69−So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.
70−
71−**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.
72−
73−
74−<br/>
75−
76−## Uninstall
77−
78−The following commands should remove everything:
79−
80−```bash
81−# Remove the `elm` executable.
82−#
83−sudo rm /usr/local/bin/elm
84−
85−# Remove any cached files. The files here reduce compile times when
86−# starting new projects and make it possible to work offline in more
87−# cases. No need to keep it around if you are uninstalling though!
88−#
89−rm -r ~/.elm/
90−```
91−
92−If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.
93−
installers/mac/Distribution.xml+3−5
@@ -1,6 +1,6 @@
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</title>
3+ <title>Elm Platform</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 requires Mac OS X 10.6 or later.';
13+ my.result.message = 'This version of Elm Platform requires Mac OS X 10.6 or later.';
1414 my.result.type = 'Fatal';
1515 return false;
1616 }
@@ -18,15 +18,13 @@ function pm_volume_check() {
1818}
1919
2020</script>
21− <!--
2221 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>
23− -->
2422 <welcome mime-type="text/rtf" file="welcome.rtf" />
2523 <conclusion mime-type="text/rtf" file="conclusion.rtf" />
2624 <choices-outline>
2725 <line choice="choice2"/>
2826 </choices-outline>
29− <choice id="choice2" title="Elm">
27+ <choice id="choice2" title="Elm Platform ">
3028 <pkg-ref id="org.elm-lang.binaries.pkg"/>
3129 </choice>
3230 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>
installers/mac/README.mddeleted−93
@@ -1,93 +0,0 @@
1−# Install Instructions
2−
3−The easiest way to install is to to use [the Mac installer](https://github.com/elm/compiler/releases/download/0.19.1/installer-for-mac.pkg)!
4−
5−But it is also possible to install by running the following commands in your terminal:
6−
7−```bash
8−# Move to your Desktop so you can see what is going on easier.
9−#
10−cd ~/Desktop/
11−
12−# Download the 0.19.1 binary for Linux.
13−#
14−# +-----------+----------------------+
15−# | FLAG | MEANING |
16−# +-----------+----------------------+
17−# | -L | follow redirects |
18−# | -o elm.gz | name the file elm.gz |
19−# +-----------+----------------------+
20−#
21−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-mac-64-bit.gz
22−
23−# There should now be a file named `elm.gz` on your Desktop.
24−#
25−# The downloaded file is compressed to make it faster to download.
26−# This next command decompresses it, replacing `elm.gz` with `elm`.
27−#
28−gunzip elm.gz
29−
30−# There should now be a file named `elm` on your Desktop!
31−#
32−# Every file has "permissions" about whether it can be read, written, or executed.
33−# So before we use this file, we need to mark this file as executable:
34−#
35−chmod +x elm
36−
37−# The `elm` file is now executable. That means running `~/Desktop/elm --help`
38−# should work. Saying `./elm --help` works the same.
39−#
40−# But we want to be able to say `elm --help` without specifying the full file
41−# path every time. We can do this by moving the `elm` binary to one of the
42−# directories listed in your `PATH` environment variable:
43−#
44−sudo mv elm /usr/local/bin/
45−
46−# Now it should be possible to run the `elm` binary just by saying its name!
47−#
48−elm --help
49−```
50−
51−<br/>
52−
53−## What is the `PATH` variable?
54−
55−When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.
56−
57−The `PATH` is the list of directories that get searched. You can see these directories by running:
58−
59−```bash
60−echo $PATH
61−```
62−
63−This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.
64−
65−When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.
66−
67−So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.
68−
69−So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.
70−
71−**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.
72−
73−
74−<br/>
75−
76−## Uninstall
77−
78−The following commands should remove everything:
79−
80−```bash
81−# Remove the `elm` executable.
82−#
83−sudo rm /usr/local/bin/elm
84−
85−# Remove any cached files. The files here reduce compile times when
86−# starting new projects and make it possible to work offline in more
87−# cases. No need to keep it around if you are uninstalling though!
88−#
89−rm -r ~/.elm/
90−```
91−
92−If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.
93−
installers/mac/Resources/en.lproj/background.pngnew file

Binary file not shown.

installers/mac/Resources/en.lproj/conclusion.rtf+6−13
@@ -1,16 +1,9 @@
1−{\rtf1\ansi\ansicpg1252\cocoartf2509
2−\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}
1+{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400
2+{\fonttbl\f0\fswiss\fcharset0 Helvetica;}
33{\colortbl;\red255\green255\blue255;}
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
4+\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0
5+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural
76
8−\f0\fs28 \cf0 Try opening the terminal and running commands like:\
7+\f0\fs26 \cf0 A bunch of useful programs were just placed in /usr/local/bin/\
98\
10−
11−\f1 elm init\
12−elm make src/Main.elm --optimize\
13−elm repl
14−\f0 \
15−\
16−Check out {\field{\*\fldinst{HYPERLINK "https://guide.elm-lang.org/"}}{\fldrslt this tutorial}} for more advice!}
9+Check out {\field{\*\fldinst HYPERLINK "http://elm-lang.org/Get-Started.elm"}{\fldrslt this tutorial}} to learn how to use them!}
installers/mac/Resources/en.lproj/welcome.rtf+4−9
@@ -1,12 +1,7 @@
1−{\rtf1\ansi\ansicpg1252\cocoartf2509
2−\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}
1+{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400
2+{\fonttbl\f0\fswiss\fcharset0 Helvetica;}
33{\colortbl;\red255\green255\blue255;}
4−{\*\expandedcolortbl;;}
54\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0
6−\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural\partightenfactor0
5+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural
76
8−\f0\fs28 \cf0 Thank you for trying out Elm!\
9−\
10−This installer makes
11−\f1 elm
12−\f0 available in your terminal.}
7+\f0\fs28 \cf0 This package will install Elm on your machine.}
installers/mac/helper-scripts/elm-startup.sh+1−1
@@ -1,3 +1,3 @@
11#!/bin/sh
22
3−open 'http://guide.elm-lang.org'
3+open 'http://elm-lang.org'
installers/mac/make-installer.sh+3−30
@@ -29,8 +29,7 @@ cp $(pwd)/preinstall $pkg_scripts
2929cp $(pwd)/postinstall $pkg_scripts
3030
3131pkgbuild \
32− --sign "Developer ID Installer: <NAME>" \
33− --identifier org.elm-lang.binary \
32+ --identifier org.elm-lang.binaries.pkg \
3433 --install-location $usr_binaries \
3534 --scripts $pkg_scripts \
3635 --filter 'Scripts.*' \
@@ -40,42 +39,16 @@ pkgbuild \
4039
4140#### BUNDLE ASSETS ####
4241
43−rm -f installer-for-mac.pkg
42+rm -f Elm.pkg
4443
4544productbuild \
46− --sign "Developer ID Installer: <NAME>" \
47− --identifier org.elm-lang.installer \
4845 --distribution Distribution.xml \
4946 --package-path . \
5047 --resources Resources \
51− installer-for-mac.pkg
48+ Elm.pkg
5249
5350
5451#### CLEAN UP ####
5552
5653rm binaries.pkg
5754rm -rf $pkg_root
58−
59−
60−#### BEGIN NOTARIZATION ####
61−
62−xcrun altool \
63− --notarize-app \
64− --primary-bundle-id "org.elm-lang.installer" \
65− --username "<EMAIL>" \
66− --password "@keychain:Developer-altool" \
67− --file "installer-for-mac.pkg"
68−
69−# From https://scriptingosx.com/2019/09/notarize-a-command-line-tool/
70−#
71−#### Check on notarization:
72−#
73−# xcrun altool \
74−# --notarization-info "<RequestUUID>" \
75−# --username "<EMAIL>" \
76−# --password "@keychain:Developer-altool"
77−#
78−#
79−#### Staple Notarization:
80−#
81−# xcrun stapler staple installer-for-mac.pkg
installers/npm/PUBLISHING.md+141−29
@@ -1,59 +1,171 @@
1−# Publishing
1+# Publishing a new release
22
3−Here's how to update the `npm` installer.
3+A new version of Elm came out. Huzzah! Here's how to update the `npm` installer.
44
5+## 1. Create tarballs of binaries
56
6−## 1. GitHub Release
7+You can find a list of what binaries we'll need to tar up in `index.js`.
78
8−Create a [GitHub Release](https://github.com/elm/compiler/releases) with the following files:
9+For example:
910
10−1. `binary-for-mac-64-bit.gz`
11−2. `binary-for-windows-64-bit.gz`
12−3. `binary-for-linux-64-bit.gz`
11+```javascript
12+var root =
13+ "https://github.com/elm/compiler/releases/download/" +
14+ binVersion +
15+ "/binaries-for-";
1316
14−Create each of these by running the `elm` executable for each platform through `gzip elm`.
17+module.exports = binwrap({
18+ binaries: ["elm"],
19+ urls: {
20+ "darwin-x64": root + "mac.tar.gz",
21+ "win32-x64": root + "windows.tar.gz",
22+ "win32-ia32": root + "windows.tar.gz",
23+ "linux-x64": root + "linux.tar.gz"
24+ }
25+});
26+```
27+
28+If this is the end of your `index.js`, you'll need to create these files:
1529
30+1. `binaries-for-mac.tar.gz`
31+2. `binaries-for-windows.tar.gz`
32+3. `binaries-for-linux.tar.gz`
1633
17−## 2. Try a beta release
34+Each of these tarballs should have **only the Elm binary** inside them - no
35+directories!
1836
19−In `package.json`, bump the version to `"0.19.2-beta"`.
37+So create them by making a directory, putting all the binaries in it, `cd`-ing
38+into that directory, and then running something like this:
2039
21−```bash
22−npm publish --tag beta
40+```shell
41+$ tar cvzf binaries-for-linux.tar.gz elm
2342```
2443
25−To test that it works, run these commands:
44+Make sure each tarball contains all the binaries listed in that `binaries:` list
45+in `index.js`. (The Windows ones should have `.exe` at the end; `binwrap`
46+expects that they will, for Windows only.)
47+
48+## 2. Update the `bin/` binary wrappers
49+
50+Inside the npm installer's `bin/` directory, there should be a file for each of
51+the binaries that will be included in this release.
52+
53+Each of these must be executable! If you're not sure whether they are,
54+run `chmod +x` on them just to be sure.
55+
56+Their paths must also must all be listed in `package.json` in two places:
57+
58+1. The `"files":` field
59+2. The `"bin":` field
60+
61+If the executables are the same as they were for the last release, great!
62+You can proceed to the next step. If any binaries were removed, make sure to
63+remove them from these lists!
64+
65+## 3. Update `package.json` for a beta release
66+
67+In `package.json`, bump the version to the next applicable release, and add
68+a `"-beta"` suffix to it.
69+
70+For example, if it was on `"0.18.0"` you might bump it to `"0.19.0-beta"`.
71+The version number should match the release of Elm, such that if people do
72+`npm install elm@0.19.0@beta` they get what they would expect.
73+
74+## 4. Tag the beta release
75+
76+Commit this change and tag it with the name of the release **without** the
77+`-beta` suffix. (We will overwrite this tag later.)
78+
79+For example:
2680
27−```bash
28−npm dist-tags ls elm
29−npm install elm@beta --ignore-scripts
81+```shell
82+$ git tag 0.19.0
83+$ git push origin 0.19.0
3084```
3185
32−The `latest` tag should not be changed, and there should be an additional `beta` tag.
86+Now this tag should exist on GitHub, allowing us to upload binaries to it.
3387
34−Try this on Windows, Linux, and Mac.
88+## 5. Upload binaries
3589
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.
3694
37−## 3. Publish final release
95+Upload the tarballs you created in step 1.
3896
39−Remove the `-beta` suffix from the version in `package.json`. Then run:
97+## 6. Publish beta release
4098
41−```bash
42−npm publish
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
43106```
44107
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+```
45114
46−## 4. Tag the `latest-0.19.1` version
115+If you messed this up, and the `latest` tag now points to the beta you just
116+published, don't panic - it's fixable! `dist-tags` can always be modified after
117+the fact. Read up on `npm` [dist-tags](https://docs.npmjs.com/cli/dist-tag)
118+to learn how to fix things.
47119
48−Many compiler releases have needed multiple `npm` publications. Maybe something does not work on Windows or some dependency becomes insecure. Normal `npm` problems.
120+## 7. Verify beta installer
49121
50−The convention for each Elm release is to create a tag the latest one.
122+Make an empty directory and run `npm init` inside it.
51123
52−```bash
53−npm dist-tag add elm@0.19.1-3 latest-0.19.1
124+Then run this:
125+
126+```shell
127+$ npm install elm@beta --ignore-scripts
54128```
55129
56−That way people who want a specific version can point to `latest-0.19.1` or `latest-0.18.0` instead of knowing the particular names of all the various publications.
130+This should succeed with an exit code of `0`.
131+If it did, look in `node_modules/.bin/` for the binaries you expect.
132+They should be present, and they should also work as expected when you run them.
133+Because you installed them with `--ignore-scripts`, the first thing they should
134+do is to download themselves and then execute whatever command you requested
135+(e.g. `node_modules/.bin/elm make Main.elm`). If you run the same command a
136+second time, it should run faster because it doesn't have to download the binary
137+first.
138+
139+Now try it again with `--ignore-scripts` turned off:
140+
141+```shell
142+$ rm -r node_modules
143+$ npm install elm@beta --ignore-scripts=false
144+```
145+
146+This time it should download the binaries during the installation phase. Once
147+again you should be able to run the binaries from `node_modules/.bin/`, and
148+this time they should be fast from the first run because they're already
149+downloaded.
150+
151+## 8. Publish for real
152+
153+It's a good idea to ask others to try out the beta installer before doing this!
154+Especially on multiple operating systems.
155+
156+To publish the real version:
157+
158+1. Edit `package.json` to remove the `-beta` suffix from the version.
159+2. Commit that change and push it.
160+3. Use `git tag --force` to overwrite the previous tag (e.g. `0.19.0` - whatever you used before).
161+4. Force push the tag, e.g. `git push origin 0.19.0 --force-with-lease`.
162+5. `npm publish`
57163
58−You can read more about dist-tags [here](https://docs.npmjs.com/cli/dist-tag).
164+You're done! Now whenever anyone does `npm install -g elm` they'll get the
165+version you just uploaded.
59166
167+The reason we only used the `-beta` suffix for `npm` was so that when we ran
168+tests on the beta version, it was all against the same (non-beta) URLs we'd end
169+up using for the real version. This means there's no opportunity for us to
170+introduce some sort of mismatch between the beta that we verified and the real
171+version.
installers/npm/README.md+23−30
@@ -1,45 +1,38 @@
1−# Elm Installer
1+npm install elm [![Travis build Status](https://travis-ci.org/elm-lang/elm-platform.svg?branch=master)](http://travis-ci.org/elm-lang/elm-platform) [![AppVeyor build status](https://ci.appveyor.com/api/projects/status/6mcub79i04ianpm9/branch/master?svg=true)](https://ci.appveyor.com/project/rtfeldman/elm-platform/branch/master)
2+===============
23
3−[Elm](https://elm-lang.org) is a functional programming language that compiles to JavaScript.
4+Install the [Elm Platform](https://github.com/elm-lang/elm-platform) via [`npm`](https://www.npmjs.com).
45
5−Head over to [The Official Guide](https://guide.elm-lang.org/) to start learning Elm!
6+## Installing
67
8+Run this to get the binaries:
79
8−<br/>
9−
10−## What is this package for?
11−
12−**Normal installs** ❌
13−
14−Use the instructions [here](https://guide.elm-lang.org/install/elm.html) instead.
15−
16−**Multiple versions** ✅
17−
18−People using Elm at work may use different versions of Elm in different projects. They can run `npm install elm@latest-0.19.1` in each project and use the binary at `./node_modules/.bin/elm` for compilation.
19−
20−**Continuous integration** ⚠️
21−
22−This works, but there are usually faster and more reliable options:
23−
24−1. You can download `elm` directly from GitHub with [this script](https://github.com/elm/compiler/blob/master/installers/linux/README.md). This is all the `npm` installer does, but with extra HTTP requests to `npmjs.com` servers, making it slower and adding more failure points.
25−2. Many continuous integration have ways to cache files ([example](https://docs.travis-ci.com/user/caching/)) to make builds faster and more reliable.
26−
27−That said, it will definitely work to use the `npm` installer on CI if you prefer that option.
10+```
11+$ npm install -g elm
12+```
2813
14+## Installing behind a proxy server
2915
30−<br/>
16+If you are behind a proxy server, set the environment variable "HTTPS_PROXY".
3117
32−## Install Locally
18+```
19+$ export HTTPS_PROXY=$YourProxyServer$
20+$ npm install -g elm
21+```
3322
34−The following command should download the latest Elm 0.19.1 binary:
23+Or on Windows:
3524
3625```
37−npm install elm@latest-0.19.1
26+$ set HTTPS_PROXY=$YourProxyServer$
27+$ npm install -g elm
3828```
3929
40−You should be able to run `./node_modules/bin/elm --version` within your project and see `0.19.1`. Now you can compile with `./node_modules/bin/elm make src/Main.elm` and not disrupt other packages.
30+## Troubleshooting
4131
42−Use `npm install elm@latest-0.19.0` or `npm install elm@latest-0.18.0` for earlier versions.
32+1. [Troubleshooting npm](https://github.com/npm/npm/wiki/Troubleshooting)
33+2. On Debian/Ubuntu systems, you may have to install the nodejs-legacy package: `apt-get install nodejs-legacy`.
34+3. If the installer says that it cannot find any usable binaries for your operating system and architecture, check the [Build from Source](https://github.com/elm-lang/elm-platform/blob/master/README.md#build-from-source) documentation.
4335
44−**Note:** The `latest-X.Y.Z` convention is used in case we need to publish patches for the `npm` installer within a given Elm release. For example, say `npm` decides that some transitive dependency is not secure. Nothing is changing about Elm or the binaries, but we need to publish a new `npm` installer that fixes this issue.
36+## Getting Started
4537
38+Once everything has installed successfully, head over to the [Get Started](http://elm-lang.org/Get-Started.elm) page!
installers/npm/bin/elm+17−42
@@ -1,54 +1,29 @@
11#!/usr/bin/env node
22
33var child_process = require('child_process');
4−var path = require('path');
4+var download = require('../download.js');
55var fs = require('fs');
66
77
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.
8+// Some npm users enable --ignore-scripts (a good security measure)
119//
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.
10+// They do not run the post-install hook, so install.js does not run.
1611//
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.
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.
2616
2717
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−}
4518
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]);
4622
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−}
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+});
installers/npm/download.js+68−68
@@ -1,7 +1,7 @@
11var fs = require('fs');
22var package = require('./package.json');
3−var path = require('path');
4−var request = require('request');
3+var URL = require('url').URL;
4+var https = require('https');
55var zlib = require('zlib');
66
77
@@ -12,72 +12,88 @@ 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(callback)
15+module.exports = function(destinationPath, callback)
1616{
17− // figure out URL of binary
1817 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';
1922
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];
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+};
2628
27− verifyPlatform(version, platform);
2829
29− var url = 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + platform + '.gz';
3030
31− reportDownload(version, url);
31+// DOWNLOAD
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' : '');
3533
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);
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+ );
5766}
5867
5968
6069
61−// VERIFY PLATFORM
70+// HANDLE REDIRECTS
6271
6372
64−function verifyPlatform(version, platform)
73+function requestWithRedirects(url, maxRedirects, failure, success)
6574{
66− if (platform) return;
75+ var req = https.request(url);
76+
77+ req.on('response', function(response) {
78+ // Check for redirects
79+
80+ var redirectUrl = new URL(response.headers['location'], new URL(url).origin).href;
81+
82+ if (typeof redirectUrl === 'string' && response.statusCode >= 300 && response.statusCode < 400)
83+ {
84+ return (maxRedirects <= 0)
85+ ? failure(new Error('followed 10 redirects and gave up'))
86+ : requestWithRedirects(redirectUrl, maxRedirects - 1, failure, success);
87+ }
88+ else
89+ {
90+ return success(response);
91+ }
92+ });
6793
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);
94+ req.on('error', failure);
95+
96+ req.end();
8197}
8298
8399
@@ -96,19 +112,3 @@ function exitFailure(url, message)
96112 );
97113 process.exit(1);
98114}
99−
100−
101−
102−// REPORT DOWNLOAD
103−
104−
105−function reportDownload(version, url)
106−{
107− console.log(
108− '--------------------------------------------------------------------------------\n\n'
109− + 'Downloading Elm ' + version + ' from GitHub.'
110− + '\n\nNOTE: You can avoid npm entirely by downloading directly from:\n'
111− + url + '\nAll this package does is download that file and put it somewhere.\n\n'
112− + '--------------------------------------------------------------------------------\n'
113− );
114−}
installers/npm/install.js+7−1
@@ -1,4 +1,10 @@
11
22var download = require('./download.js');
3+var package = require('./package.json');
4+var path = require('path');
35
4−download(function() {});
6+
7+// get slashes right for Windows
8+var targetPath = path.resolve(__dirname, Object.values(package.bin)[0]);
9+
10+download(targetPath, function() {});
installers/npm/package.json+7−6
@@ -1,6 +1,6 @@
11{
22 "name": "elm",
3− "version": "0.19.1-5",
3+ "version": "0.19.0-no-deps",
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": "Evan Czaplicki",
15− "email": "evan@elm-lang.org",
16− "url": "https://github.com/evancz"
14+ "name": "Richard Feldman",
15+ "email": "richard.t.feldman@gmail.com",
16+ "url": "https://github.com/rtfeldman"
1717 },
1818 "engines": {
1919 "node": ">=7.0.0"
@@ -35,8 +35,9 @@
3535 "install",
3636 "installer"
3737 ],
38− "bin": { "elm": "bin/elm" },
38+ "bin": {
39+ "elm": "bin/elm"
40+ },
3941 "dependencies": {
40− "request": "^2.88.0"
4142 }
4243}
installers/npm/troubleshooting.mddeleted−76
@@ -1,76 +0,0 @@
1−# Troubleshooting
2−
3−I very highly recommend asking for help on [the Elm slack](https://elmlang.herokuapp.com).
4−
5−There are a lot of things that can go wrong when installing software, and it can really help to have a second pair of eyes on your situation!
6−
7−This document goes through a couple options that may help you out.
8−
9−<br/>
10−
11−
12−## Can you skip npm entirely?
13−
14−The most reliable way to get Elm installed using the official installers for Mac and Windows [here][download].
15−
16−You can also download the binaries directly. On Linux, you could do it in the terminal like this:
17−
18−```bash
19−cd ~/Desktop/
20−curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz
21−gunzip elm.gz # unzip the file
22−chmod +x elm # make the file executable
23−sudo mv elm /usr/local/bin/ # put the executable in a directory likely to be listed in your PATH variable
24−```
25−
26−If these exact commands do not work for you, you can try to do the same thing by hand.
27−
28−Read the section below on `PATH` variables if you are not sure what that is!
29−
30−[download]: https://github.com/elm/compiler/releases/tag/0.19.1
31−
32−<br/>
33−
34−
35−## Do you need to use npm for some reason?
36−
37−The company running npm has a list of common troubleshooting situations [here](https://npm.community/c/support/troubleshooting), but it may be better to just try to find your specific case on Stack Overflow. Often there are permissions issues where you may need to use `sudo` with some command.
38−
39−### Firewalls
40−
41−Some companies have a firewall.
42−
43−These companies usually have set the `HTTP_PROXY` or `HTTPS_PROXY` environment variable on your computer. This is more common with Windows computers.
44−
45−The result is that the request for `https://github.com/elm/compiler/releases/download/0.19.1/binary-for-windows-64-bit.gz` is being sent to a "proxy server" where they monitor traffic. Maybe they rule out certain domains, maybe they check data when it comes back from the actual URL, etc.
46−
47−It is probably best to ask someone about the situation on this, but you can test things out by temporarily using an alternate `HTTPS_PROXY` value with something like this:
48−
49−```
50−# Mac and Linux
51−HTTPS_PROXY=http://proxy.example.com npm install -g elm
52−
53−# Windows
54−set HTTPS_PROXY=http://proxy.example.com
55−npm install -g elm
56−```
57−
58−Check out [this document](https://www.npmjs.com/package/request#controlling-proxy-behaviour-using-environment-variables) for more information on how environment variables like `NO_PROXY`, `HTTP_PROXY`, and `HTTPS_PROXY` are handled by the npm.
59−
60−<br/>
61−
62−
63−## Do you know what a `PATH` variable is?
64−
65−When you run a command like `elm make src/Main.elm`, your computer starts by trying to find a file called `elm`.
66−
67−The `PATH` is a list of directories to search within. On Mac and Linux, you can see these directories by running:
68−
69−```
70−$ echo $PATH
71−/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/local/git/bin
72−```
73−
74−The are separated by `:` for some reason. So running `elm make src/Main.elm` starts by searching the `PATH` for files named `elm`. On my computer, it finds `/usr/local/bin/elm` and then can actually run the command.
75−
76−Is `elm` in one of the directories listed in your `PATH` variable? I recommend asking for help if you are in this scenario and unsure how to proceed.
installers/win/Nsisfile.nsi+16−16
@@ -75,7 +75,7 @@ Function un.onInit
7575FunctionEnd
7676
7777Function LaunchLink
78− ExecShell "open" "https://guide.elm-lang.org"
78+ ExecShell "open" "http://elm-lang.org/get-started"
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
@@ -261,4 +261,4 @@ Section "Uninstall"
261261 ; Update environment variables
262262 SendMessage ${HWND_BROADCAST} ${WM_SETTINGCHANGE} 0 "STR:Environment" /TIMEOUT=5000
263263
264−SectionEnd
264+SectionEnd
installers/win/README.md+3−18
@@ -1,24 +1,9 @@
1−# Installing on Windows
2−
3−The installer for Windows is available [here](https://guide.elm-lang.org/install.html).
4−
5−
6−<br/>
7−
8−## Uninstall
9−
10−First run the `C:\Program Files (x86)\Elm\0.19\uninstall.exe` file. This will remove Elm stuff from your `PATH`.
11−
12−Then remove the whole `C:\Users\<username>\AppData\Roaming\elm` directory. Elm caches some packages and build artifacts to reduce compile times and to help you work offline. Getting rid of this directory will clear that information out!
13−
14−<br/>
15−
16−## Building the Windows installer
1+# Building Windows installer
172
183You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.
194
205Once everything is installed, run something like this command:
216
22− make_installer.cmd 0.19.0
7+ make_installer.cmd 0.19
238
24−It will build an installer called `Elm-0.19.0-setup.exe`.
9+It will build an installer called `Elm-0.19-setup.exe`.
installers/win/file.iconew file

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

reactor/src/Index/Navigator.elm+1−1
@@ -19,7 +19,7 @@ view root dirs =
1919 , style "align-items" "center"
2020 , style "height" "40px"
2121 ]
22− (makeLinks root dirs "" [])
22+ (makeLinks root dirs "/" [])
2323
2424
2525makeLinks : String -> List String -> String -> List (Html msg) -> List (Html msg)
roadmap.mddeleted−29
@@ -1,29 +0,0 @@
1−# Roadmap
2−
3−If you like what you see now, that's pretty much what Elm is going to be for a while.
4−
5−I'm currently doing some exploratory work with compiler techniques and targets, but it is still too early to tell which parts of that might work out. I know many readers take "exploring X" as a promise that "X will definitely happen", so I want to be careful in setting expectations low since there is still so much uncertainty in the work. So while there is no real news to share at this point, I can give some expectations about future stability of Elm:
6−
7−**If this exploratory work goes well**, even in the wildest version of success, I wouldn't expect the language or core packages to change very much. Maybe two or three years down the line it could reveal something that'd be good to fix up, but I don't really foresee notable changes right now.
8−
9−**If this exploratory work does not work out**, I have some more conservative projects that are good ideas that I want to circle back to at some point. Things like:
10−
11−- add a constrained type variable `eq` to get rid of the runtime error for `(==)` on functions
12−- try to integrate `elm test` so it can run only tests that changed
13−- try to get `elm format` using the latest parsing infrastructure so it's not a perf bottleneck during development anymore
14−- do another round on perf because I have one last idea that can squeeze out a bit more speed
15−
16−These are all nice quality of life things, but with 0.19.0 and 0.19.1 taking so long, I got pretty burnt out on "incremental improvements that are good ideas, but take a very long time and aren't very exciting to non-Elm users." Without getting too into the details, I really needed to change things up before returning to these particular ideas.
17−
18−If someone has a security issue from the compiler or core libraries, please DM me about it on the Elm Slack. Outside of security issues, I think capacity for more discretionary changes will increase once the lessons from the compiler explorations become more clear. Hopefully the discussion [here](https://discourse.elm-lang.org/t/costs-funding-in-open-source-languages/5722) clarifies the thinking on these capacity questions a bit.
19−
20−<br>
21−<br>
22−
23−**Taking a step back**, I have found that working in this looser style has produced a high baseline of quality, and I think that is an important part of Elm. For example, all the error message work in Elm began as a project to implement the `--report=json` flag. That work happened to reveal some cool ideas on improving error messages, and if I had been using a rigid roadmap, I might have skipped those ideas to meet the publicly-stated arbitrary deadline. We'd have a clearer roadmap, but error messages no different than other type-inferred languages.
24−
25−So I think having more flexibility in planning is a competitive advantage for Elm in certain ways, but it is obviously a trade off that does not work for everyone. If someone needs more certainty, I generally recommend looking into other languages to see if they have a balance that works better for their needs. For example, languages made by big corporations are generally "less risky" on things like this, but I think you see the fruits of that kind of process in the design decisions as well. Trade offs!
26−
27−Anyway, like I said at the beginning, if you like what you see now, that's what it's going to be for a while. Even in the best case scenario with my current explorations!
28−
29−I hope this is helpful information, and I hope you have a good experience with Elm, even if you ultimately find a different language that works better for you!
terminal/src/Bump.hs+1−3
@@ -8,7 +8,6 @@ module Bump
88import qualified Data.List as List
99import qualified Data.NonEmptyList as NE
1010
11−import qualified BackgroundWriter as BW
1211import qualified Build
1312import qualified Deps.Bump as Bump
1413import qualified Deps.Diff as Diff
@@ -136,8 +135,7 @@ suggestVersion (Env root cache manager _ outline@(Outline.PkgOutline pkg _ _ vsn
136135generateDocs :: FilePath -> Outline.PkgOutline -> Task.Task Exit.Bump Docs.Documentation
137136generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) =
138137 do details <-
139− Task.eio Exit.BumpBadDetails $ BW.withScope $ \scope ->
140− Details.load Reporting.silent scope root
138+ Task.eio Exit.BumpBadDetails $ Details.load Reporting.silent root
141139
142140 case Outline.flattenExposed exposed of
143141 [] ->
terminal/src/Develop.hs+5−13
@@ -20,7 +20,6 @@ import Snap.Core hiding (path)
2020import Snap.Http.Server
2121import Snap.Util.FileServe
2222
23−import qualified BackgroundWriter as BW
2423import qualified Build
2524import qualified Elm.Details as Details
2625import qualified Develop.Generate.Help as Help
@@ -157,11 +156,11 @@ compile path =
157156 return $ Left $ Exit.ReactorNoOutline
158157
159158 Just root ->
160− BW.withScope $ \scope -> Stuff.withRootLock root $ Task.run $
161− do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
162− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])
159+ Stuff.withRootLock root $ Task.run $
160+ do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent root
161+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromMains Reporting.silent root details (NE.List path [])
163162 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts
164− let (NE.List name _) = Build.getRootNames artifacts
163+ let (NE.List name _) = Build.getMainNames artifacts
165164 return $ Html.sandwich name javascript
166165
167166
@@ -218,16 +217,13 @@ mimeTypeDict =
218217 , ".m3u" ==> "audio/x-mpegurl"
219218 , ".mov" ==> "video/quicktime"
220219 , ".mp3" ==> "audio/mpeg"
221− , ".mp4" ==> "video/mp4"
222220 , ".mpeg" ==> "video/mpeg"
223221 , ".mpg" ==> "video/mpeg"
224222 , ".ogg" ==> "application/ogg"
225− , ".otf" ==> "font/otf"
226223 , ".pac" ==> "application/x-ns-proxy-autoconfig"
227224 , ".pdf" ==> "application/pdf"
228225 , ".png" ==> "image/png"
229226 , ".qt" ==> "video/quicktime"
230− , ".sfnt" ==> "font/sfnt"
231227 , ".sig" ==> "application/pgp-signature"
232228 , ".spl" ==> "application/futuresplash"
233229 , ".svg" ==> "image/svg+xml"
@@ -238,16 +234,12 @@ mimeTypeDict =
238234 , ".tbz" ==> "application/x-bzip-compressed-tar"
239235 , ".text" ==> "text/plain"
240236 , ".tgz" ==> "application/x-tgz"
241− , ".ttf" ==> "font/ttf"
237+ , ".ttf" ==> "application/x-font-truetype"
242238 , ".txt" ==> "text/plain"
243239 , ".wav" ==> "audio/x-wav"
244240 , ".wax" ==> "audio/x-ms-wax"
245− , ".webm" ==> "video/webm"
246− , ".webp" ==> "image/webp"
247241 , ".wma" ==> "audio/x-ms-wma"
248242 , ".wmv" ==> "video/x-ms-wmv"
249− , ".woff" ==> "font/woff"
250− , ".woff2" ==> "font/woff2"
251243 , ".xbm" ==> "image/x-xbitmap"
252244 , ".xml" ==> "text/xml"
253245 , ".xpm" ==> "image/x-xpixmap"
terminal/src/Develop/Generate/Index.hs+2−4
@@ -13,7 +13,6 @@ import qualified Data.Map as Map
1313import qualified System.Directory as Dir
1414import System.FilePath ((</>), splitDirectories, takeExtension)
1515
16−import qualified BackgroundWriter as BW
1716import qualified Develop.Generate.Help as Help
1817import qualified Elm.Details as Details
1918import qualified Elm.Outline as Outline
@@ -168,13 +167,12 @@ getExactDeps maybeOutline =
168167 return Map.empty
169168
170169 Just root ->
171− BW.withScope $ \scope ->
172− do result <- Details.load Reporting.silent scope root
170+ do result <- Details.load Reporting.silent root
173171 case result of
174172 Left _ ->
175173 return Map.empty
176174
177− Right (Details.Details _ validOutline _ _ _ _) ->
175+ Right (Details.Details _ validOutline _ _ _) ->
178176 case validOutline of
179177 Details.ValidApp _ ->
180178 return Map.empty
terminal/src/Develop/StaticFiles/Build.hs+5−7
@@ -13,13 +13,12 @@ import qualified Data.NonEmptyList as NE
1313import qualified System.Directory as Dir
1414import System.FilePath ((</>))
1515
16−import qualified BackgroundWriter as BW
16+import qualified Reporting.Task as Task
1717import qualified Build
1818import qualified Elm.Details as Details
1919import qualified Generate
2020import qualified Reporting
2121import qualified Reporting.Exit as Exit
22−import qualified Reporting.Task as Task
2322
2423
2524
@@ -37,18 +36,17 @@ readAsset path =
3736
3837buildReactorFrontEnd :: IO BS.ByteString
3938buildReactorFrontEnd =
40− BW.withScope $ \scope ->
4139 Dir.withCurrentDirectory "reactor" $
4240 do root <- Dir.getCurrentDirectory
4341 runTaskUnsafe $
44− do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root
45− artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details paths
42+ do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent root
43+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromMains Reporting.silent root details mains
4644 javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts
4745 return (LBS.toStrict (B.toLazyByteString javascript))
4846
4947
50−paths :: NE.List FilePath
51−paths =
48+mains :: NE.List FilePath
49+mains =
5250 NE.List
5351 ("src" </> "NotFound.elm")
5452 [ "src" </> "Errors.elm"
terminal/src/Diff.hs+2−3
@@ -13,7 +13,6 @@ import qualified Data.Maybe as Maybe
1313import qualified Data.Name as Name
1414import qualified Data.NonEmptyList as NE
1515
16−import qualified BackgroundWriter as BW
1716import qualified Build
1817import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..))
1918import qualified Deps.Diff as DD
@@ -172,8 +171,8 @@ generateDocs (Env maybeRoot _ _ _) =
172171
173172 Just root ->
174173 do details <-
175− Task.eio Exit.DiffBadDetails $ BW.withScope $ \scope ->
176− Details.load Reporting.silent scope root
174+ Task.eio Exit.DiffBadDetails $
175+ Details.load Reporting.silent root
177176
178177 case Details._outline details of
179178 Details.ValidApp _ ->
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 (Outline.RelativeSrcDir "src") []) directs indirects Map.empty Map.empty
93+ Outline.AppOutline V.compiler (NE.List "src" []) directs indirects Map.empty Map.empty
9494 putStrLn "Okay, I created it. Now read that link!"
9595 return (Right ())
9696
terminal/src/Install.hs+11−13
@@ -10,7 +10,6 @@ import Data.Map ((!))
1010import qualified Data.Map as Map
1111import qualified Data.Map.Merge.Strict as Map
1212
13−import qualified BackgroundWriter as BW
1413import qualified Deps.Solver as Solver
1514import qualified Deps.Registry as Registry
1615import qualified Elm.Constraint as C
@@ -56,11 +55,11 @@ run args () =
5655 case oldOutline of
5756 Outline.App outline ->
5857 do changes <- makeAppPlan env pkg outline
59− attemptChanges root env oldOutline V.toChars changes
58+ attemptChanges root env pkg oldOutline V.toChars changes
6059
6160 Outline.Pkg outline ->
6261 do changes <- makePkgPlan env pkg outline
63− attemptChanges root env oldOutline C.toChars changes
62+ attemptChanges root env pkg oldOutline C.toChars changes
6463
6564
6665
@@ -77,14 +76,14 @@ data Changes vsn
7776type Task = Task.Task Exit.Install
7877
7978
80−attemptChanges :: FilePath -> Solver.Env -> Outline.Outline -> (a -> String) -> Changes a -> Task ()
81−attemptChanges root env oldOutline toChars changes =
79+attemptChanges :: FilePath -> Solver.Env -> Pkg.Name -> Outline.Outline -> (a -> String) -> Changes a -> Task ()
80+attemptChanges root env pkg oldOutline toChars changes =
8281 case changes of
8382 AlreadyInstalled ->
8483 Task.io $ putStrLn "It is already installed!"
8584
8685 PromoteIndirect newOutline ->
87− attemptChangesHelp root env oldOutline newOutline $
86+ attemptChangesHelp root env pkg oldOutline newOutline $
8887 D.vcat
8988 [ D.fillSep
9089 ["I","found","it","in","your","elm.json","file,"
@@ -97,7 +96,7 @@ attemptChanges root env oldOutline toChars changes =
9796 ]
9897
9998 PromoteTest newOutline ->
100− attemptChangesHelp root env oldOutline newOutline $
99+ attemptChangesHelp root env pkg oldOutline newOutline $
101100 D.vcat
102101 [ D.fillSep
103102 ["I","found","it","in","your","elm.json","file,"
@@ -114,7 +113,7 @@ attemptChanges root env oldOutline toChars changes =
114113 widths = Map.foldrWithKey (widen toChars) (Widths 0 0 0) changeDict
115114 changeDocs = Map.foldrWithKey (addChange toChars widths) (Docs [] [] []) changeDict
116115 in
117− attemptChangesHelp root env oldOutline newOutline $ D.vcat $
116+ attemptChangesHelp root env pkg oldOutline newOutline $ D.vcat $
118117 [ "Here is my plan:"
119118 , viewChangeDocs changeDocs
120119 , ""
@@ -122,15 +121,14 @@ attemptChanges root env oldOutline toChars changes =
122121 ]
123122
124123
125−attemptChangesHelp :: FilePath -> Solver.Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task ()
126−attemptChangesHelp root env oldOutline newOutline question =
127− Task.eio Exit.InstallBadDetails $
128− BW.withScope $ \scope ->
124+attemptChangesHelp :: FilePath -> Solver.Env -> Pkg.Name -> Outline.Outline -> Outline.Outline -> D.Doc -> Task ()
125+attemptChangesHelp root env pkg oldOutline newOutline question =
126+ Task.eio (\_ -> Exit.InstallHasBadDetails pkg (Outline.encode newOutline)) $
129127 do approved <- Reporting.ask question
130128 if approved
131129 then
132130 do Outline.write root newOutline
133− result <- Details.verifyInstall scope root env newOutline
131+ result <- Details.verifyInstall root env newOutline
134132 case result of
135133 Left exit ->
136134 do Outline.write root oldOutline
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
16−import Terminal.Helpers
15+import Terminal.Args
16+import Terminal.Args.Helpers
1717
1818import qualified Bump
1919import qualified Develop
@@ -31,7 +31,7 @@ import qualified Repl
3131
3232main :: IO ()
3333main =
34− Terminal.app intro outro
34+ complex intro outro
3535 [ repl
3636 , init
3737 , reactor
@@ -72,7 +72,7 @@ outro =
7272-- INIT
7373
7474
75−init :: Terminal.Command
75+init :: Interface
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− Terminal.Command "init" (Common summary) details example noArgs noFlags Init.run
90+ Interface "init" (Common summary) details example noArgs noFlags Init.run
9191
9292
9393
9494-- REPL
9595
9696
97−repl :: Terminal.Command
97+repl :: Interface
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− Terminal.Command "repl" (Common summary) details example noArgs replFlags Repl.run
118+ Interface "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 :: Terminal.Command
136+reactor :: Interface
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− Terminal.Command "reactor" (Common summary) details example noArgs reactorFlags Develop.run
157+ Interface "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 :: Terminal.Command
175+make :: Interface
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− Terminal.Command "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run
199+ Interface "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run
200200
201201
202202
203203-- INSTALL
204204
205205
206−install :: Terminal.Command
206+install :: Interface
207207install =
208208 let
209209 details =
@@ -232,14 +232,14 @@ install =
232232 , require1 Install.Install package
233233 ]
234234 in
235− Terminal.Command "install" Uncommon details example installArgs noFlags Install.run
235+ Interface "install" Uncommon details example installArgs noFlags Install.run
236236
237237
238238
239239-- PUBLISH
240240
241241
242−publish :: Terminal.Command
242+publish :: Interface
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− Terminal.Command "publish" Uncommon details example noArgs noFlags Publish.run
272+ Interface "publish" Uncommon details example noArgs noFlags Publish.run
273273
274274
275275
276276-- BUMP
277277
278278
279−bump :: Terminal.Command
279+bump :: Interface
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− Terminal.Command "bump" Uncommon details example noArgs noFlags Bump.run
292+ Interface "bump" Uncommon details example noArgs noFlags Bump.run
293293
294294
295295
296296-- DIFF
297297
298298
299−diff :: Terminal.Command
299+diff :: Interface
300300diff =
301301 let
302302 details =
@@ -321,7 +321,7 @@ diff =
321321 , require3 Diff.GlobalInquiry package version version
322322 ]
323323 in
324− Terminal.Command "diff" Uncommon details example diffArgs noFlags Diff.run
324+ Interface "diff" Uncommon details example diffArgs noFlags Diff.run
325325
326326
327327
terminal/src/Make.hs+19−23
@@ -14,11 +14,9 @@ module Make
1414import qualified Data.ByteString.Builder as B
1515import qualified Data.Maybe as Maybe
1616import qualified Data.NonEmptyList as NE
17−import qualified System.Directory as Dir
1817import qualified System.FilePath as FP
1918
2019import qualified AST.Optimized as Opt
21−import qualified BackgroundWriter as BW
2220import qualified Build
2321import qualified Elm.Details as Details
2422import qualified Elm.ModuleName as ModuleName
@@ -29,7 +27,7 @@ import qualified Reporting
2927import qualified Reporting.Exit as Exit
3028import qualified Reporting.Task as Task
3129import qualified Stuff
32−import Terminal (Parser(..))
30+import Terminal.Args (Parser(..))
3331
3432
3533
@@ -75,10 +73,9 @@ run paths flags@(Flags _ _ _ report _) =
7573
7674runHelp :: FilePath -> [FilePath] -> Reporting.Style -> Flags -> IO (Either Exit.Make ())
7775runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
78− BW.withScope $ \scope ->
7976 Stuff.withRootLock root $ Task.run $
8077 do desiredMode <- getMode debug optimize
81− details <- Task.eio Exit.MakeBadDetails (Details.load style scope root)
78+ details <- Task.eio Exit.MakeBadDetails (Details.load style root)
8279 case paths of
8380 [] ->
8481 do exposed <- getExposed details
@@ -107,7 +104,7 @@ runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =
107104 case getNoMains artifacts of
108105 [] ->
109106 do builder <- toBuilder root details desiredMode artifacts
110− generate style target builder (Build.getRootNames artifacts)
107+ generate style target builder (Build.getMainNames artifacts)
111108
112109 name:names ->
113110 Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)
@@ -139,7 +136,7 @@ getMode debug optimize =
139136
140137
141138getExposed :: Details.Details -> Task (NE.List ModuleName.Raw)
142−getExposed (Details.Details _ validOutline _ _ _ _) =
139+getExposed (Details.Details _ validOutline _ _ _) =
143140 case validOutline of
144141 Details.ValidApp _ ->
145142 Task.throw Exit.MakeAppNeedsFileNames
@@ -166,7 +163,7 @@ buildExposed style root details maybeDocs exposed =
166163buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts
167164buildPaths style root details paths =
168165 Task.eio Exit.MakeCannotBuild $
169− Build.fromPaths style root details paths
166+ Build.fromMains style root details paths
170167
171168
172169
@@ -174,13 +171,13 @@ buildPaths style root details paths =
174171
175172
176173getMains :: Build.Artifacts -> [ModuleName.Raw]
177−getMains (Build.Artifacts _ _ roots modules) =
178− Maybe.mapMaybe (getMain modules) (NE.toList roots)
174+getMains (Build.Artifacts _ _ mains modules) =
175+ Maybe.mapMaybe (getMain modules) (NE.toList mains)
179176
180177
181−getMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw
182−getMain modules root =
183− case root of
178+getMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw
179+getMain modules main =
180+ case main of
184181 Build.Inside name ->
185182 if any (isMain name) modules
186183 then Just name
@@ -207,9 +204,9 @@ isMain targetName modul =
207204
208205
209206hasOneMain :: Build.Artifacts -> Task ModuleName.Raw
210−hasOneMain (Build.Artifacts _ _ roots modules) =
211− case roots of
212− NE.List root [] -> Task.mio Exit.MakeNoMain (return $ getMain modules root)
207+hasOneMain (Build.Artifacts _ _ mains modules) =
208+ case mains of
209+ NE.List main [] -> Task.mio Exit.MakeNoMain (return $ getMain modules main)
213210 NE.List _ (_:_) -> Task.throw Exit.MakeMultipleFilesIntoHtml
214211
215212
@@ -218,13 +215,13 @@ hasOneMain (Build.Artifacts _ _ roots modules) =
218215
219216
220217getNoMains :: Build.Artifacts -> [ModuleName.Raw]
221−getNoMains (Build.Artifacts _ _ roots modules) =
222− Maybe.mapMaybe (getNoMain modules) (NE.toList roots)
218+getNoMains (Build.Artifacts _ _ mains modules) =
219+ Maybe.mapMaybe (getNoMain modules) (NE.toList mains)
223220
224221
225−getNoMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw
226−getNoMain modules root =
227− case root of
222+getNoMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw
223+getNoMain modules main =
224+ case main of
228225 Build.Inside name ->
229226 if any (isMain name) modules
230227 then Nothing
@@ -243,8 +240,7 @@ getNoMain modules root =
243240generate :: Reporting.Style -> FilePath -> B.Builder -> NE.List ModuleName.Raw -> Task ()
244241generate style target builder names =
245242 Task.io $
246− do Dir.createDirectoryIfMissing True (FP.takeDirectory target)
247− File.writeBuilder target builder
243+ do File.writeBuilder target builder
248244 Reporting.reportGenerate style names target
249245
250246
terminal/src/Publish.hs+12−27
@@ -17,7 +17,6 @@ import qualified System.Info as Info
1717import qualified System.IO as IO
1818import qualified System.Process as Process
1919
20−import qualified BackgroundWriter as BW
2120import qualified Build
2221import qualified Deps.Bump as Bump
2322import qualified Deps.Diff as Diff
@@ -171,11 +170,10 @@ verifyLicense root =
171170
172171verifyBuild :: FilePath -> Task.Task Exit.Publish Docs.Documentation
173172verifyBuild root =
174− reportBuildCheck $ BW.withScope $ \scope ->
175− Task.run $
176− do details@(Details.Details _ outline _ _ _ _) <-
173+ reportBuildCheck $ Task.run $
174+ do details@(Details.Details _ outline _ _ _) <-
177175 Task.eio Exit.PublishBadDetails $
178− Details.load Reporting.silent scope root
176+ Details.load Reporting.silent root
179177
180178 exposed <-
181179 case outline of
@@ -198,21 +196,8 @@ getGit :: Task.Task Exit.Publish Git
198196getGit =
199197 do maybeGit <- Task.io $ Dir.findExecutable "git"
200198 case maybeGit of
201− Nothing ->
202− Task.throw Exit.PublishNoGit
203−
204− Just git ->
205− return $ Git $ \args ->
206− let
207− process =
208− (Process.proc git args)
209− { Process.std_in = Process.CreatePipe
210− , Process.std_out = Process.CreatePipe
211− , Process.std_err = Process.CreatePipe
212− }
213− in
214− Process.withCreateProcess process $ \_ _ _ handle ->
215− Process.waitForProcess handle
199+ Just git -> return (Git (Process.rawSystem git))
200+ Nothing -> Task.throw Exit.PublishNoGit
216201
217202
218203
@@ -230,7 +215,7 @@ verifyTag git manager pkg vsn =
230215
231216 Exit.ExitSuccess ->
232217 let url = toTagUrl pkg vsn in
233− Http.get manager url [Http.accept "application/json"] (Exit.PublishCannotGetTag vsn) $ \body ->
218+ Http.post manager url [Http.accept "application/json"] (Exit.PublishCannotGetTag vsn) $ \body ->
234219 case D.fromByteString commitHashDecoder body of
235220 Right hash ->
236221 return $ Right hash
@@ -270,7 +255,7 @@ verifyNoChanges git commitHash vsn =
270255
271256verifyZip :: Env -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha
272257verifyZip (Env root _ manager _ _) pkg vsn =
273− withPrepublishDir root $ \prepublishDir ->
258+ withTempDir root $ \prepublishDir ->
274259 do let url = toZipUrl pkg vsn
275260
276261 (sha, archive) <-
@@ -294,8 +279,8 @@ toZipUrl pkg vsn =
294279 "https://github.com/" ++ Pkg.toUrl pkg ++ "/zipball/" ++ V.toChars vsn ++ "/"
295280
296281
297−withPrepublishDir :: FilePath -> (FilePath -> Task.Task x a) -> Task.Task x a
298−withPrepublishDir root callback =
282+withTempDir :: FilePath -> (FilePath -> Task.Task x a) -> Task.Task x a
283+withTempDir root callback =
299284 let
300285 dir = Stuff.prepublishDir root
301286 in
@@ -308,10 +293,10 @@ withPrepublishDir root callback =
308293
309294verifyZipBuild :: FilePath -> IO (Either Exit.Publish ())
310295verifyZipBuild root =
311− BW.withScope $ \scope -> Task.run $
312− do details@(Details.Details _ outline _ _ _ _) <-
296+ Task.run $
297+ do details@(Details.Details _ outline _ _ _) <-
313298 Task.eio Exit.PublishZipBadDetails $
314− Details.load Reporting.silent scope root
299+ Details.load Reporting.silent root
315300
316301 exposed <-
317302 case outline of
terminal/src/Repl.hs+60−188
@@ -3,16 +3,6 @@
33module Repl
44 ( Flags(..)
55 , run
6− --
7− , Lines(..)
8− , Input(..)
9− , Prefill(..)
10− , CategorizedInput(..)
11− , categorize
12− --
13− , State(..)
14− , Output(..)
15− , toByteString
166 )
177 where
188
@@ -39,7 +29,6 @@ import qualified System.IO as IO
3929import qualified System.Process as Proc
4030
4131import qualified AST.Source as Src
42−import qualified BackgroundWriter as BW
4332import qualified Build
4433import qualified Elm.Constraint as C
4534import qualified Elm.Details as Details
@@ -53,9 +42,6 @@ import qualified Parse.Expression as PE
5342import qualified Parse.Declaration as PD
5443import qualified Parse.Module as PM
5544import qualified Parse.Primitives as P
56−import qualified Parse.Space as PS
57−import qualified Parse.Type as PT
58−import qualified Parse.Variable as PV
5945import Parse.Primitives (Row, Col)
6046import qualified Reporting
6147import qualified Reporting.Annotation as A
@@ -174,110 +160,31 @@ data Input
174160
175161read :: Repl.InputT M Input
176162read =
177− do maybeLine <- Repl.getInputLine "> "
178− case maybeLine of
163+ do line <- Repl.getInputLine "> "
164+ case line of
179165 Nothing ->
180166 return Exit
181167
182168 Just chars ->
183− let
184− lines = Lines (stripLegacyBackslash chars) []
185− in
186− case categorize lines of
169+ case categorize chars of
187170 Done input -> return input
188− Continue p -> readMore lines p
171+ Continue -> readMore chars
189172
190173
191−readMore :: Lines -> Prefill -> Repl.InputT M Input
192−readMore previousLines prefill =
193− do input <- Repl.getInputLineWithInitial "| " (renderPrefill prefill, "")
174+readMore :: [Char] -> Repl.InputT M Input
175+readMore previousLines =
176+ do input <- Repl.getInputLineWithInitial "| " (" ","")
194177 case input of
195178 Nothing ->
196179 return Skip
197180
198181 Just chars ->
199182 let
200− lines = addLine (stripLegacyBackslash chars) previousLines
183+ allLines = previousLines ++ '\n' : chars
201184 in
202− case categorize lines of
185+ case categorize allLines of
203186 Done input -> return input
204− Continue p -> readMore lines p
205−
206−
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−
224−data Prefill
225− = Indent
226− | DefStart N.Name
227−
228−
229−renderPrefill :: Prefill -> String
230−renderPrefill lineStart =
231− case lineStart of
232− Indent ->
233− " "
234−
235− DefStart name ->
236− N.toChars name ++ " "
237−
238−
239−
240−-- LINES
241−
242−
243−data Lines =
244− Lines
245− { _prevLine :: String
246− , _revLines :: [String]
247− }
248−
249−
250−addLine :: [Char] -> Lines -> Lines
251−addLine line (Lines x xs) =
252− Lines line (x:xs)
253−
254−
255−isBlank :: Lines -> Bool
256−isBlank (Lines prev rev) =
257− null rev && all (==' ') prev
258−
259−
260−isSingleLine :: Lines -> Bool
261−isSingleLine (Lines _ rev) =
262− null rev
263−
264−
265−endsWithBlankLine :: Lines -> Bool
266−endsWithBlankLine (Lines prev _) =
267− all (==' ') prev
268−
269−
270−linesToByteString :: Lines -> BS_UTF8.ByteString
271−linesToByteString (Lines prev rev) =
272− BS_UTF8.fromString (unlines (reverse (prev:rev)))
273−
274−
275−getFirstLine :: Lines -> String
276−getFirstLine (Lines x xs) =
277− case xs of
278− [] -> x
279− y:ys -> getFirstLine (Lines y ys)
280−
187+ Continue -> readMore allLines
281188
282189
283190
@@ -286,21 +193,21 @@ getFirstLine (Lines x xs) =
286193
287194data CategorizedInput
288195 = Done Input
289− | Continue Prefill
196+ | Continue
290197
291198
292−categorize :: Lines -> CategorizedInput
293−categorize lines
294− | isBlank lines = Done Skip
295− | startsWithColon lines = Done (toCommand lines)
296− | startsWithKeyword "import" lines = attemptImport lines
297− | otherwise = attemptDeclOrExpr lines
199+categorize :: [Char] -> CategorizedInput
200+categorize chars
201+ | all (==' ') chars = Done Skip
202+ | startsWithColon chars = Done (toCommand chars)
203+ | startsWithKeyword "import" chars = attemptImport chars
204+ | otherwise = attemptDeclOrExpr chars
298205
299206
300−attemptImport :: Lines -> CategorizedInput
301−attemptImport lines =
207+attemptImport :: [Char] -> CategorizedInput
208+attemptImport chars =
302209 let
303− src = linesToByteString lines
210+ src = BS_UTF8.fromString (chars ++ "\n")
304211 parser = P.specialize (\_ _ _ -> ()) PM.chompImport
305212 in
306213 case P.fromByteString parser (\_ _ -> ()) src of
@@ -308,69 +215,63 @@ attemptImport lines =
308215 Done (Import name src)
309216
310217 Left () ->
311− ifFail lines (Import "ERR" src)
312−
313−
314−ifFail :: Lines -> Input -> CategorizedInput
315−ifFail lines input =
316− if endsWithBlankLine lines
317− then Done input
318− else Continue Indent
218+ if endsWithBlankLine chars
219+ then Done (Import "ERR" src)
220+ else Continue
319221
320222
321−ifDone :: Lines -> Input -> CategorizedInput
322−ifDone lines input =
323− if isSingleLine lines || endsWithBlankLine lines
324− then Done input
325− else Continue Indent
326−
327−
328−attemptDeclOrExpr :: Lines -> CategorizedInput
329−attemptDeclOrExpr lines =
223+attemptDeclOrExpr :: [Char] -> CategorizedInput
224+attemptDeclOrExpr chars =
330225 let
331− src = linesToByteString lines
226+ src = BS_UTF8.fromString (chars ++ "\n")
332227 exprParser = P.specialize (toExprPosition src) PE.expression
333228 declParser = P.specialize (toDeclPosition src) PD.declaration
334229 in
335230 case P.fromByteString declParser (,) src of
336231 Right (decl, _) ->
337232 case decl of
338− PD.Value _ (A.At _ (Src.Value (A.At _ name) _ _ _)) -> ifDone lines (Decl name src)
339− PD.Union _ (A.At _ (Src.Union (A.At _ name) _ _ )) -> ifDone lines (Type name src)
340− PD.Alias _ (A.At _ (Src.Alias (A.At _ name) _ _ )) -> ifDone lines (Type name src)
233+ PD.Value _ (A.At _ (Src.Value (A.At _ name) _ _ _)) -> Done (Decl name src)
234+ PD.Union _ (A.At _ (Src.Union (A.At _ name) _ _ )) -> Done (Type name src)
235+ PD.Alias _ (A.At _ (Src.Alias (A.At _ name) _ _ )) -> Done (Type name src)
341236 PD.Port _ _ -> Done Port
342237
343238 Left declPosition
344− | startsWithKeyword "type" lines ->
345− ifFail lines (Type "ERR" src)
239+ | startsWithKeyword "type" chars ->
240+ if endsWithBlankLine chars
241+ then Done (Type "ERR" src)
242+ else Continue
346243
347− | startsWithKeyword "port" lines ->
244+ | startsWithKeyword "port" chars ->
348245 Done Port
349246
350247 | otherwise ->
351248 case P.fromByteString exprParser (,) src of
352249 Right _ ->
353− ifDone lines (Expr src)
250+ Done (Expr src)
354251
355252 Left exprPosition ->
356− if exprPosition >= declPosition then
357− ifFail lines (Expr src)
358− else
359− case P.fromByteString annotation (\_ _ -> ()) src of
360− Right name -> Continue (DefStart name)
361− Left () -> ifFail lines (Decl "ERR" src)
253+ if endsWithBlankLine chars
254+ then Done (if declPosition <= exprPosition then Expr src else Decl "ERR" src)
255+ else Continue
256+
362257
258+endsWithBlankLine :: [Char] -> Bool
259+endsWithBlankLine chars =
260+ case reverse (List.lines chars) of
261+ [] -> False
262+ cs:_ -> all (==' ') cs
363263
364−startsWithColon :: Lines -> Bool
365−startsWithColon lines =
366− case dropWhile (==' ') (getFirstLine lines) of
264+
265+startsWithColon :: [Char] -> Bool
266+startsWithColon chars =
267+ case dropWhile (==' ') chars of
367268 [] -> False
368269 c:_ -> c == ':'
369270
370271
371−toCommand :: Lines -> Input
372−toCommand lines =
373− case drop 1 $ dropWhile (==' ') (getFirstLine lines) of
272+toCommand :: [Char] -> Input
273+toCommand chars =
274+ case drop 1 $ dropWhile (==' ') chars of
374275 "reset" -> Reset
375276 "exit" -> Exit
376277 "quit" -> Exit
@@ -378,11 +279,8 @@ toCommand lines =
378279 rest -> Help (Just (takeWhile (/=' ') rest))
379280
380281
381−startsWithKeyword :: [Char] -> Lines -> Bool
382−startsWithKeyword keyword lines =
383− let
384− line = getFirstLine lines
385− in
282+startsWithKeyword :: [Char] -> [Char] -> Bool
283+startsWithKeyword keyword line =
386284 List.isPrefixOf keyword line &&
387285 case drop (length keyword) line of
388286 [] -> True
@@ -408,21 +306,6 @@ toDeclPosition src decl r c =
408306 (row, col)
409307
410308
411−annotation :: P.Parser () N.Name
412−annotation =
413− let
414− err _ _ = ()
415− err_ _ _ _ = ()
416− in
417− do name <- PV.lower err
418− PS.chompAndCheckIndent err_ err
419− P.word1 0x3A {-:-} err
420− PS.chompAndCheckIndent err_ err
421− (_, _) <- P.specialize err_ PT.expression
422− PS.checkFreshLine err
423− return name
424−
425−
426309
427310-- STATE
428311
@@ -494,12 +377,10 @@ data Output
494377
495378attemptEval :: Env -> State -> State -> Output -> IO State
496379attemptEval (Env root interpreter ansi) oldState newState output =
497− do result <-
498− BW.withScope $ \scope ->
499− Stuff.withRootLock root $ Task.run $
380+ do result <- Stuff.withRootLock root $ Task.run $
500381 do details <-
501382 Task.eio Exit.ReplBadDetails $
502− Details.load Reporting.silent scope root
383+ Details.load Reporting.silent root
503384
504385 artifacts <-
505386 Task.eio id $
@@ -551,16 +432,16 @@ toByteString (State imports types decls) output =
551432
552433outputToBuilder :: Output -> B.Builder
553434outputToBuilder output =
554− N.toBuilder N.replValueToPrint <> " =" <>
555435 case output of
556436 OutputNothing ->
557− " ()\n"
437+ mempty
558438
559439 OutputDecl _ ->
560− " ()\n"
440+ mempty
561441
562442 OutputExpr expr ->
563− foldr (\line rest -> "\n " <> B.byteString line <> rest) "\n" (BSC.lines expr)
443+ N.toBuilder N.replValueToPrint <> " ="
444+ <> foldr (\line rest -> "\n " <> B.byteString line <> rest) "\n" (BSC.lines expr)
564445
565446
566447
@@ -622,22 +503,13 @@ getRoot =
622503 Licenses.bsd3
623504 V.one
624505 (Outline.ExposedList [])
625− defaultDeps
506+ (Map.singleton Pkg.core C.anything)
626507 Map.empty
627508 C.defaultElm
628509
629510 return root
630511
631512
632−defaultDeps :: Map.Map Pkg.Name C.Constraint
633−defaultDeps =
634− Map.fromList
635− [ (Pkg.core, C.anything)
636− , (Pkg.json, C.anything)
637− , (Pkg.html, C.anything)
638− ]
639−
640−
641513
642514-- GET INTERPRETER
643515
terminal/impl/Terminal.hs → terminal/src/Terminal/Args.hsrenamed+25−28
@@ -1,7 +1,8 @@
1−module Terminal
2− ( app
3− , Command(..)
1+module Terminal.Args
2+ ( simple
3+ , Interface(..)
44 , Summary(..)
5+ , complex
56 , Flags, noFlags, flags, (|--)
67 , Flag, flag, onOff
78 , Parser(..)
@@ -25,17 +26,17 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P
2526import qualified Text.Read as Read
2627
2728import qualified Elm.Version as V
28−import Terminal.Internal
29−import qualified Terminal.Chomp as Chomp
30−import qualified Terminal.Error as Error
29+import Terminal.Args.Internal
30+import qualified Terminal.Args.Chomp as Chomp
31+import qualified Terminal.Args.Error as Error
3132
3233
3334
34−-- COMMAND
35+-- GET
3536
3637
37−_command :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()
38−_command details example args_ flags_ callback =
38+simple :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()
39+simple details example args_ flags_ callback =
3940 do setLocaleEncoding utf8
4041 argStrings <- Env.getArgs
4142 case argStrings of
@@ -56,38 +57,34 @@ _command details example args_ flags_ callback =
5657 Error.exitWithError err
5758
5859
59−
60−-- APP
61−
62−
63−app :: P.Doc -> P.Doc -> [Command] -> IO ()
64−app intro outro commands =
60+complex :: P.Doc -> P.Doc -> [Interface] -> IO ()
61+complex intro outro interfaces =
6562 do setLocaleEncoding utf8
6663 argStrings <- Env.getArgs
6764 case argStrings of
6865 [] ->
69− Error.exitWithOverview intro outro commands
66+ Error.exitWithOverview intro outro interfaces
7067
7168 ["--help"] ->
72− Error.exitWithOverview intro outro commands
69+ Error.exitWithOverview intro outro interfaces
7370
7471 ["--version"] ->
7572 do hPutStrLn stdout (V.toChars V.compiler)
7673 Exit.exitSuccess
7774
7875 command : chunks ->
79− do case List.find (\cmd -> toName cmd == command) commands of
76+ do case List.find (\iface -> toName iface == command) interfaces of
8077 Nothing ->
81− Error.exitWithUnknown command (map toName commands)
78+ Error.exitWithUnknown command (map toName interfaces)
8279
83− Just (Command _ _ details example args_ flags_ callback) ->
80+ Just (Interface _ _ details example args_ flags_ callback) ->
8481 if elem "--help" chunks then
8582 Error.exitWithHelp (Just command) details example args_ flags_
8683
8784 else
8885 case snd $ Chomp.chomp Nothing chunks args_ flags_ of
89− Right (argsValue, flagsValue) ->
90− callback argsValue flagsValue
86+ Right (argsValue, flagValue) ->
87+ callback argsValue flagValue
9188
9289 Left err ->
9390 Error.exitWithError err
@@ -162,21 +159,21 @@ findIndex index point chunks =
162159 findIndex (index + 1) point cs
163160
164161
165−_complexSuggest :: [Command] -> Int -> [String] -> IO [String]
166−_complexSuggest commands index strings =
162+_complexSuggest :: [Interface] -> Int -> [String] -> IO [String]
163+_complexSuggest interfaces index strings =
167164 case strings of
168165 [] ->
169− return (map toName commands)
166+ return (map toName interfaces)
170167
171168 command : chunks ->
172169 if index == 1 then
173− return (filter (List.isPrefixOf command) (map toName commands))
170+ return (filter (List.isPrefixOf command) (map toName interfaces))
174171 else
175− case List.find (\cmd -> toName cmd == command) commands of
172+ case List.find (\iface -> toName iface == command) interfaces of
176173 Nothing ->
177174 return []
178175
179− Just (Command _ _ _ _ args_ flags_ _) ->
176+ Just (Interface _ _ _ _ args_ flags_ _) ->
180177 fst $ Chomp.chomp (Just (index-1)) chunks args_ flags_
181178
182179
terminal/impl/Terminal/Chomp.hs → terminal/src/Terminal/Args/Chomp.hsrenamed+5−4
@@ -1,5 +1,6 @@
1−{-# LANGUAGE GADTs, Rank2Types #-}
2−module Terminal.Chomp
1+{-# LANGUAGE GADTs #-}
2+{-# LANGUAGE Rank2Types #-}
3+module Terminal.Args.Chomp
34 ( chomp
45 )
56 where
@@ -7,8 +8,8 @@ module Terminal.Chomp
78
89import qualified Data.List as List
910
10−import Terminal.Error
11−import Terminal.Internal
11+import Terminal.Args.Error
12+import Terminal.Args.Internal
1213
1314
1415
terminal/impl/Terminal/Error.hs → terminal/src/Terminal/Args/Error.hsrenamed+18−28
@@ -1,5 +1,6 @@
1−{-# LANGUAGE GADTs, OverloadedStrings #-}
2−module Terminal.Error
1+{-# LANGUAGE GADTs #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+module Terminal.Args.Error
34 ( Error(..)
45 , ArgError(..)
56 , FlagError(..)
@@ -23,7 +24,7 @@ import System.IO (hPutStrLn, stderr)
2324import qualified Text.PrettyPrint.ANSI.Leijen as P
2425
2526import Reporting.Suggest as Suggest
26−import Terminal.Internal
27+import Terminal.Args.Internal
2728
2829
2930
@@ -186,22 +187,22 @@ flagsToDocs flags docs =
186187-- OVERVIEW
187188
188189
189−exitWithOverview :: P.Doc -> P.Doc -> [Command] -> IO a
190−exitWithOverview intro outro commands =
190+exitWithOverview :: P.Doc -> P.Doc -> [Interface] -> IO a
191+exitWithOverview intro outro interfaces =
191192 do exeName <- getExeName
192193 exitSuccess
193194 [ intro
194195 , "The most common commands are:"
195− , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) commands
196+ , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) interfaces
196197 , "There are a bunch of other commands as well though. Here is a full list:"
197− , P.indent 4 $ P.dullcyan $ toCommandList exeName commands
198+ , P.indent 4 $ P.dullcyan $ toCommandList exeName interfaces
198199 , "Adding the --help flag gives a bunch of additional details about each one."
199200 , outro
200201 ]
201202
202203
203−toSummary :: String -> Command -> Maybe P.Doc
204−toSummary exeName (Command name summary _ _ (Args args) _ _) =
204+toSummary :: String -> Interface -> Maybe P.Doc
205+toSummary exeName (Interface name summary _ _ (Args args) _ _) =
205206 case summary of
206207 Uncommon ->
207208 Nothing
@@ -214,10 +215,10 @@ toSummary exeName (Command name summary _ _ (Args args) _ _) =
214215 ]
215216
216217
217−toCommandList :: String -> [Command] -> P.Doc
218−toCommandList exeName commands =
218+toCommandList :: String -> [Interface] -> P.Doc
219+toCommandList exeName interfaces =
219220 let
220− names = map toName commands
221+ names = map toName interfaces
221222 width = maximum (map length names)
222223
223224 toExample name =
@@ -271,24 +272,13 @@ exitWithError err =
271272 BadArgs argErrors ->
272273 case argErrors of
273274 [] ->
274− return
275− [ reflow $ "I was not expecting any arguments for this command."
276− , reflow $ "Try removing them?"
277− ]
275+ error "TODO no possible args"
278276
279277 [(_args, argError)] ->
280278 argErrorToDocs argError
281279
282280 _:_:_ ->
283− argErrorToDocs $ head $ List.sortOn toArgErrorRank (map snd argErrors)
284−
285−
286−toArgErrorRank :: ArgError -> Int -- lower is better
287−toArgErrorRank err =
288− case err of
289− ArgBad _ _ -> 0
290− ArgMissing _ -> 1
291− ArgExtras _ -> 2
281+ error "TODO show possible arg configurations"
292282
293283
294284toGreen :: String -> P.Doc
@@ -328,10 +318,10 @@ argErrorToDocs argError =
328318 return
329319 [ "I am having trouble with this argument:"
330320 , P.indent 4 $ toRed string
331− , P.fillSep $
321+ , P.fillSep
332322 ["It","is","supposed","to","be","a"
333− ,toYellow (toToken tipe),"value,","like"
334− ] ++ if length examples == 1 then ["this:"] else ["one","of","these:"]
323+ ,toYellow (toToken tipe),"value,","like","this:"
324+ ]
335325 , P.indent 4 $ P.green $ P.vcat $ map P.text examples
336326 ]
337327
terminal/impl/Terminal/Helpers.hs → terminal/src/Terminal/Args/Helpers.hsrenamed+7−20
@@ -1,5 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2−module Terminal.Helpers
2+module Terminal.Args.Helpers
33 ( version
44 , elmFile
55 , package
@@ -14,13 +14,12 @@ import qualified Data.Map as Map
1414import qualified Data.Utf8 as Utf8
1515import qualified System.FilePath as FP
1616
17−import Terminal (Parser(..))
17+import Terminal.Args (Parser(..))
1818import qualified Deps.Registry as Registry
1919import qualified Elm.Package as Pkg
2020import qualified Elm.Version as V
2121import qualified Parse.Primitives as P
2222import qualified Stuff
23−import qualified Reporting.Suggest as Suggest
2423
2524
2625
@@ -118,17 +117,8 @@ parsePackage chars =
118117
119118
120119suggestPackages :: String -> IO [String]
121−suggestPackages given =
122− do cache <- Stuff.getPackageCache
123− maybeRegistry <- Registry.read cache
124− return $
125− case maybeRegistry of
126− Nothing ->
127− []
128−
129− Just (Registry.Registry _ versions) ->
130− filter (List.isPrefixOf given) $
131− map Pkg.toChars (Map.keys versions)
120+suggestPackages _ =
121+ return []
132122
133123
134124examplePackages :: String -> IO [String]
@@ -138,11 +128,8 @@ examplePackages given =
138128 return $
139129 case maybeRegistry of
140130 Nothing ->
141− [ "elm/json"
142− , "elm/http"
143− , "elm/random"
144− ]
131+ []
145132
146133 Just (Registry.Registry _ versions) ->
147− map Pkg.toChars $ take 4 $
148− Suggest.sort given Pkg.toChars (Map.keys versions)
134+ filter (List.isPrefixOf given) $
135+ map Pkg.toChars (Map.keys versions)
terminal/impl/Terminal/Internal.hs → terminal/src/Terminal/Args/Internal.hsrenamed+8−8
@@ -1,6 +1,6 @@
11{-# LANGUAGE GADTs #-}
2−module Terminal.Internal
3− ( Command(..)
2+module Terminal.Args.Internal
3+ ( Interface(..)
44 , toName
55 , Summary(..)
66 , Flags(..)
@@ -17,11 +17,11 @@ import Text.PrettyPrint.ANSI.Leijen (Doc)
1717
1818
1919
20−-- COMMAND
20+-- INTERFACE
2121
2222
23−data Command where
24− Command
23+data Interface where
24+ Interface
2525 :: String
2626 -> Summary
2727 -> String
@@ -29,11 +29,11 @@ data Command where
2929 -> Args args
3030 -> Flags flags
3131 -> (args -> flags -> IO ())
32− -> Command
32+ -> Interface
3333
3434
35−toName :: Command -> String
36−toName (Command name _ _ _ _ _ _) =
35+toName :: Interface -> String
36+toName (Interface name _ _ _ _ _ _) =
3737 name
3838
3939
docs/upgrade-instructions/0.16.md → upgrade-docs/0.16.mdrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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