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

Binary file not shown.

LICENSE+6−25
@@ -1,30 +1,11 @@
1−Copyright (c) 2012-present, Evan Czaplicki
1+Copyright 2012-present Evan Czaplicki
2
2
3−All rights reserved.
3+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
4
4
5−Redistribution and use in source and binary forms, with or without
5+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
6−modification, are permitted provided that the following conditions are met:
7
6
8− * Redistributions of source code must retain the above copyright
9− notice, this list of conditions and the following disclaimer.
7+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
10
8
11− * Redistributions in binary form must reproduce the above
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.
12− copyright notice, this list of conditions and the following
13− disclaimer in the documentation and/or other materials provided
14− with the distribution.
15
10
16− * Neither the name of Evan Czaplicki nor the names of other
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.
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+10−5
@@ -1,17 +1,22 @@
1−# The Elm Compiler
1+# Elm
2
2
3−Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/).
3+A delightful language for reliable webapps.
4
4
5+Check out the [Home Page](http://elm-lang.org/), [Try Online](http://elm-lang.org/try), or [The Official Guide](http://guide.elm-lang.org/)
6+
7+
8+<br>
5
9
6## Install
10## Install
7
11
8−Follow [these instructions][installer]!
12+✨ [Install](https://guide.elm-lang.org/install/elm.html) ✨
9
13
10− [installer]: https://guide.elm-lang.org/install.html
14+For multiple versions, previous versions, and uninstallation, see the instructions [here](https://github.com/elm/compiler/blob/master/installers/README.md).
11
15
16+<br>
12
17
13## Help
18## Help
14
19
15If you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!
20If you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!
16
21
17−[slack]: http://elmlang.herokuapp.com/
22+[slack]: http://elmlang.herokuapp.com/
builder/src/Build.hs+303−253
@@ -2,15 +2,15 @@
2{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}
2{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}
3module Build
3module Build
4 ( fromExposed
4 ( fromExposed
5− , fromMains
5+ , fromPaths
6 , fromRepl
6 , fromRepl
7 , Artifacts(..)
7 , Artifacts(..)
8− , Main(..)
8+ , Root(..)
9 , Module(..)
9 , Module(..)
10 , CachedInterface(..)
10 , CachedInterface(..)
11 , ReplArtifacts(..)
11 , ReplArtifacts(..)
12 , DocsGoal(..)
12 , DocsGoal(..)
13− , getMainNames
13+ , getRootNames
14 )
14 )
15 where
15 where
16
16
@@ -42,6 +42,7 @@ import qualified Elm.Details as Details
42import qualified Elm.Docs as Docs
42import qualified Elm.Docs as Docs
43import qualified Elm.Interface as I
43import qualified Elm.Interface as I
44import qualified Elm.ModuleName as ModuleName
44import qualified Elm.ModuleName as ModuleName
45+import qualified Elm.Outline as Outline
45import qualified Elm.Package as Pkg
46import qualified Elm.Package as Pkg
46import qualified File
47import qualified File
47import qualified Json.Encode as E
48import qualified Json.Encode as E
@@ -49,6 +50,7 @@ import qualified Parse.Module as Parse
49import qualified Reporting
50import qualified Reporting
50import qualified Reporting.Annotation as A
51import qualified Reporting.Annotation as A
51import qualified Reporting.Error as Error
52import qualified Reporting.Error as Error
53+import qualified Reporting.Error.Docs as EDocs
52import qualified Reporting.Error.Syntax as Syntax
54import qualified Reporting.Error.Syntax as Syntax
53import qualified Reporting.Error.Import as Import
55import qualified Reporting.Error.Import as Import
54import qualified Reporting.Exit as Exit
56import qualified Reporting.Exit as Exit
@@ -64,21 +66,47 @@ data Env =
64 Env
66 Env
65 { _key :: Reporting.BKey
67 { _key :: Reporting.BKey
66 , _root :: FilePath
68 , _root :: FilePath
67− , _pkg :: Pkg.Name
69+ , _project :: Parse.ProjectType
68− , _srcDirs :: [FilePath]
70+ , _srcDirs :: [AbsoluteSrcDir]
71+ , _buildID :: Details.BuildID
69 , _locals :: Map.Map ModuleName.Raw Details.Local
72 , _locals :: Map.Map ModuleName.Raw Details.Local
70 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign
73 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign
71 }
74 }
72
75
73
76
74−makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env
77+makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env
75−makeEnv key root (Details.Details _ validOutline locals foreigns _) =
78+makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =
76 case validOutline of
79 case validOutline of
77− Details.ValidApp srcDirs ->
80+ Details.ValidApp givenSrcDirs ->
78− Env key root Pkg.dummyName (NE.toList srcDirs) locals foreigns
81+ do srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)
82+ return $ Env key root Parse.Application srcDirs buildID locals foreigns
79
83
80 Details.ValidPkg pkg _ _ ->
84 Details.ValidPkg pkg _ _ ->
85+ do srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")
81− Env key root pkg ["src"] locals foreigns
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
110
83
111
84
112
@@ -109,7 +137,7 @@ forkWithKey func dict =
109fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)
137fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)
110fromExposed style root details docsGoal exposed@(NE.List e es) =
138fromExposed style root details docsGoal exposed@(NE.List e es) =
111 Reporting.trackBuild style $ \key ->
139 Reporting.trackBuild style $ \key ->
112− do let env = makeEnv key root details
140+ do env <- makeEnv key root details
113 dmvar <- Details.loadInterfaces root details
141 dmvar <- Details.loadInterfaces root details
114
142
115 -- crawl
143 -- crawl
@@ -132,18 +160,18 @@ fromExposed style root details docsGoal exposed@(NE.List e es) =
132 putMVar rmvar resultMVars
160 putMVar rmvar resultMVars
133 results <- traverse readMVar resultMVars
161 results <- traverse readMVar resultMVars
134 writeDetails root details results
162 writeDetails root details results
135− finalizeExposed docsGoal exposed results
163+ finalizeExposed root docsGoal exposed results
136
164
137
165
138
166
139−-- FROM MAINS
167+-- FROM PATHS
140
168
141
169
142data Artifacts =
170data Artifacts =
143 Artifacts
171 Artifacts
144 { _name :: Pkg.Name
172 { _name :: Pkg.Name
145 , _deps :: Dependencies
173 , _deps :: Dependencies
146− , _mains :: NE.List Main
174+ , _roots :: NE.List Root
147 , _modules :: [Module]
175 , _modules :: [Module]
148 }
176 }
149
177
@@ -157,25 +185,25 @@ type Dependencies =
157 Map.Map ModuleName.Canonical I.DependencyInterface
185 Map.Map ModuleName.Canonical I.DependencyInterface
158
186
159
187
160−fromMains :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
188+fromPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)
161−fromMains style root details paths =
189+fromPaths style root details paths =
162 Reporting.trackBuild style $ \key ->
190 Reporting.trackBuild style $ \key ->
163− do let env = makeEnv key root details
191+ do env <- makeEnv key root details
164
192
165− elmains <- findMains env paths
193+ elroots <- findRoots env paths
166− case elmains of
194+ case elroots of
167 Left problem ->
195 Left problem ->
168 return (Left (Exit.BuildProjectProblem problem))
196 return (Left (Exit.BuildProjectProblem problem))
169
197
170− Right lmains ->
198+ Right lroots ->
171 do -- crawl
199 do -- crawl
172 dmvar <- Details.loadInterfaces root details
200 dmvar <- Details.loadInterfaces root details
173 smvar <- newMVar Map.empty
201 smvar <- newMVar Map.empty
174− smainMVars <- traverse (fork . crawlMain env smvar) lmains
202+ srootMVars <- traverse (fork . crawlRoot env smvar) lroots
175− smains <- traverse readMVar smainMVars
203+ sroots <- traverse readMVar srootMVars
176 statuses <- traverse readMVar =<< readMVar smvar
204 statuses <- traverse readMVar =<< readMVar smvar
177
205
178− midpoint <- checkMainsMidpoint dmvar statuses smains
206+ midpoint <- checkMidpointAndRoots dmvar statuses sroots
179 case midpoint of
207 case midpoint of
180 Left problem ->
208 Left problem ->
181 return (Left (Exit.BuildProjectProblem problem))
209 return (Left (Exit.BuildProjectProblem problem))
@@ -185,24 +213,24 @@ fromMains style root details paths =
185 rmvar <- newEmptyMVar
213 rmvar <- newEmptyMVar
186 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
214 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
187 putMVar rmvar resultsMVars
215 putMVar rmvar resultsMVars
188− rmainMVars <- traverse (fork . checkMain env resultsMVars) smains
216+ rrootMVars <- traverse (fork . checkRoot env resultsMVars) sroots
189 results <- traverse readMVar resultsMVars
217 results <- traverse readMVar resultsMVars
190 writeDetails root details results
218 writeDetails root details results
191− toArtifacts env foreigns results <$> traverse readMVar rmainMVars
219+ toArtifacts env foreigns results <$> traverse readMVar rrootMVars
192
220
193
221
194
222
195−-- GET MAIN NAMES
223+-- GET ROOT NAMES
196
224
197
225
198−getMainNames :: Artifacts -> NE.List ModuleName.Raw
226+getRootNames :: Artifacts -> NE.List ModuleName.Raw
199−getMainNames (Artifacts _ _ mains _) =
227+getRootNames (Artifacts _ _ roots _) =
200− fmap getMainName mains
228+ fmap getRootName roots
201
229
202
230
203−getMainName :: Main -> ModuleName.Raw
231+getRootName :: Root -> ModuleName.Raw
204−getMainName main =
232+getRootName root =
205− case main of
233+ case root of
206 Inside name -> name
234 Inside name -> name
207 Outside name _ _ -> name
235 Outside name _ _ -> name
208
236
@@ -238,11 +266,10 @@ crawlDeps env mvar deps blockedValue =
238
266
239
267
240crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status
268crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status
241−crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar docsNeed name =
269+crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name =
242 do let fileName = ModuleName.toFilePath name <.> "elm"
270 do let fileName = ModuleName.toFilePath name <.> "elm"
243− let inRoot path = File.exists (root </> path)
244
271
245− paths <- filterM inRoot (map (</> fileName) srcDirs)
272+ paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)
246
273
247 case paths of
274 case paths of
248 [path] ->
275 [path] ->
@@ -251,21 +278,18 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar docsNeed name =
251 return $ SBadImport $ Import.Ambiguous path [] dep deps
278 return $ SBadImport $ Import.Ambiguous path [] dep deps
252
279
253 Nothing ->
280 Nothing ->
281+ do newTime <- File.getTime path
254− case Map.lookup name locals of
282+ case Map.lookup name locals of
255− Nothing ->
283+ Nothing ->
256− crawlFile env mvar docsNeed name path
284+ crawlFile env mvar docsNeed name path newTime buildID
257
285
258− Just local@(Details.Local oldPath oldTime deps _) ->
286+ Just local@(Details.Local oldPath oldTime deps _ lastChange _) ->
259− if path /= oldPath
260− then crawlFile env mvar docsNeed name path
261− else
262− do newTime <- File.getTime path
263− if oldTime < newTime || needsDocs docsNeed
287+ if path /= oldPath || oldTime /= newTime || needsDocs docsNeed
264− then crawlFile env mvar docsNeed name path
288+ then crawlFile env mvar docsNeed name path newTime lastChange
265− else crawlDeps env mvar deps (SCached local)
289+ else crawlDeps env mvar deps (SCached local)
266
290
267 p1:p2:ps ->
291 p1:p2:ps ->
268− return $ SBadImport $ Import.AmbiguousLocal p1 p2 ps
292+ return $ SBadImport $ Import.AmbiguousLocal (FP.makeRelative root p1) (FP.makeRelative root p2) (map (FP.makeRelative root) ps)
269
293
270 [] ->
294 [] ->
271 case Map.lookup name foreigns of
295 case Map.lookup name foreigns of
@@ -278,19 +302,18 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar docsNeed name =
278 return $ SBadImport $ Import.AmbiguousForeign dep d ds
302 return $ SBadImport $ Import.AmbiguousForeign dep d ds
279
303
280 Nothing ->
304 Nothing ->
281− if Name.isKernel name && Pkg.isKernel pkg then
305+ if Name.isKernel name && Parse.isKernel projectType then
282 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
306 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")
283 return $ if exists then SKernel else SBadImport Import.NotFound
307 return $ if exists then SKernel else SBadImport Import.NotFound
284 else
308 else
285 return $ SBadImport Import.NotFound
309 return $ SBadImport Import.NotFound
286
310
287
311
288−crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> IO Status
312+crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> File.Time -> Details.BuildID -> IO Status
289−crawlFile env@(Env _ root pkg _ _ _) mvar docsNeed expectedName path =
313+crawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName path time lastChange =
290− do time <- File.getTime path
291− source <- File.readUtf8 (root </> path)
314+ do source <- File.readUtf8 (root </> path)
292
315
293− case Parse.fromByteString pkg source of
316+ case Parse.fromByteString projectType source of
294 Left err ->
317 Left err ->
295 return $ SBadSyntax path time source err
318 return $ SBadSyntax path time source err
296
319
@@ -303,7 +326,7 @@ crawlFile env@(Env _ root pkg _ _ _) mvar docsNeed expectedName path =
303 if expectedName == actualName then
326 if expectedName == actualName then
304 let
327 let
305 deps = map Src.getImportName imports
328 deps = map Src.getImportName imports
306− local = Details.Local path time deps (any isMain values)
329+ local = Details.Local path time deps (any isMain values) lastChange buildID
307 in
330 in
308 crawlDeps env mvar deps (SChanged local source modul docsNeed)
331 crawlDeps env mvar deps (SChanged local source modul docsNeed)
309 else
332 else
@@ -326,7 +349,7 @@ type ResultDict =
326data Result
349data Result
327 = RNew !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
350 = RNew !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
328 | RSame !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
351 | RSame !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)
329− | RCached Bool (MVar CachedInterface)
352+ | RCached Bool Details.BuildID (MVar CachedInterface)
330 | RNotFound Import.Problem
353 | RNotFound Import.Problem
331 | RProblem Error.Module
354 | RProblem Error.Module
332 | RBlocked
355 | RBlocked
@@ -341,15 +364,15 @@ data CachedInterface
341
364
342
365
343checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result
366checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result
344−checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
367+checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name status =
345 case status of
368 case status of
346− SCached local@(Details.Local path time deps hasMain) ->
369+ SCached local@(Details.Local path time deps hasMain lastChange lastCompile) ->
347 do results <- readMVar resultsMVar
370 do results <- readMVar resultsMVar
348− depsStatus <- checkDeps root results deps
371+ depsStatus <- checkDeps root results deps lastCompile
349 case depsStatus of
372 case depsStatus of
350 DepsChange ifaces ->
373 DepsChange ifaces ->
351 do source <- File.readUtf8 path
374 do source <- File.readUtf8 path
352− case Parse.fromByteString pkg source of
375+ case Parse.fromByteString projectType source of
353 Right modul -> compile env (DocsNeed False) local source ifaces modul
376 Right modul -> compile env (DocsNeed False) local source ifaces modul
354 Left err ->
377 Left err ->
355 return $ RProblem $
378 return $ RProblem $
@@ -357,7 +380,7 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
357
380
358 DepsSame _ _ ->
381 DepsSame _ _ ->
359 do mvar <- newMVar Unneeded
382 do mvar <- newMVar Unneeded
360− return (RCached hasMain mvar)
383+ return (RCached hasMain lastChange mvar)
361
384
362 DepsBlock ->
385 DepsBlock ->
363 return RBlocked
386 return RBlocked
@@ -365,16 +388,16 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =
365 DepsNotFound problems ->
388 DepsNotFound problems ->
366 do source <- File.readUtf8 path
389 do source <- File.readUtf8 path
367 return $ RProblem $ Error.Module name path time source $
390 return $ RProblem $ Error.Module name path time source $
368− case Parse.fromByteString pkg source of
391+ case Parse.fromByteString projectType source of
369 Right (Src.Module _ _ _ imports _ _ _ _ _) ->
392 Right (Src.Module _ _ _ imports _ _ _ _ _) ->
370 Error.BadImports (toImportErrors env results imports problems)
393 Error.BadImports (toImportErrors env results imports problems)
371
394
372 Left err ->
395 Left err ->
373 Error.BadSyntax err
396 Error.BadSyntax err
374
397
375− SChanged local@(Details.Local path time deps _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) docsNeed ->
398+ SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) docsNeed ->
376 do results <- readMVar resultsMVar
399 do results <- readMVar resultsMVar
377− depsStatus <- checkDeps root results deps
400+ depsStatus <- checkDeps root results deps lastCompile
378 case depsStatus of
401 case depsStatus of
379 DepsChange ifaces ->
402 DepsChange ifaces ->
380 compile env docsNeed local source ifaces modul
403 compile env docsNeed local source ifaces modul
@@ -419,29 +442,45 @@ data DepsStatus
419 | DepsNotFound (NE.List (ModuleName.Raw, Import.Problem))
442 | DepsNotFound (NE.List (ModuleName.Raw, Import.Problem))
420
443
421
444
422−checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus
445+checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> Details.BuildID -> IO DepsStatus
423−checkDeps root results deps =
446+checkDeps root results deps lastCompile =
424− checkDepsHelp root results deps [] [] [] [] False
447+ checkDepsHelp root results deps [] [] [] [] False 0 lastCompile
425
448
426
449
427type Dep = (ModuleName.Raw, I.Interface)
450type Dep = (ModuleName.Raw, I.Interface)
428type CDep = (ModuleName.Raw, MVar CachedInterface)
451type CDep = (ModuleName.Raw, MVar CachedInterface)
429
452
430
453
431−checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> IO DepsStatus
454+checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> Details.BuildID -> Details.BuildID -> IO DepsStatus
432−checkDepsHelp root results deps new same cached importProblems isBlocked =
455+checkDepsHelp root results deps new same cached importProblems isBlocked lastDepChange lastCompile =
433 case deps of
456 case deps of
434 dep:otherDeps ->
457 dep:otherDeps ->
435 do result <- readMVar (results ! dep)
458 do result <- readMVar (results ! dep)
436 case result of
459 case result of
460+ RNew (Details.Local _ _ _ _ lastChange _) iface _ _ ->
437− RNew _ iface _ _ -> checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked
461+ checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked (max lastChange lastDepChange) lastCompile
462+
463+ RSame (Details.Local _ _ _ _ lastChange _) iface _ _ ->
438− RSame _ iface _ _ -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked
464+ checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked (max lastChange lastDepChange) lastCompile
465+
466+ RCached _ lastChange mvar ->
439− RCached _ mvar -> checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked
467+ checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked (max lastChange lastDepChange) lastCompile
468+
469+ RNotFound prob ->
440− RNotFound prob -> checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True
470+ checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True lastDepChange lastCompile
471+
472+ RProblem _ ->
441− RProblem _ -> checkDepsHelp root results otherDeps new same cached importProblems True
473+ checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile
474+
475+ RBlocked ->
442− RBlocked -> checkDepsHelp root results otherDeps new same cached importProblems True
476+ checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile
477+
478+ RForeign iface ->
443− RForeign iface -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked
479+ checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked lastDepChange lastCompile
480+
481+ RKernel ->
444− RKernel -> checkDepsHelp root results otherDeps new same cached importProblems isBlocked
482+ checkDepsHelp root results otherDeps new same cached importProblems isBlocked lastDepChange lastCompile
483+
445
484
446 [] ->
485 [] ->
447 case reverse importProblems of
486 case reverse importProblems of
@@ -452,7 +491,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked =
452 if isBlocked then
491 if isBlocked then
453 return $ DepsBlock
492 return $ DepsBlock
454
493
455− else if null new then
494+ else if null new && lastDepChange <= lastCompile then
456 return $ DepsSame same cached
495 return $ DepsSame same cached
457
496
458 else
497 else
@@ -467,7 +506,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked =
467
506
468
507
469toImportErrors :: Env -> ResultDict -> [Src.Import] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error
508toImportErrors :: Env -> ResultDict -> [Src.Import] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error
470−toImportErrors (Env _ _ _ _ locals foreigns) results imports problems =
509+toImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems =
471 let
510 let
472 knownModules =
511 knownModules =
473 Set.unions
512 Set.unions
@@ -546,11 +585,11 @@ checkMidpoint dmvar statuses =
546 return (Left (Exit.BP_Cycle name names))
585 return (Left (Exit.BP_Cycle name names))
547
586
548
587
549−checkMainsMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List MainStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
588+checkMidpointAndRoots :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List RootStatus -> IO (Either Exit.BuildProjectProblem Dependencies)
550−checkMainsMidpoint dmvar statuses smains =
589+checkMidpointAndRoots dmvar statuses sroots =
551 case checkForCycles statuses of
590 case checkForCycles statuses of
552 Nothing ->
591 Nothing ->
553− case checkUniqueMains statuses smains of
592+ case checkUniqueRoots statuses sroots of
554 Nothing ->
593 Nothing ->
555 do maybeForeigns <- readMVar dmvar
594 do maybeForeigns <- readMVar dmvar
556 case maybeForeigns of
595 case maybeForeigns of
@@ -601,25 +640,25 @@ addToGraph name status graph =
601 let
640 let
602 dependencies =
641 dependencies =
603 case status of
642 case status of
604− SCached (Details.Local _ _ deps _) -> deps
643+ SCached (Details.Local _ _ deps _ _ _) -> deps
605− SChanged (Details.Local _ _ deps _) _ _ _ -> deps
644+ SChanged (Details.Local _ _ deps _ _ _) _ _ _ -> deps
606− SBadImport _ -> []
645+ SBadImport _ -> []
607− SBadSyntax _ _ _ _ -> []
646+ SBadSyntax _ _ _ _ -> []
608− SForeign _ -> []
647+ SForeign _ -> []
609− SKernel -> []
648+ SKernel -> []
610 in
649 in
611 (name, name, dependencies) : graph
650 (name, name, dependencies) : graph
612
651
613
652
614
653
615−-- CHECK UNIQUE MAINS
654+-- CHECK UNIQUE ROOTS
616
655
617
656
618−checkUniqueMains :: Map.Map ModuleName.Raw Status -> NE.List MainStatus -> Maybe Exit.BuildProjectProblem
657+checkUniqueRoots :: Map.Map ModuleName.Raw Status -> NE.List RootStatus -> Maybe Exit.BuildProjectProblem
619−checkUniqueMains insides smains =
658+checkUniqueRoots insides sroots =
620 let
659 let
621 outsidesDict =
660 outsidesDict =
622− Map.fromListWith OneOrMore.more (Maybe.mapMaybe mainStatusToNamePathPair (NE.toList smains))
661+ Map.fromListWith OneOrMore.more (Maybe.mapMaybe rootStatusToNamePathPair (NE.toList sroots))
623 in
662 in
624 case Map.traverseWithKey checkOutside outsidesDict of
663 case Map.traverseWithKey checkOutside outsidesDict of
625 Left problem ->
664 Left problem ->
@@ -631,30 +670,30 @@ checkUniqueMains insides smains =
631 Left problem -> Just problem
670 Left problem -> Just problem
632
671
633
672
634−mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
673+rootStatusToNamePathPair :: RootStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)
635−mainStatusToNamePathPair smain =
674+rootStatusToNamePathPair sroot =
636− case smain of
675+ case sroot of
637− SInside _ -> Nothing
676+ SInside _ -> Nothing
638− SOutsideOk (Details.Local path _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
677+ SOutsideOk (Details.Local path _ _ _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)
639− SOutsideErr _ -> Nothing
678+ SOutsideErr _ -> Nothing
640
679
641
680
642checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath
681checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath
643checkOutside name paths =
682checkOutside name paths =
644 case OneOrMore.destruct NE.List paths of
683 case OneOrMore.destruct NE.List paths of
645 NE.List p [] -> Right p
684 NE.List p [] -> Right p
646− NE.List p1 (p2:_) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
685+ NE.List p1 (p2:_) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
647
686
648
687
649checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
688checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()
650checkInside name p1 status =
689checkInside name p1 status =
651 case status of
690 case status of
652− SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)
691+ SCached (Details.Local p2 _ _ _ _ _) -> Left (Exit.BP_RootNameDuplicate name p1 p2)
653− SChanged (Details.Local p2 _ _ _) _ _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)
692+ SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_RootNameDuplicate name p1 p2)
654− SBadImport _ -> Right ()
693+ SBadImport _ -> Right ()
655− SBadSyntax _ _ _ _ -> Right ()
694+ SBadSyntax _ _ _ _ -> Right ()
656− SForeign _ -> Right ()
695+ SForeign _ -> Right ()
657− SKernel -> Right ()
696+ SKernel -> Right ()
658
697
659
698
660
699
@@ -662,40 +701,57 @@ checkInside name p1 status =
662
701
663
702
664compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
703compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result
665−compile (Env key root pkg _ _ _) docsNeed local@(Details.Local path time _ _) source ifaces modul =
704+compile (Env key root projectType _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul =
705+ let
706+ pkg = projectTypeToPkg projectType
707+ in
666 case Compile.compile pkg ifaces modul of
708 case Compile.compile pkg ifaces modul of
667 Right (Compile.Artifacts canonical annotations objects) ->
709 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 ->
668− do let name = Src.getName modul
716+ do let name = Src.getName modul
669− let iface = I.fromModule pkg canonical annotations
717+ let iface = I.fromModule pkg canonical annotations
670− let docs = makeDocs docsNeed canonical
671− let elmi = Stuff.elmi root name
718+ let elmi = Stuff.elmi root name
672− File.writeBinary (Stuff.elmo root name) objects
719+ File.writeBinary (Stuff.elmo root name) objects
673− maybeOldi <- File.readBinary elmi
720+ maybeOldi <- File.readBinary elmi
674− case maybeOldi of
721+ case maybeOldi of
675− Just oldi | oldi == iface ->
722+ Just oldi | oldi == iface ->
676− do -- iface should be fully forced by equality check
723+ do -- iface should be fully forced by equality check
677− Reporting.report key Reporting.BDone
724+ Reporting.report key Reporting.BDone
725+ let local = Details.Local path time deps main lastChange buildID
678− return (RSame local iface objects docs)
726+ return (RSame local iface objects docs)
679−
727+
680− _ ->
728+ _ ->
681− do -- iface may be lazy still
729+ do -- iface may be lazy still
682− File.writeBinary elmi iface
730+ File.writeBinary elmi iface
683− Reporting.report key Reporting.BDone
731+ Reporting.report key Reporting.BDone
732+ let local = Details.Local path time deps main buildID buildID
684− return (RNew local iface objects docs)
733+ return (RNew local iface objects docs)
685
734
686 Left err ->
735 Left err ->
687 return $ RProblem $
736 return $ RProblem $
688 Error.Module (Src.getName modul) path time source err
737 Error.Module (Src.getName modul) path time source err
689
738
690
739
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+
691
747
692-- WRITE DETAILS
748-- WRITE DETAILS
693
749
694
750
695writeDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()
751writeDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()
696−writeDetails root (Details.Details time outline locals foreigns extras) results =
752+writeDetails root (Details.Details time outline buildID locals foreigns extras) results =
697 File.writeBinary (Stuff.details root) $
753 File.writeBinary (Stuff.details root) $
698− Details.Details time outline (Map.foldrWithKey addNewLocal locals results) foreigns extras
754+ Details.Details time outline buildID (Map.foldrWithKey addNewLocal locals results) foreigns extras
699
755
700
756
701addNewLocal :: ModuleName.Raw -> Result -> Map.Map ModuleName.Raw Details.Local -> Map.Map ModuleName.Raw Details.Local
757addNewLocal :: ModuleName.Raw -> Result -> Map.Map ModuleName.Raw Details.Local -> Map.Map ModuleName.Raw Details.Local
@@ -703,7 +759,7 @@ addNewLocal name result locals =
703 case result of
759 case result of
704 RNew local _ _ _ -> Map.insert name local locals
760 RNew local _ _ _ -> Map.insert name local locals
705 RSame local _ _ _ -> Map.insert name local locals
761 RSame local _ _ _ -> Map.insert name local locals
706− RCached _ _ -> locals
762+ RCached _ _ _ -> locals
707 RNotFound _ -> locals
763 RNotFound _ -> locals
708 RProblem _ -> locals
764 RProblem _ -> locals
709 RBlocked -> locals
765 RBlocked -> locals
@@ -715,8 +771,8 @@ addNewLocal name result locals =
715-- FINALIZE EXPOSED
771-- FINALIZE EXPOSED
716
772
717
773
718−finalizeExposed :: DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
774+finalizeExposed :: FilePath -> DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)
719−finalizeExposed docsGoal exposed results =
775+finalizeExposed root docsGoal exposed results =
720 case foldr (addImportProblems results) [] (NE.toList exposed) of
776 case foldr (addImportProblems results) [] (NE.toList exposed) of
721 p:ps ->
777 p:ps ->
722 return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))
778 return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))
@@ -724,7 +780,7 @@ finalizeExposed docsGoal exposed results =
724 [] ->
780 [] ->
725 case Map.foldr addErrors [] results of
781 case Map.foldr addErrors [] results of
726 [] -> Right <$> finalizeDocs docsGoal results
782 [] -> Right <$> finalizeDocs docsGoal results
727− e:es -> return $ Left $ Exit.BuildBadModules e es
783+ e:es -> return $ Left $ Exit.BuildBadModules root e es
728
784
729
785
730addErrors :: Result -> [Error.Module] -> [Error.Module]
786addErrors :: Result -> [Error.Module] -> [Error.Module]
@@ -732,7 +788,7 @@ addErrors result errors =
732 case result of
788 case result of
733 RNew _ _ _ _ -> errors
789 RNew _ _ _ _ -> errors
734 RSame _ _ _ _ -> errors
790 RSame _ _ _ _ -> errors
735− RCached _ _ -> errors
791+ RCached _ _ _ -> errors
736 RNotFound _ -> errors
792 RNotFound _ -> errors
737 RProblem e -> e:errors
793 RProblem e -> e:errors
738 RBlocked -> errors
794 RBlocked -> errors
@@ -745,7 +801,7 @@ addImportProblems results name problems =
745 case results ! name of
801 case results ! name of
746 RNew _ _ _ _ -> problems
802 RNew _ _ _ _ -> problems
747 RSame _ _ _ _ -> problems
803 RSame _ _ _ _ -> problems
748− RCached _ _ -> problems
804+ RCached _ _ _ -> problems
749 RNotFound p -> (name, p) : problems
805 RNotFound p -> (name, p) : problems
750 RProblem _ -> problems
806 RProblem _ -> problems
751 RBlocked -> problems
807 RBlocked -> problems
@@ -775,14 +831,14 @@ toDocsNeed goal =
775 KeepDocs -> DocsNeed True
831 KeepDocs -> DocsNeed True
776
832
777
833
778−makeDocs :: DocsNeed -> Can.Module -> Maybe Docs.Module
834+makeDocs :: DocsNeed -> Can.Module -> Either EDocs.Error (Maybe Docs.Module)
779makeDocs (DocsNeed isNeeded) modul =
835makeDocs (DocsNeed isNeeded) modul =
780 if isNeeded then
836 if isNeeded then
781 case Docs.fromModule modul of
837 case Docs.fromModule modul of
782− Right docs -> Just docs
838+ Right docs -> Right (Just docs)
783− Left _ -> Nothing
839+ Left err -> Left err
784 else
840 else
785− Nothing
841+ Right Nothing
786
842
787
843
788finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs
844finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs
@@ -803,7 +859,7 @@ toDocs result =
803 case result of
859 case result of
804 RNew _ _ _ d -> d
860 RNew _ _ _ d -> d
805 RSame _ _ _ d -> d
861 RSame _ _ _ d -> d
806− RCached _ _ -> Nothing
862+ RCached _ _ _ -> Nothing
807 RNotFound _ -> Nothing
863 RNotFound _ -> Nothing
808 RProblem _ -> Nothing
864 RProblem _ -> Nothing
809 RBlocked -> Nothing
865 RBlocked -> Nothing
@@ -831,40 +887,41 @@ data ReplArtifacts =
831
887
832fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
888fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)
833fromRepl root details source =
889fromRepl root details source =
834− let
835− env@(Env _ _ pkg _ _ _) = makeEnv Reporting.ignorer root details
890+ do env@(Env _ _ projectType _ _ _ _) <- makeEnv Reporting.ignorer root details
836− in
837− case Parse.fromByteString pkg source of
891+ case Parse.fromByteString projectType source of
838− Left syntaxError ->
892+ Left syntaxError ->
839− return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
893+ return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
840
894
841− Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
895+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
842− do dmvar <- Details.loadInterfaces root details
896+ do dmvar <- Details.loadInterfaces root details
843
897
844− let deps = map Src.getImportName imports
898+ let deps = map Src.getImportName imports
845− mvar <- newMVar Map.empty
899+ mvar <- newMVar Map.empty
846− crawlDeps env mvar deps ()
900+ crawlDeps env mvar deps ()
847
901
848− statuses <- traverse readMVar =<< readMVar mvar
902+ statuses <- traverse readMVar =<< readMVar mvar
849− midpoint <- checkMidpoint dmvar statuses
903+ midpoint <- checkMidpoint dmvar statuses
850
904
851− case midpoint of
905+ case midpoint of
852− Left problem ->
906+ Left problem ->
853− return $ Left $ Exit.ReplProjectProblem problem
907+ return $ Left $ Exit.ReplProjectProblem problem
854
908
855− Right foreigns ->
909+ Right foreigns ->
856− do rmvar <- newEmptyMVar
910+ do rmvar <- newEmptyMVar
857− resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
911+ resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses
858− putMVar rmvar resultMVars
912+ putMVar rmvar resultMVars
859− results <- traverse readMVar resultMVars
913+ results <- traverse readMVar resultMVars
860− writeDetails root details results
914+ writeDetails root details results
861− depsStatus <- checkDeps root resultMVars deps
915+ depsStatus <- checkDeps root resultMVars deps 0
862− finalizeReplArtifacts env source modul depsStatus resultMVars results
916+ finalizeReplArtifacts env source modul depsStatus resultMVars results
863
917
864
918
865finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
919finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
866−finalizeReplArtifacts env@(Env _ root pkg _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
920+finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =
867 let
921 let
922+ pkg =
923+ projectTypeToPkg projectType
924+
868 compileInput ifaces =
925 compileInput ifaces =
869 case Compile.compile pkg ifaces modul of
926 case Compile.compile pkg ifaces modul of
870 Right (Compile.Artifacts canonical annotations objects) ->
927 Right (Compile.Artifacts canonical annotations objects) ->
@@ -891,7 +948,7 @@ finalizeReplArtifacts env@(Env _ root pkg _ _ _) source modul@(Src.Module _ _ _
891 DepsBlock ->
948 DepsBlock ->
892 case Map.foldr addErrors [] results of
949 case Map.foldr addErrors [] results of
893 [] -> return $ Left $ Exit.ReplBlocked
950 [] -> return $ Left $ Exit.ReplBlocked
894− e:es -> return $ Left $ Exit.ReplBadLocalDeps e es
951+ e:es -> return $ Left $ Exit.ReplBadLocalDeps root e es
895
952
896 DepsNotFound problems ->
953 DepsNotFound problems ->
897 return $ Left $ Exit.ReplBadInput source $ Error.BadImports $
954 return $ Left $ Exit.ReplBadInput source $ Error.BadImports $
@@ -907,25 +964,25 @@ finalizeReplArtifacts env@(Env _ root pkg _ _ _) source modul@(Src.Module _ _ _
907
964
908
965
909
966
910−-- FIND MAIN
967+-- FIND ROOT
911
968
912
969
913−data MainLocation
970+data RootLocation
914 = LInside ModuleName.Raw
971 = LInside ModuleName.Raw
915 | LOutside FilePath
972 | LOutside FilePath
916
973
917
974
918−findMains :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List MainLocation))
975+findRoots :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List RootLocation))
919−findMains env paths =
976+findRoots env paths =
920− do mvars <- traverse (fork . findLocation env) paths
977+ do mvars <- traverse (fork . getRootInfo env) paths
921− elocs <- traverse readMVar mvars
978+ einfos <- traverse readMVar mvars
922− return $ checkLocations =<< sequence elocs
979+ return $ checkRoots =<< sequence einfos
923
980
924
981
925−checkLocations :: NE.List Location -> Either Exit.BuildProjectProblem (NE.List MainLocation)
982+checkRoots :: NE.List RootInfo -> Either Exit.BuildProjectProblem (NE.List RootLocation)
926−checkLocations locations =
983+checkRoots infos =
927 let
984 let
928− toOneOrMore loc@(Location absolute _ _) =
985+ toOneOrMore loc@(RootInfo absolute _ _) =
929 (absolute, OneOrMore.one loc)
986 (absolute, OneOrMore.one loc)
930
987
931 fromOneOrMore loc locs =
988 fromOneOrMore loc locs =
@@ -933,33 +990,33 @@ checkLocations locations =
933 [] -> Right ()
990 [] -> Right ()
934 loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))
991 loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))
935 in
992 in
936− fmap (\_ -> fmap _location locations) $
993+ fmap (\_ -> fmap _location infos) $
937 traverse (OneOrMore.destruct fromOneOrMore) $
994 traverse (OneOrMore.destruct fromOneOrMore) $
938− Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList locations)
995+ Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList infos)
939
996
940
997
941
998
942−-- LOCATIONS
999+-- ROOT INFO
943
1000
944
1001
945−data Location =
1002+data RootInfo =
946− Location
1003+ RootInfo
947 { _absolute :: FilePath
1004 { _absolute :: FilePath
948 , _relative :: FilePath
1005 , _relative :: FilePath
949− , _location :: MainLocation
1006+ , _location :: RootLocation
950 }
1007 }
951
1008
952
1009
953−findLocation :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem Location)
1010+getRootInfo :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
954−findLocation env path =
1011+getRootInfo env path =
955 do exists <- File.exists path
1012 do exists <- File.exists path
956 if exists
1013 if exists
957− then findLoc env path =<< Dir.canonicalizePath path
1014+ then getRootInfoHelp env path =<< Dir.canonicalizePath path
958 else return (Left (Exit.BP_PathUnknown path))
1015 else return (Left (Exit.BP_PathUnknown path))
959
1016
960
1017
961−findLoc :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem Location)
1018+getRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)
962−findLoc (Env _ root _ srcDirs _ _) path absolutePath =
1019+getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =
963 let
1020 let
964 (dirs, file) = FP.splitFileName absolutePath
1021 (dirs, file) = FP.splitFileName absolutePath
965 (final, ext) = FP.splitExtension file
1022 (final, ext) = FP.splitExtension file
@@ -969,45 +1026,39 @@ findLoc (Env _ root _ srcDirs _ _) path absolutePath =
969 return $ Left $ Exit.BP_WithBadExtension path
1026 return $ Left $ Exit.BP_WithBadExtension path
970 else
1027 else
971 let
1028 let
972− roots = FP.splitDirectories root
973− segments = FP.splitDirectories dirs ++ [final]
1029+ absoluteSegments = FP.splitDirectories dirs ++ [final]
974 in
1030 in
975− case dropPrefix roots segments of
976− Nothing ->
977− return $ Right $ Location absolutePath path (LOutside path)
978−
979− Just relativeSegments ->
980− case Maybe.mapMaybe (isInsideSrcDirByPath relativeSegments) srcDirs of
1031+ case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of
981− [] ->
1032+ [] ->
982− return $ Right $ Location absolutePath path (LOutside path)
1033+ return $ Right $ RootInfo absolutePath path (LOutside path)
983
1034
984− [(_, Right names)] ->
1035+ [(_, Right names)] ->
985− do let name = Name.fromChars (List.intercalate "." names)
1036+ do let name = Name.fromChars (List.intercalate "." names)
986− dirs <- filterM (isInsideSrcDirByName root names) srcDirs
1037+ matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs
987− case dirs of
1038+ case matchingDirs of
988− d1:d2:_ ->
1039+ d1:d2:_ ->
989− do let p1 = d1 </> FP.joinPath names <.> "elm"
1040+ do let p1 = addRelative d1 (FP.joinPath names <.> "elm")
990− let p2 = d2 </> FP.joinPath names <.> "elm"
1041+ let p2 = addRelative d2 (FP.joinPath names <.> "elm")
991− return $ Left $ Exit.BP_MainNameDuplicate name p1 p2
1042+ return $ Left $ Exit.BP_RootNameDuplicate name p1 p2
992
1043
993− _ ->
1044+ _ ->
994− return $ Right $ Location absolutePath path (LInside name)
1045+ return $ Right $ RootInfo absolutePath path (LInside name)
995
1046
996− [(s, Left names)] ->
1047+ [(s, Left names)] ->
997− return $ Left $ Exit.BP_MainNameInvalid path s names
1048+ return $ Left $ Exit.BP_RootNameInvalid path s names
998
1049
999− (s1,_):(s2,_):_ ->
1050+ (s1,_):(s2,_):_ ->
1000− return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
1051+ return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2
1001
1052
1002
1053
1003
1054
1004−isInsideSrcDirByName :: FilePath -> [String] -> FilePath -> IO Bool
1055+isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool
1005−isInsideSrcDirByName root names srcDir =
1056+isInsideSrcDirByName names srcDir =
1006− File.exists (root </> srcDir </> FP.joinPath names <.> "elm")
1057+ File.exists (addRelative srcDir (FP.joinPath names <.> "elm"))
1007
1058
1008
1059
1009−isInsideSrcDirByPath :: [String] -> FilePath -> Maybe (FilePath, Either [String] [String])
1060+isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])
1010−isInsideSrcDirByPath segments srcDir =
1061+isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =
1011 case dropPrefix (FP.splitDirectories srcDir) segments of
1062 case dropPrefix (FP.splitDirectories srcDir) segments of
1012 Nothing ->
1063 Nothing ->
1013 Nothing
1064 Nothing
@@ -1028,35 +1079,33 @@ isGoodName name =
1028 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars
1079 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars
1029
1080
1030
1081
1082+-- INVARIANT: Dir.canonicalizePath has been run on both inputs
1083+--
1031dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]
1084dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]
1032dropPrefix roots paths =
1085dropPrefix roots paths =
1033 case roots of
1086 case roots of
1034 [] ->
1087 [] ->
1035 Just paths
1088 Just paths
1036
1089
1037− ".":rs ->
1038− dropPrefix rs paths
1039−
1040 r:rs ->
1090 r:rs ->
1041 case paths of
1091 case paths of
1042− [] -> Nothing
1092+ [] -> Nothing
1043− ".":ps -> dropPrefix roots ps
1044− p:ps -> if r == p then dropPrefix rs ps else Nothing
1093+ p:ps -> if r == p then dropPrefix rs ps else Nothing
1045
1094
1046
1095
1047
1096
1048−-- CRAWL MAINS
1097+-- CRAWL ROOTS
1049
1098
1050
1099
1051−data MainStatus
1100+data RootStatus
1052 = SInside ModuleName.Raw
1101 = SInside ModuleName.Raw
1053 | SOutsideOk Details.Local B.ByteString Src.Module
1102 | SOutsideOk Details.Local B.ByteString Src.Module
1054 | SOutsideErr Error.Module
1103 | SOutsideErr Error.Module
1055
1104
1056
1105
1057−crawlMain :: Env -> MVar StatusDict -> MainLocation -> IO MainStatus
1106+crawlRoot :: Env -> MVar StatusDict -> RootLocation -> IO RootStatus
1058−crawlMain env@(Env _ _ pkg _ _ _) mvar given =
1107+crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =
1059− case given of
1108+ case root of
1060 LInside name ->
1109 LInside name ->
1061 do statusMVar <- newEmptyMVar
1110 do statusMVar <- newEmptyMVar
1062 statusDict <- takeMVar mvar
1111 statusDict <- takeMVar mvar
@@ -1067,10 +1116,10 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =
1067 LOutside path ->
1116 LOutside path ->
1068 do time <- File.getTime path
1117 do time <- File.getTime path
1069 source <- File.readUtf8 path
1118 source <- File.readUtf8 path
1070− case Parse.fromByteString pkg source of
1119+ case Parse.fromByteString projectType source of
1071 Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->
1120 Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->
1072 do let deps = map Src.getImportName imports
1121 do let deps = map Src.getImportName imports
1073− let local = Details.Local path time deps (any isMain values)
1122+ let local = Details.Local path time deps (any isMain values) buildID buildID
1074 crawlDeps env mvar deps (SOutsideOk local source modul)
1123 crawlDeps env mvar deps (SOutsideOk local source modul)
1075
1124
1076 Left syntaxError ->
1125 Left syntaxError ->
@@ -1079,27 +1128,27 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =
1079
1128
1080
1129
1081
1130
1082−-- CHECK MAINS
1131+-- CHECK ROOTS
1083
1132
1084
1133
1085−data MainResult
1134+data RootResult
1086 = RInside ModuleName.Raw
1135 = RInside ModuleName.Raw
1087 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph
1136 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph
1088 | ROutsideErr Error.Module
1137 | ROutsideErr Error.Module
1089 | ROutsideBlocked
1138 | ROutsideBlocked
1090
1139
1091
1140
1092−checkMain :: Env -> ResultDict -> MainStatus -> IO MainResult
1141+checkRoot :: Env -> ResultDict -> RootStatus -> IO RootResult
1093−checkMain env@(Env _ root _ _ _ _) results pendingMain =
1142+checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =
1094− case pendingMain of
1143+ case rootStatus of
1095 SInside name ->
1144 SInside name ->
1096 return (RInside name)
1145 return (RInside name)
1097
1146
1098 SOutsideErr err ->
1147 SOutsideErr err ->
1099 return (ROutsideErr err)
1148 return (ROutsideErr err)
1100
1149
1101− SOutsideOk local@(Details.Local path time deps _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
1150+ SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
1102− do depsStatus <- checkDeps root results deps
1151+ do depsStatus <- checkDeps root results deps lastCompile
1103 case depsStatus of
1152 case depsStatus of
1104 DepsChange ifaces ->
1153 DepsChange ifaces ->
1105 compileOutside env local source ifaces modul
1154 compileOutside env local source ifaces modul
@@ -1118,9 +1167,10 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =
1118 Error.BadImports (toImportErrors env results imports problems)
1167 Error.BadImports (toImportErrors env results imports problems)
1119
1168
1120
1169
1121−compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO MainResult
1170+compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO RootResult
1122−compileOutside (Env key _ pkg _ _ _) (Details.Local path time _ _) source ifaces modul =
1171+compileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =
1123 let
1172 let
1173+ pkg = projectTypeToPkg projectType
1124 name = Src.getName modul
1174 name = Src.getName modul
1125 in
1175 in
1126 case Compile.compile pkg ifaces modul of
1176 case Compile.compile pkg ifaces modul of
@@ -1136,35 +1186,35 @@ compileOutside (Env key _ pkg _ _ _) (Details.Local path time _ _) source ifaces
1136-- TO ARTIFACTS
1186-- TO ARTIFACTS
1137
1187
1138
1188
1139−data Main
1189+data Root
1140 = Inside ModuleName.Raw
1190 = Inside ModuleName.Raw
1141 | Outside ModuleName.Raw I.Interface Opt.LocalGraph
1191 | Outside ModuleName.Raw I.Interface Opt.LocalGraph
1142
1192
1143
1193
1144−toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either Exit.BuildProblem Artifacts
1194+toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either Exit.BuildProblem Artifacts
1145−toArtifacts (Env _ _ pkg _ _ _) foreigns results mainResults =
1195+toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults =
1146− case gatherProblemsOrMains results mainResults of
1196+ case gatherProblemsOrMains results rootResults of
1147 Left (NE.List e es) ->
1197 Left (NE.List e es) ->
1148− Left (Exit.BuildBadModules e es)
1198+ Left (Exit.BuildBadModules root e es)
1149
1199
1150− Right mains ->
1200+ Right roots ->
1151− Right $ Artifacts pkg foreigns mains $
1201+ Right $ Artifacts (projectTypeToPkg projectType) foreigns roots $
1152− Map.foldrWithKey addInside (foldr addOutside [] mainResults) results
1202+ Map.foldrWithKey addInside (foldr addOutside [] rootResults) results
1153
1203
1154
1204
1155−gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either (NE.List Error.Module) (NE.List Main)
1205+gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either (NE.List Error.Module) (NE.List Root)
1156−gatherProblemsOrMains results (NE.List mainResult mainResults) =
1206+gatherProblemsOrMains results (NE.List rootResult rootResults) =
1157 let
1207 let
1158− sortMain result (es, mains) =
1208+ addResult result (es, roots) =
1159 case result of
1209 case result of
1160− RInside n -> ( es, Inside n : mains)
1210+ RInside n -> ( es, Inside n : roots)
1161− ROutsideOk n i o -> ( es, Outside n i o : mains)
1211+ ROutsideOk n i o -> ( es, Outside n i o : roots)
1162− ROutsideErr e -> (e:es, mains)
1212+ ROutsideErr e -> (e:es, roots)
1163− ROutsideBlocked -> ( es, mains)
1213+ ROutsideBlocked -> ( es, roots)
1164
1214
1165 errors = Map.foldr addErrors [] results
1215 errors = Map.foldr addErrors [] results
1166 in
1216 in
1167− case (mainResult, foldr sortMain (errors, []) mainResults) of
1217+ case (rootResult, foldr addResult (errors, []) rootResults) of
1168 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)
1218 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)
1169 (RInside _ , (e:es, _ )) -> Left (NE.List e es)
1219 (RInside _ , (e:es, _ )) -> Left (NE.List e es)
1170 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
1220 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)
@@ -1179,7 +1229,7 @@ addInside name result modules =
1179 case result of
1229 case result of
1180 RNew _ iface objs _ -> Fresh name iface objs : modules
1230 RNew _ iface objs _ -> Fresh name iface objs : modules
1181 RSame _ iface objs _ -> Fresh name iface objs : modules
1231 RSame _ iface objs _ -> Fresh name iface objs : modules
1182− RCached main mvar -> Cached name main mvar : modules
1232+ RCached main _ mvar -> Cached name main mvar : modules
1183 RNotFound _ -> error (badInside name)
1233 RNotFound _ -> error (badInside name)
1184 RProblem _ -> error (badInside name)
1234 RProblem _ -> error (badInside name)
1185 RBlocked -> error (badInside name)
1235 RBlocked -> error (badInside name)
@@ -1192,9 +1242,9 @@ badInside name =
1192 "Error from `" ++ Name.toChars name ++ "` should have been reported already."
1242 "Error from `" ++ Name.toChars name ++ "` should have been reported already."
1193
1243
1194
1244
1195−addOutside :: MainResult -> [Module] -> [Module]
1245+addOutside :: RootResult -> [Module] -> [Module]
1196−addOutside main modules =
1246+addOutside root modules =
1197− case main of
1247+ case root of
1198 RInside _ -> modules
1248 RInside _ -> modules
1199 ROutsideOk name iface objs -> Fresh name iface objs : modules
1249 ROutsideOk name iface objs -> Fresh name iface objs : modules
1200 ROutsideErr _ -> modules
1250 ROutsideErr _ -> modules
builder/src/Elm/Details.hs+46−12
@@ -2,6 +2,7 @@
2{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2{-# LANGUAGE BangPatterns, OverloadedStrings #-}
3module Elm.Details
3module Elm.Details
4 ( Details(..)
4 ( Details(..)
5+ , BuildID
5 , ValidOutline(..)
6 , ValidOutline(..)
6 , Local(..)
7 , Local(..)
7 , Foreign(..)
8 , Foreign(..)
@@ -15,7 +16,7 @@ module Elm.Details
15
16
16import Control.Concurrent (forkIO)
17import Control.Concurrent (forkIO)
17import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)
18import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)
18−import Control.Monad (liftM, liftM2, liftM3, liftM4)
19+import Control.Monad (liftM, liftM2, liftM3)
19import Data.Binary (Binary, get, put, getWord8, putWord8)
20import Data.Binary (Binary, get, put, getWord8, putWord8)
20import qualified Data.Either as Either
21import qualified Data.Either as Either
21import qualified Data.Map as Map
22import qualified Data.Map as Map
@@ -27,6 +28,7 @@ import qualified Data.NonEmptyList as NE
27import qualified Data.OneOrMore as OneOrMore
28import qualified Data.OneOrMore as OneOrMore
28import qualified Data.Set as Set
29import qualified Data.Set as Set
29import qualified Data.Utf8 as Utf8
30import qualified Data.Utf8 as Utf8
31+import Data.Word (Word64)
30import qualified System.Directory as Dir
32import qualified System.Directory as Dir
31import System.FilePath ((</>), (<.>))
33import System.FilePath ((</>), (<.>))
32
34
@@ -66,23 +68,42 @@ data Details =
66 Details
68 Details
67 { _outlineTime :: File.Time
69 { _outlineTime :: File.Time
68 , _outline :: ValidOutline
70 , _outline :: ValidOutline
71+ , _buildID :: BuildID
69 , _locals :: Map.Map ModuleName.Raw Local
72 , _locals :: Map.Map ModuleName.Raw Local
70 , _foreigns :: Map.Map ModuleName.Raw Foreign
73 , _foreigns :: Map.Map ModuleName.Raw Foreign
71 , _extras :: Extras
74 , _extras :: Extras
72 }
75 }
73
76
74
77
78+type BuildID = Word64
79+
80+
75data ValidOutline
81data ValidOutline
76− = ValidApp (NE.List FilePath)
82+ = ValidApp (NE.List Outline.SrcDir)
77 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})
83 | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})
78
84
79
85
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+--
80data Local =
99data Local =
81 Local
100 Local
82 { _path :: FilePath
101 { _path :: FilePath
83 , _time :: File.Time
102 , _time :: File.Time
84 , _deps :: [ModuleName.Raw]
103 , _deps :: [ModuleName.Raw]
85 , _main :: Bool
104 , _main :: Bool
105+ , _lastChange :: BuildID
106+ , _lastCompile :: BuildID
86 }
107 }
87
108
88
109
@@ -104,14 +125,14 @@ type Interfaces =
104
125
105
126
106loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))
127loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))
107−loadObjects root (Details _ _ _ _ extras) =
128+loadObjects root (Details _ _ _ _ _ extras) =
108 case extras of
129 case extras of
109 ArtifactsFresh _ o -> newMVar (Just o)
130 ArtifactsFresh _ o -> newMVar (Just o)
110 ArtifactsCached -> fork (File.readBinary (Stuff.objects root))
131 ArtifactsCached -> fork (File.readBinary (Stuff.objects root))
111
132
112
133
113loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))
134loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))
114−loadInterfaces root (Details _ _ _ _ extras) =
135+loadInterfaces root (Details _ _ _ _ _ extras) =
115 case extras of
136 case extras of
116 ArtifactsFresh i _ -> newMVar (Just i)
137 ArtifactsFresh i _ -> newMVar (Just i)
117 ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))
138 ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))
@@ -143,9 +164,9 @@ load style scope root =
143 Nothing ->
164 Nothing ->
144 generate style scope root newTime
165 generate style scope root newTime
145
166
146− Just details@(Details oldTime _ _ _ _) ->
167+ Just details@(Details oldTime _ buildID _ _ _) ->
147 if oldTime == newTime
168 if oldTime == newTime
148− then return (Right details)
169+ then return (Right details { _buildID = buildID + 1 })
149 else generate style scope root newTime
170 else generate style scope root newTime
150
171
151
172
@@ -310,7 +331,7 @@ verifyDependencies env@(Env key scope root cache _ _ _) time outline solution di
310 objs = Map.foldr addObjects Opt.empty artifacts
331 objs = Map.foldr addObjects Opt.empty artifacts
311 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts
332 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts
312 foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps
333 foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps
313− details = Details time outline Map.empty foreigns (ArtifactsFresh ifaces objs)
334+ details = Details time outline 0 Map.empty foreigns (ArtifactsFresh ifaces objs)
314 in
335 in
315 do BW.writeBinary scope (Stuff.objects root) objs
336 do BW.writeBinary scope (Stuff.objects root) objs
316 BW.writeBinary scope (Stuff.interfaces root) ifaces
337 BW.writeBinary scope (Stuff.interfaces root) ifaces
@@ -574,7 +595,7 @@ crawlModule foreignDeps mvar pkg src docsStatus name =
574crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
595crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
575crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
596crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
576 do bytes <- File.readUtf8 path
597 do bytes <- File.readUtf8 path
577− case Parse.fromByteString pkg bytes of
598+ case Parse.fromByteString (Parse.Package pkg) bytes of
578 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->
599 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->
579 do deps <- crawlImports foreignDeps mvar pkg src imports
600 do deps <- crawlImports foreignDeps mvar pkg src imports
580 return (Just (SLocal docsStatus deps modul))
601 return (Just (SLocal docsStatus deps modul))
@@ -761,8 +782,14 @@ endpointDecoder =
761
782
762
783
763instance Binary Details where
784instance 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
764− get = do { a <- get; b <- get; c <- get; d <- get; return (Details a b c d ArtifactsCached) }
792+ return (Details a b c d e ArtifactsCached)
765− put (Details a b c d _) = put a >> put b >> put c >> put d
766
793
767
794
768instance Binary ValidOutline where
795instance Binary ValidOutline where
@@ -780,8 +807,15 @@ instance Binary ValidOutline where
780
807
781
808
782instance Binary Local where
809instance Binary Local where
783− get = liftM4 Local get get get get
784− put (Local a b c d) = put a >> put b >> put c >> put d
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)
785
819
786
820
787instance Binary Foreign where
821instance Binary Foreign where
builder/src/Elm/Outline.hs+96−12
@@ -5,6 +5,7 @@ module Elm.Outline
5 , AppOutline(..)
5 , AppOutline(..)
6 , PkgOutline(..)
6 , PkgOutline(..)
7 , Exposed(..)
7 , Exposed(..)
8+ , SrcDir(..)
8 , read
9 , read
9 , write
10 , write
10 , encode
11 , encode
@@ -16,11 +17,14 @@ module Elm.Outline
16
17
17
18
18import Prelude hiding (read)
19import Prelude hiding (read)
19−import Control.Monad (filterM)
20+import Control.Monad (filterM, liftM)
21+import Data.Binary (Binary, get, put, getWord8, putWord8)
20import qualified Data.Map as Map
22import qualified Data.Map as Map
21import qualified Data.NonEmptyList as NE
23import qualified Data.NonEmptyList as NE
24+import qualified Data.OneOrMore as OneOrMore
22import Foreign.Ptr (minusPtr)
25import Foreign.Ptr (minusPtr)
23import qualified System.Directory as Dir
26import qualified System.Directory as Dir
27+import qualified System.FilePath as FP
24import System.FilePath ((</>))
28import System.FilePath ((</>))
25
29
26import qualified Elm.Constraint as Con
30import qualified Elm.Constraint as Con
@@ -49,7 +53,7 @@ data Outline
49data AppOutline =
53data AppOutline =
50 AppOutline
54 AppOutline
51 { _app_elm_version :: V.Version
55 { _app_elm_version :: V.Version
52− , _app_source_dirs :: NE.List FilePath
56+ , _app_source_dirs :: NE.List SrcDir
53 , _app_deps_direct :: Map.Map Pkg.Name V.Version
57 , _app_deps_direct :: Map.Map Pkg.Name V.Version
54 , _app_deps_indirect :: Map.Map Pkg.Name V.Version
58 , _app_deps_indirect :: Map.Map Pkg.Name V.Version
55 , _app_test_direct :: Map.Map Pkg.Name V.Version
59 , _app_test_direct :: Map.Map Pkg.Name V.Version
@@ -75,6 +79,11 @@ data Exposed
75 | ExposedDict [(Json.String, [ModuleName.Raw])]
79 | ExposedDict [(Json.String, [ModuleName.Raw])]
76
80
77
81
82+data SrcDir
83+ = AbsoluteSrcDir FilePath
84+ | RelativeSrcDir FilePath
85+
86+
78
87
79-- DEFAULTS
88-- DEFAULTS
80
89
@@ -117,7 +126,7 @@ encode outline =
117 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->
126 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->
118 E.object
127 E.object
119 [ "type" ==> E.chars "application"
128 [ "type" ==> E.chars "application"
120− , "source-directories" ==> E.list E.chars (NE.toList srcDirs)
129+ , "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs)
121 , "elm-version" ==> V.encode elm
130 , "elm-version" ==> V.encode elm
122 , "dependencies" ==>
131 , "dependencies" ==>
123 E.object
132 E.object
@@ -165,6 +174,13 @@ encodeDeps encodeValue deps =
165 E.dict Pkg.toJsonString encodeValue deps
174 E.dict Pkg.toJsonString encodeValue deps
166
175
167
176
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+
168
184
169-- PARSE AND VERIFY
185-- PARSE AND VERIFY
170
186
@@ -192,15 +208,58 @@ read root =
192 return $ Left Exit.OutlineNoAppJson
208 return $ Left Exit.OutlineNoAppJson
193
209
194 | otherwise ->
210 | otherwise ->
195− do badDirs <- filterM (isBadSrcDir root) (NE.toList srcDirs)
211+ do badDirs <- filterM (isSrcDirMissing root) (NE.toList srcDirs)
196− case badDirs of
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 ->
197− [] -> return $ Right outline
220+ return $ Right outline
198− d:ds -> return $ Left (Exit.OutlineHasBadSrcDirs d ds)
221+
222+ Just (canonicalDir, (dir1,dir2)) ->
223+ return $ Left (Exit.OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2)
224+
225+
226+isSrcDirMissing :: FilePath -> SrcDir -> IO Bool
227+isSrcDirMissing root srcDir =
228+ not <$> Dir.doesDirectoryExist (toAbsolute root srcDir)
229+
230+
231+toGiven :: SrcDir -> FilePath
232+toGiven srcDir =
233+ case srcDir of
234+ AbsoluteSrcDir dir -> dir
235+ RelativeSrcDir dir -> dir
236+
237+
238+toAbsolute :: FilePath -> SrcDir -> FilePath
239+toAbsolute root srcDir =
240+ case srcDir of
241+ AbsoluteSrcDir dir -> dir
242+ RelativeSrcDir dir -> root </> dir
199
243
200
244
201−isBadSrcDir :: FilePath -> FilePath -> IO Bool
245+detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))
202−isBadSrcDir root dir =
246+detectDuplicates root srcDirs =
203− not <$> Dir.doesDirectoryExist (root </> dir)
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)
204
263
205
264
206
265
@@ -278,9 +337,16 @@ depsDecoder valueDecoder =
278 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder
337 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder
279
338
280
339
281−dirsDecoder :: Decoder (NE.List FilePath)
340+dirsDecoder :: Decoder (NE.List SrcDir)
282dirsDecoder =
341dirsDecoder =
283− fmap Json.toChars <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs
342+ fmap (toSrcDir . Json.toChars) <$> D.nonEmptyList D.string Exit.OP_NoSrcDirs
343+
344+
345+toSrcDir :: FilePath -> SrcDir
346+toSrcDir path =
347+ if FP.isRelative path
348+ then RelativeSrcDir path
349+ else AbsoluteSrcDir path
284
350
285
351
286
352
@@ -321,3 +387,21 @@ boundParser bound tooLong =
321 if len < bound
387 if len < bound
322 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)
388 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)
323 else cerr row newCol (\_ _ -> tooLong)
389 else cerr row newCol (\_ _ -> tooLong)
390+
391+
392+
393+-- BINARY
394+
395+
396+instance Binary SrcDir where
397+ put outline =
398+ case outline of
399+ AbsoluteSrcDir a -> putWord8 0 >> put a
400+ RelativeSrcDir a -> putWord8 1 >> put a
401+
402+ get =
403+ do n <- getWord8
404+ case n of
405+ 0 -> liftM AbsoluteSrcDir get
406+ 1 -> liftM RelativeSrcDir get
407+ _ -> fail "binary encoding of SrcDir was corrupted"
builder/src/Generate.hs+6−6
@@ -99,18 +99,18 @@ checkForDebugUses (Objects _ locals) =
99-- GATHER MAINS
99-- GATHER MAINS
100
100
101
101
102−gatherMains :: Pkg.Name -> Objects -> NE.List Build.Main -> Map.Map ModuleName.Canonical Opt.Main
102+gatherMains :: Pkg.Name -> Objects -> NE.List Build.Root -> Map.Map ModuleName.Canonical Opt.Main
103−gatherMains pkg (Objects _ locals) buildMains =
103+gatherMains pkg (Objects _ locals) roots =
104− Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList buildMains)
104+ Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList roots)
105
105
106
106
107−lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Main -> Maybe (ModuleName.Canonical, Opt.Main)
107+lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Root -> Maybe (ModuleName.Canonical, Opt.Main)
108−lookupMain pkg locals buildMain =
108+lookupMain pkg locals root =
109 let
109 let
110 toPair name (Opt.LocalGraph maybeMain _ _) =
110 toPair name (Opt.LocalGraph maybeMain _ _) =
111 (,) (ModuleName.Canonical pkg name) <$> maybeMain
111 (,) (ModuleName.Canonical pkg name) <$> maybeMain
112 in
112 in
113− case buildMain of
113+ case root of
114 Build.Inside name -> toPair name =<< Map.lookup name locals
114 Build.Inside name -> toPair name =<< Map.lookup name locals
115 Build.Outside name _ g -> toPair name g
115 Build.Outside name _ g -> toPair name g
116
116
builder/src/Http.hs+1−1
@@ -241,4 +241,4 @@ jsonPart name filePath value =
241
241
242stringPart :: String -> String -> Multi.Part
242stringPart :: String -> String -> Multi.Part
243stringPart name string =
243stringPart name string =
244− Multi.partBS (String.fromString name) (BS.pack string)
244+ Multi.partBS (String.fromString name) (BS.pack string)
builder/src/Reporting.hs+2−2
@@ -364,10 +364,10 @@ toFinalMessage done result =
364
364
365 Left problem ->
365 Left problem ->
366 case problem of
366 case problem of
367− Exit.BuildBadModules _ [] ->
367+ Exit.BuildBadModules _ _ [] ->
368 "Detected problems in 1 module."
368 "Detected problems in 1 module."
369
369
370− Exit.BuildBadModules _ (_:ps) ->
370+ Exit.BuildBadModules _ _ (_:ps) ->
371 "Detected problems in " ++ show (2 + length ps) ++ " modules."
371 "Detected problems in " ++ show (2 + length ps) ++ " modules."
372
372
373 Exit.BuildProjectProblem _ ->
373 Exit.BuildProjectProblem _ ->
builder/src/Reporting/Exit.hs+65−72
@@ -8,7 +8,6 @@ module Reporting.Exit
8 , Publish(..), publishToReport
8 , Publish(..), publishToReport
9 , Install(..), installToReport
9 , Install(..), installToReport
10 , Reactor(..), reactorToReport
10 , Reactor(..), reactorToReport
11− , Worker(..), workerToReport
12 , newPackageOverview
11 , newPackageOverview
13 --
12 --
14 , Solver(..)
13 , Solver(..)
@@ -31,9 +30,6 @@ module Reporting.Exit
31
30
32
31
33import qualified Data.ByteString as BS
32import 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
37import qualified Data.ByteString.UTF8 as BS_UTF8
33import qualified Data.ByteString.UTF8 as BS_UTF8
38import qualified Data.List as List
34import qualified Data.List as List
39import qualified Data.Map as Map
35import qualified Data.Map as Map
@@ -178,7 +174,7 @@ diffToReport diff =
178 \ with packages. That way there are previously published versions of the API to\
174 \ with packages. That way there are previously published versions of the API to\
179 \ diff against!"
175 \ diff against!"
180 [ D.reflow $ "If you are just curious to see a diff, try running this command:"
176 [ D.reflow $ "If you are just curious to see a diff, try running this command:"
181− , D.indent 4 $ D.dullyellow $ "elm diff elm/http 1.0.0 2.0.0"
177+ , D.indent 4 $ D.dullyellow $ "elm diff elm/json 1.0.0 1.1.2"
182 ]
178 ]
183
179
184 DiffNoExposed ->
180 DiffNoExposed ->
@@ -951,7 +947,8 @@ toSolverReport problem =
951
947
952data Outline
948data Outline
953 = OutlineHasBadStructure (Decode.Error OutlineProblem)
949 = OutlineHasBadStructure (Decode.Error OutlineProblem)
954− | OutlineHasBadSrcDirs FilePath [FilePath]
950+ | OutlineHasMissingSrcDirs FilePath [FilePath]
951+ | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath
955 | OutlineNoPkgCore
952 | OutlineNoPkgCore
956 | OutlineNoAppCore
953 | OutlineNoAppCore
957 | OutlineNoAppJson
954 | OutlineNoAppJson
@@ -977,12 +974,12 @@ toOutlineReport problem =
977 Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $
974 Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $
978 Json.ExplicitReason "I ran into a problem with your elm.json file."
975 Json.ExplicitReason "I ran into a problem with your elm.json file."
979
976
980− OutlineHasBadSrcDirs dir dirs ->
977+ OutlineHasMissingSrcDirs dir dirs ->
981 case dirs of
978 case dirs of
982 [] ->
979 [] ->
983 Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")
980 Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")
984 "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"
981 "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"
985− [ D.indent 4 $ D.dullyellow $ D.fromChars dir
982+ [ D.indent 4 $ D.red $ D.fromChars dir
986 , D.reflow $
983 , D.reflow $
987 "I cannot find it though. Is it missing? Is there a typo?"
984 "I cannot find it though. Is it missing? Is there a typo?"
988 ]
985 ]
@@ -990,11 +987,33 @@ toOutlineReport problem =
990 _:_ ->
987 _:_ ->
991 Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")
988 Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")
992 "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"
989 "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"
990+ [ D.indent 4 $ D.vcat $
993− [ D.indent 4 $ D.dullyellow $ D.fromChars dir
991+ map (D.red . D.fromChars) (dir:dirs)
994 , D.reflow $
992 , D.reflow $
995 "I cannot find them though. Are they missing? Are there typos?"
993 "I cannot find them though. Are they missing? Are there typos?"
996 ]
994 ]
997
995
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+
998 OutlineNoPkgCore ->
1017 OutlineNoPkgCore ->
999 Help.report "MISSING DEPENDENCY" (Just "elm.json")
1018 Help.report "MISSING DEPENDENCY" (Just "elm.json")
1000 "I need to see an \"elm/core\" dependency your elm.json file. The default imports\
1019 "I need to see an \"elm/core\" dependency your elm.json file. The default imports\
@@ -1156,10 +1175,16 @@ toOutlineProblemReport path source _ region problem =
1156 toSnippet "HEADER TOO LONG" Nothing
1175 toSnippet "HEADER TOO LONG" Nothing
1157 ( D.reflow $
1176 ( D.reflow $
1158 "I got stuck while reading your elm.json file. This section header is too long:"
1177 "I got stuck while reading your elm.json file. This section header is too long:"
1178+ , D.stack
1159− , D.fillSep
1179+ [ D.fillSep
1160− ["I","need","it","to","be"
1180+ ["I","need","it","to","be"
1161− ,D.green "under",D.green "20",D.green "characters"
1181+ ,D.green "under",D.green "20",D.green "bytes"
1162− ,"so","it","renders","nicely","on","the","package","website!"
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."
1163 ]
1188 ]
1164 )
1189 )
1165
1190
@@ -1204,10 +1229,16 @@ toOutlineProblemReport path source _ region problem =
1204 toSnippet "SUMMARY TOO LONG" Nothing
1229 toSnippet "SUMMARY TOO LONG" Nothing
1205 ( D.reflow $
1230 ( D.reflow $
1206 "I got stuck while reading your elm.json file. Your \"summary\" is too long:"
1231 "I got stuck while reading your elm.json file. Your \"summary\" is too long:"
1232+ , D.stack
1207− , D.fillSep
1233+ [ D.fillSep
1208− ["I","need","it","to","be"
1234+ ["I","need","it","to","be"
1209− ,D.green "under",D.green "80",D.green "characters"
1235+ ,D.green "under",D.green "80",D.green "bytes"
1210− ,"so","it","renders","nicely","on","the","package","website!"
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."
1211 ]
1242 ]
1212 )
1243 )
1213
1244
@@ -1251,8 +1282,7 @@ toDetailsReport details =
1251 "The dependencies in your elm.json are not compatible."
1282 "The dependencies in your elm.json are not compatible."
1252 [ D.fillSep
1283 [ D.fillSep
1253 ["Did","you","change","them","by","hand?","Try","to","change","it","back!"
1284 ["Did","you","change","them","by","hand?","Try","to","change","it","back!"
1254− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1285+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1255− ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
1256 ]
1286 ]
1257 , D.reflow $
1287 , D.reflow $
1258 "Please ask for help on the community forums if you try those paths and are still\
1288 "Please ask for help on the community forums if you try those paths and are still\
@@ -1269,8 +1299,7 @@ toDetailsReport details =
1269 \ get access to the registry!"
1299 \ get access to the registry!"
1270 , D.toFancyNote
1300 , D.toFancyNote
1271 ["If","you","changed","your","dependencies","by","hand,","try","to","change","them","back!"
1301 ["If","you","changed","your","dependencies","by","hand,","try","to","change","them","back!"
1272− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1302+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1273− ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
1274 ]
1303 ]
1275 ]
1304 ]
1276
1305
@@ -1306,8 +1335,7 @@ toDetailsReport details =
1306 \ party tool) leaving them in an invalid state."
1335 \ party tool) leaving them in an invalid state."
1307 [ D.fillSep
1336 [ D.fillSep
1308 ["Try","to","change","them","back","to","what","they","were","before!"
1337 ["Try","to","change","them","back","to","what","they","were","before!"
1309− ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install"
1338+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."
1310− ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."
1311 ]
1339 ]
1312 , D.reflow $
1340 , D.reflow $
1313 "Please ask for help on the community forums if you try those paths and are still\
1341 "Please ask for help on the community forums if you try those paths and are still\
@@ -1494,7 +1522,7 @@ toHttpErrorReport title err context =
1494
1522
1495 Http.BadHttp url httpExceptionContent ->
1523 Http.BadHttp url httpExceptionContent ->
1496 case httpExceptionContent of
1524 case httpExceptionContent of
1497− HTTP.StatusCodeException response _ ->
1525+ HTTP.StatusCodeException response body ->
1498 let
1526 let
1499 (HTTP.Status code message) = HTTP.responseStatus response
1527 (HTTP.Status code message) = HTTP.responseStatus response
1500 in
1528 in
@@ -1502,6 +1530,7 @@ toHttpErrorReport title err context =
1502 [ D.fillSep $
1530 [ D.fillSep $
1503 ["But","it","came","back","as",D.red (D.fromInt code)]
1531 ["But","it","came","back","as",D.red (D.fromInt code)]
1504 ++ map D.fromChars (words (BS_UTF8.toString message))
1532 ++ map D.fromChars (words (BS_UTF8.toString message))
1533+ , D.indent 4 $ D.reflow $ BS_UTF8.toString body
1505 , D.reflow $
1534 , D.reflow $
1506 "This may mean some online endpoint changed in an unexpected way, so if does not\
1535 "This may mean some online endpoint changed in an unexpected way, so if does not\
1507 \ seem like something on your side is causing this (e.g. firewall) please report\
1536 \ seem like something on your side is causing this (e.g. firewall) please report\
@@ -1727,7 +1756,7 @@ makeToReport make =
1727
1756
1728
1757
1729data BuildProblem
1758data BuildProblem
1730− = BuildBadModules Error.Module [Error.Module]
1759+ = BuildBadModules FilePath Error.Module [Error.Module]
1731 | BuildProjectProblem BuildProjectProblem
1760 | BuildProjectProblem BuildProjectProblem
1732
1761
1733
1762
@@ -1736,8 +1765,8 @@ data BuildProjectProblem
1736 | BP_WithBadExtension FilePath
1765 | BP_WithBadExtension FilePath
1737 | BP_WithAmbiguousSrcDir FilePath FilePath FilePath
1766 | BP_WithAmbiguousSrcDir FilePath FilePath FilePath
1738 | BP_MainPathDuplicate FilePath FilePath
1767 | BP_MainPathDuplicate FilePath FilePath
1739− | BP_MainNameDuplicate ModuleName.Raw FilePath FilePath
1768+ | BP_RootNameDuplicate ModuleName.Raw FilePath FilePath
1740− | BP_MainNameInvalid FilePath FilePath [String]
1769+ | BP_RootNameInvalid FilePath FilePath [String]
1741 | BP_CannotLoadDependencies
1770 | BP_CannotLoadDependencies
1742 | BP_Cycle ModuleName.Raw [ModuleName.Raw]
1771 | BP_Cycle ModuleName.Raw [ModuleName.Raw]
1743 | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))
1772 | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))
@@ -1746,8 +1775,8 @@ data BuildProjectProblem
1746toBuildProblemReport :: BuildProblem -> Help.Report
1775toBuildProblemReport :: BuildProblem -> Help.Report
1747toBuildProblemReport problem =
1776toBuildProblemReport problem =
1748 case problem of
1777 case problem of
1749− BuildBadModules e es ->
1778+ BuildBadModules root e es ->
1750− Help.compilerReport e es
1779+ Help.compilerReport root e es
1751
1780
1752 BuildProjectProblem projectProblem ->
1781 BuildProjectProblem projectProblem ->
1753 toProjectProblemReport projectProblem
1782 toProjectProblemReport projectProblem
@@ -1804,7 +1833,7 @@ toProjectProblemReport projectProblem =
1804 \ unstuck!"
1833 \ unstuck!"
1805 ]
1834 ]
1806
1835
1807− BP_MainNameDuplicate name outsidePath otherPath ->
1836+ BP_RootNameDuplicate name outsidePath otherPath ->
1808 Help.report "MODULE NAME CLASH" Nothing
1837 Help.report "MODULE NAME CLASH" Nothing
1809 "These two files are causing a module name clash:"
1838 "These two files are causing a module name clash:"
1810 [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]
1839 [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]
@@ -1815,7 +1844,7 @@ toProjectProblemReport projectProblem =
1815 "Try changing to a different module name in one of them!"
1844 "Try changing to a different module name in one of them!"
1816 ]
1845 ]
1817
1846
1818− BP_MainNameInvalid givenPath srcDir _ ->
1847+ BP_RootNameInvalid givenPath srcDir _ ->
1819 Help.report "UNEXPECTED FILE NAME" Nothing
1848 Help.report "UNEXPECTED FILE NAME" Nothing
1820 "I am having trouble with this file name:"
1849 "I am having trouble with this file name:"
1821 [ D.indent 4 $ D.red $ D.fromChars givenPath
1850 [ D.indent 4 $ D.red $ D.fromChars givenPath
@@ -1939,7 +1968,7 @@ toGenerateReport problem =
1939 "The issue is that --optimize strips out info needed by `Debug` functions.\
1968 "The issue is that --optimize strips out info needed by `Debug` functions.\
1940 \ Here are two examples:"
1969 \ Here are two examples:"
1941 , D.indent 4 $ D.reflow $
1970 , D.indent 4 $ D.reflow $
1942− "(1) It shortens record field names. This makes the generated JavaScript is\
1971+ "(1) It shortens record field names. This makes the generated JavaScript\
1943 \ smaller, but `Debug.toString` cannot know the real field names anymore."
1972 \ smaller, but `Debug.toString` cannot know the real field names anymore."
1944 , D.indent 4 $ D.reflow $
1973 , D.indent 4 $ D.reflow $
1945 "(2) Values like `type Height = Height Float` are unboxed. This reduces\
1974 "(2) Values like `type Height = Height Float` are unboxed. This reduces\
@@ -2008,7 +2037,7 @@ reactorToReport problem =
2008data Repl
2037data Repl
2009 = ReplBadDetails Details
2038 = ReplBadDetails Details
2010 | ReplBadInput BS.ByteString Error.Error
2039 | ReplBadInput BS.ByteString Error.Error
2011− | ReplBadLocalDeps Error.Module [Error.Module]
2040+ | ReplBadLocalDeps FilePath Error.Module [Error.Module]
2012 | ReplProjectProblem BuildProjectProblem
2041 | ReplProjectProblem BuildProjectProblem
2013 | ReplBadGenerate Generate
2042 | ReplBadGenerate Generate
2014 | ReplBadCache
2043 | ReplBadCache
@@ -2022,10 +2051,10 @@ replToReport problem =
2022 toDetailsReport details
2051 toDetailsReport details
2023
2052
2024 ReplBadInput source err ->
2053 ReplBadInput source err ->
2025− Help.compilerReport (Error.Module N.replModule "REPL" File.zeroTime source err) []
2054+ Help.compilerReport "/" (Error.Module N.replModule "REPL" File.zeroTime source err) []
2026
2055
2027− ReplBadLocalDeps e es ->
2056+ ReplBadLocalDeps root e es ->
2028− Help.compilerReport e es
2057+ Help.compilerReport root e es
2029
2058
2030 ReplProjectProblem projectProblem ->
2059 ReplProjectProblem projectProblem ->
2031 toProjectProblemReport projectProblem
2060 toProjectProblemReport projectProblem
@@ -2038,39 +2067,3 @@ replToReport problem =
2038
2067
2039 ReplBlocked ->
2068 ReplBlocked ->
2040 corruptCacheReport
2069 corruptCacheReport
2041−
2042−
2043−
2044−-- WORKER
2045−
2046−
2047−data Worker
2048− = WorkerInputError Error.Module
2049− | WorkerNoMain
2050−
2051−
2052−workerToReport :: Worker -> Help.Report
2053−workerToReport problem =
2054− case problem of
2055− WorkerInputError err ->
2056− Help.compilerReport err []
2057−
2058− WorkerNoMain ->
2059− Help.report "NO MAIN" Nothing
2060− (
2061− "Without a `main` value, I do not know what to show on screen!"
2062− )
2063− [ D.reflow $
2064− "Adding a `main` value can be as brief as:"
2065− , D.vcat
2066− [ D.fillSep [D.cyan "import","Html"]
2067− , ""
2068− , D.fillSep [D.green "main","="]
2069− , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
2070− ]
2071− , D.reflow $
2072− "Try adding something like that!"
2073− , D.toSimpleNote $
2074− "I recommend looking through https://guide.elm-lang.org for more advice on\
2075− \ how to fill in `main` values."
2076− ]
builder/src/Reporting/Exit/Help.hs+5−5
@@ -29,7 +29,7 @@ import qualified Reporting.Error as Error
29
29
30
30
31data Report
31data Report
32− = CompilerReport Error.Module [Error.Module]
32+ = CompilerReport FilePath Error.Module [Error.Module]
33 | Report
33 | Report
34 { _title :: String
34 { _title :: String
35 , _path :: Maybe FilePath
35 , _path :: Maybe FilePath
@@ -52,7 +52,7 @@ jsonReport =
52 Report
52 Report
53
53
54
54
55−compilerReport :: Error.Module -> [Error.Module] -> Report
55+compilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report
56compilerReport =
56compilerReport =
57 CompilerReport
57 CompilerReport
58
58
@@ -64,8 +64,8 @@ compilerReport =
64reportToDoc :: Report -> D.Doc
64reportToDoc :: Report -> D.Doc
65reportToDoc report_ =
65reportToDoc report_ =
66 case report_ of
66 case report_ of
67− CompilerReport e es ->
67+ CompilerReport root e es ->
68− Error.toDoc e es
68+ Error.toDoc root e es
69
69
70 Report title maybePath message ->
70 Report title maybePath message ->
71 let
71 let
@@ -94,7 +94,7 @@ reportToDoc report_ =
94reportToJson :: Report -> E.Value
94reportToJson :: Report -> E.Value
95reportToJson report_ =
95reportToJson report_ =
96 case report_ of
96 case report_ of
97− CompilerReport e es ->
97+ CompilerReport _ e es ->
98 E.object
98 E.object
99 [ "type" ==> E.chars "compile-errors"
99 [ "type" ==> E.chars "compile-errors"
100 , "errors" ==> E.list Error.toJson (e:es)
100 , "errors" ==> E.list Error.toJson (e:es)
builder/src/Stuff.hs+1−1
@@ -62,7 +62,7 @@ prepublishDir root =
62
62
63compilerVersion :: FilePath
63compilerVersion :: FilePath
64compilerVersion =
64compilerVersion =
65− V.toChars V.compiler ++ "-alpha-3"
65+ V.toChars V.compiler
66
66
67
67
68
68
compiler/src/AST/Source.hs+5−5
@@ -195,15 +195,15 @@ newtype Comment =
195
195
196data Exposing
196data Exposing
197 = Open
197 = Open
198− | Explicit [A.Located Exposed]
198+ | Explicit [Exposed]
199
199
200
200
201data Exposed
201data Exposed
202− = Lower Name
202+ = Lower (A.Located Name)
203− | Upper Name Privacy
203+ | Upper (A.Located Name) Privacy
204− | Operator Name
204+ | Operator A.Region Name
205
205
206
206
207data Privacy
207data Privacy
208− = Public
208+ = Public A.Region
209 | Private
209 | Private
compiler/src/AST/Utils/Shader.hs+2
@@ -74,9 +74,11 @@ escape chars =
74 []
74 []
75
75
76 c:cs
76 c:cs
77+ | c == '\r' -> escape cs
77 | c == '\n' -> '\\' : 'n' : escape cs
78 | c == '\n' -> '\\' : 'n' : escape cs
78 | c == '\"' -> '\\' : '"' : escape cs
79 | c == '\"' -> '\\' : '"' : escape cs
79 | c == '\'' -> '\\' : '\'' : escape cs
80 | c == '\'' -> '\\' : '\'' : escape cs
81+ | c == '\\' -> '\\' : '\\' : escape cs
80 | otherwise -> c : escape cs
82 | otherwise -> c : escape cs
81
83
82
84
compiler/src/AST/Utils/Type.hs−1
@@ -1,5 +1,4 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3module AST.Utils.Type
2module AST.Utils.Type
4 ( delambda
3 ( delambda
5 , dealias
4 , dealias
compiler/src/Canonicalize/Environment.hs+50−20
@@ -4,6 +4,8 @@ module Canonicalize.Environment
4 ( Env(..)
4 ( Env(..)
5 , Exposed
5 , Exposed
6 , Qualified
6 , Qualified
7+ , Info(..)
8+ , mergeInfo
7 , Var(..)
9 , Var(..)
8 , Type(..)
10 , Type(..)
9 , Ctor(..)
11 , Ctor(..)
@@ -20,8 +22,8 @@ module Canonicalize.Environment
20
22
21import qualified Data.Map.Merge.Strict as Map
23import qualified Data.Map.Merge.Strict as Map
22import qualified Data.Map.Strict as Map
24import qualified Data.Map.Strict as Map
23−import qualified Data.Map.Strict.Internal as I
24import qualified Data.Name as Name
25import qualified Data.Name as Name
26+import qualified Data.OneOrMore as OneOrMore
25
27
26import qualified AST.Utils.Binop as Binop
28import qualified AST.Utils.Binop as Binop
27import qualified AST.Canonical as Can
29import qualified AST.Canonical as Can
@@ -58,11 +60,34 @@ data Env =
58
60
59
61
60type Exposed a =
62type Exposed a =
61− Map.Map Name.Name (Map.Map ModuleName.Canonical a)
63+ Map.Map Name.Name (Info a)
62
64
63
65
64type Qualified a =
66type Qualified a =
65− Map.Map Name.Name (Map.Map Name.Name (Map.Map ModuleName.Canonical a))
67+ Map.Map Name.Name (Map.Map Name.Name (Info a))
68+
69+
70+
71+-- INFO
72+
73+
74+data Info a
75+ = Specific ModuleName.Canonical a
76+ | Ambiguous ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
77+
78+
79+mergeInfo :: Info a -> Info a -> Info a
80+mergeInfo info1 info2 =
81+ case info1 of
82+ Specific h1 _ ->
83+ case info2 of
84+ Specific h2 _ -> if h1 == h2 then info1 else Ambiguous h1 (OneOrMore.one h2)
85+ Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more (OneOrMore.one h2) hs2)
86+
87+ Ambiguous h1 hs1 ->
88+ case info2 of
89+ Specific h2 _ -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.one h2))
90+ Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.more (OneOrMore.one h2) hs2))
66
91
67
92
68
93
@@ -72,7 +97,8 @@ type Qualified a =
72data Var
97data Var
73 = Local A.Region
98 = Local A.Region
74 | TopLevel A.Region
99 | TopLevel A.Region
75− | Foreign (Map.Map ModuleName.Canonical Can.Annotation)
100+ | Foreign ModuleName.Canonical Can.Annotation
101+ | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
76
102
77
103
78
104
@@ -139,7 +165,10 @@ addLocalLeft _ region =
139addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
165addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
140addLocalBoth name region var =
166addLocalBoth name region var =
141 case var of
167 case var of
142− Foreign _ ->
168+ Foreign _ _ ->
169+ Result.ok (Local region)
170+
171+ Foreigns _ _ ->
143 Result.ok (Local region)
172 Result.ok (Local region)
144
173
145 Local parentRegion ->
174 Local parentRegion ->
@@ -150,17 +179,18 @@ addLocalBoth name region var =
150
179
151
180
152
181
182+
153-- FIND TYPE
183-- FIND TYPE
154
184
155
185
156findType :: A.Region -> Env -> Name.Name -> Result i w Type
186findType :: A.Region -> Env -> Name.Name -> Result i w Type
157findType region (Env _ _ ts _ _ _ qts _) name =
187findType region (Env _ _ ts _ _ _ qts _) name =
158 case Map.lookup name ts of
188 case Map.lookup name ts of
159− Just (I.Bin 1 _ tipe _ _) ->
189+ Just (Specific _ tipe) ->
160 Result.ok tipe
190 Result.ok tipe
161
191
162− Just homes ->
192+ Just (Ambiguous h hs) ->
163− Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))
193+ Result.throw (Error.AmbiguousType region Nothing name h hs)
164
194
165 Nothing ->
195 Nothing ->
166 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
196 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
@@ -171,11 +201,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
171 case Map.lookup prefix qts of
201 case Map.lookup prefix qts of
172 Just qualified ->
202 Just qualified ->
173 case Map.lookup name qualified of
203 case Map.lookup name qualified of
174− Just (I.Bin 1 _ tipe _ _) ->
204+ Just (Specific _ tipe) ->
175 Result.ok tipe
205 Result.ok tipe
176
206
177− Just homes ->
207+ Just (Ambiguous h hs) ->
178− Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))
208+ Result.throw (Error.AmbiguousType region (Just prefix) name h hs)
179
209
180 Nothing ->
210 Nothing ->
181 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
211 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
@@ -191,11 +221,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
191findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
221findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
192findCtor region (Env _ _ _ cs _ _ _ qcs) name =
222findCtor region (Env _ _ _ cs _ _ _ qcs) name =
193 case Map.lookup name cs of
223 case Map.lookup name cs of
194− Just (I.Bin 1 _ ctor _ _) ->
224+ Just (Specific _ ctor) ->
195 Result.ok ctor
225 Result.ok ctor
196
226
197− Just homes ->
227+ Just (Ambiguous h hs) ->
198− Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))
228+ Result.throw (Error.AmbiguousVariant region Nothing name h hs)
199
229
200 Nothing ->
230 Nothing ->
201 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
231 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
@@ -206,11 +236,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
206 case Map.lookup prefix qcs of
236 case Map.lookup prefix qcs of
207 Just qualified ->
237 Just qualified ->
208 case Map.lookup name qualified of
238 case Map.lookup name qualified of
209− Just (I.Bin 1 _ pattern _ _) ->
239+ Just (Specific _ pattern) ->
210 Result.ok pattern
240 Result.ok pattern
211
241
212− Just homes ->
242+ Just (Ambiguous h hs) ->
213− Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))
243+ Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)
214
244
215 Nothing ->
245 Nothing ->
216 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
246 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
@@ -226,11 +256,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
226findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
256findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
227findBinop region (Env _ _ _ _ binops _ _ _) name =
257findBinop region (Env _ _ _ _ binops _ _ _) name =
228 case Map.lookup name binops of
258 case Map.lookup name binops of
229− Just (I.Bin 1 _ binop _ _) ->
259+ Just (Specific _ binop) ->
230 Result.ok binop
260 Result.ok binop
231
261
232− Just homes ->
262+ Just (Ambiguous h hs) ->
233− Result.throw (Error.AmbiguousBinop region name (Map.keys homes))
263+ Result.throw (Error.AmbiguousBinop region name h hs)
234
264
235 Nothing ->
265 Nothing ->
236 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))
266 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))
compiler/src/Canonicalize/Environment/Dups.hs+1−1
@@ -105,7 +105,7 @@ one name region value =
105
105
106insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a
106insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a
107insert name region value dict =
107insert name region value dict =
108− Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict
108+ Map.insertWith (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict
109
109
110
110
111union :: Dict a -> Dict a -> Dict a
111union :: Dict a -> Dict a -> Dict a
compiler/src/Canonicalize/Environment/Foreign.hs+49−37
@@ -35,7 +35,14 @@ type Result i w a =
35createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
35createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
36createInitialEnv home ifaces imports =
36createInitialEnv home ifaces imports =
37 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)
37 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)
38− Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)
38+ Result.ok (Env.Env home (Map.map infoToVar vs) ts cs bs qvs qts qcs)
39+
40+
41+infoToVar :: Env.Info Can.Annotation -> Env.Var
42+infoToVar info =
43+ case info of
44+ Env.Specific home tipe -> Env.Foreign home tipe
45+ Env.Ambiguous h hs -> Env.Foreigns h hs
39
46
40
47
41
48
@@ -61,7 +68,7 @@ emptyState =
61
68
62emptyTypes :: Env.Exposed Env.Type
69emptyTypes :: Env.Exposed Env.Type
63emptyTypes =
70emptyTypes =
64− Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))
71+ Map.singleton "List" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))
65
72
66
73
67
74
@@ -102,8 +109,8 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
102 (Map.mapMaybeWithKey (unionToType home) unions)
109 (Map.mapMaybeWithKey (unionToType home) unions)
103 (Map.mapMaybeWithKey (aliasToType home) aliases)
110 (Map.mapMaybeWithKey (aliasToType home) aliases)
104
111
105− !vars = Map.map (Map.singleton home) defs
112+ !vars = Map.map (Env.Specific home) defs
106− !types = Map.map (Map.singleton home . fst) rawTypeInfo
113+ !types = Map.map (Env.Specific home . fst) rawTypeInfo
107 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
114 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
108
115
109 !qvs2 = addQualified prefix vars qvs
116 !qvs2 = addQualified prefix vars qvs
@@ -129,7 +136,7 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
129
136
130addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
137addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
131addExposed =
138addExposed =
132− Map.unionWith Map.union
139+ Map.unionWith Env.mergeInfo
133
140
134
141
135addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
142addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
@@ -150,7 +157,7 @@ unionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type,
150unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
157unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
151 let
158 let
152 addCtor dict (Can.Ctor ctor index _ args) =
159 addCtor dict (Can.Ctor ctor index _ args) =
153− Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict
160+ Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict
154 in
161 in
155 ( Env.Union (length vars) home
162 ( Env.Union (length vars) home
156 , List.foldl' addCtor Map.empty ctors
163 , List.foldl' addCtor Map.empty ctors
@@ -181,7 +188,7 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
181 (Can.TAlias home name avars (Can.Filled tipe))
188 (Can.TAlias home name avars (Can.Filled tipe))
182 (Can.fieldsToList fields)
189 (Can.fieldsToList fields)
183 in
190 in
184− Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))
191+ Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))
185
192
186 _ ->
193 _ ->
187 Map.empty
194 Map.empty
@@ -192,9 +199,9 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
192-- BINOP
199-- BINOP
193
200
194
201
195−binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop
202+binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop
196binopToBinop home op (I.Binop name annotation associativity precedence) =
203binopToBinop home op (I.Binop name annotation associativity precedence) =
197− Map.singleton home (Env.Binop op home name annotation associativity precedence)
204+ Env.Specific home (Env.Binop op home name annotation associativity precedence)
198
205
199
206
200
207
@@ -207,19 +214,19 @@ addExposedValue
207 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)
214 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)
208 -> Map.Map Name.Name I.Binop
215 -> Map.Map Name.Name I.Binop
209 -> State
216 -> State
210− -> A.Located Src.Exposed
217+ -> Src.Exposed
211 -> Result i w State
218 -> Result i w State
212−addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At region exposed) =
219+addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
213 case exposed of
220 case exposed of
214− Src.Lower name ->
221+ Src.Lower (A.At region name) ->
215 case Map.lookup name vars of
222 case Map.lookup name vars of
216 Just info ->
223 Just info ->
217− Result.ok (State (Map.insertWith Map.union name info vs) ts cs bs qvs qts qcs)
224+ Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)
218
225
219 Nothing ->
226 Nothing ->
220 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
227 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
221
228
222− Src.Upper name privacy ->
229+ Src.Upper (A.At region name) privacy ->
223 case privacy of
230 case privacy of
224 Src.Private ->
231 Src.Private ->
225 case Map.lookup name types of
232 case Map.lookup name types of
@@ -227,43 +234,43 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg
227 case tipe of
234 case tipe of
228 Env.Union _ _ ->
235 Env.Union _ _ ->
229 let
236 let
230− !ts2 = Map.insert name (Map.singleton home tipe) ts
237+ !ts2 = Map.insert name (Env.Specific home tipe) ts
231 in
238 in
232 Result.ok (State vs ts2 cs bs qvs qts qcs)
239 Result.ok (State vs ts2 cs bs qvs qts qcs)
233
240
234 Env.Alias _ _ _ _ ->
241 Env.Alias _ _ _ _ ->
235 let
242 let
236− !ts2 = Map.insert name (Map.singleton home tipe) ts
243+ !ts2 = Map.insert name (Env.Specific home tipe) ts
237 !cs2 = addExposed cs ctors
244 !cs2 = addExposed cs ctors
238 in
245 in
239 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
246 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
240
247
241 Nothing ->
248 Nothing ->
242− case Map.lookup name (toCtors types) of
249+ case checkForCtorMistake name types of
243− Just tipe ->
250+ tipe:_ ->
244 Result.throw $ Error.ImportCtorByName region name tipe
251 Result.throw $ Error.ImportCtorByName region name tipe
245
252
246− Nothing ->
253+ [] ->
247 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
254 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
248
255
249− Src.Public ->
256+ Src.Public dotDotRegion ->
250 case Map.lookup name types of
257 case Map.lookup name types of
251 Just (tipe, ctors) ->
258 Just (tipe, ctors) ->
252 case tipe of
259 case tipe of
253 Env.Union _ _ ->
260 Env.Union _ _ ->
254 let
261 let
255− !ts2 = Map.insert name (Map.singleton home tipe) ts
262+ !ts2 = Map.insert name (Env.Specific home tipe) ts
256 !cs2 = addExposed cs ctors
263 !cs2 = addExposed cs ctors
257 in
264 in
258 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
265 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
259
266
260 Env.Alias _ _ _ _ ->
267 Env.Alias _ _ _ _ ->
261− Result.throw (Error.ImportOpenAlias region name)
268+ Result.throw (Error.ImportOpenAlias dotDotRegion name)
262
269
263 Nothing ->
270 Nothing ->
264 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))
271 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))
265
272
266− Src.Operator op ->
273+ Src.Operator region op ->
267 case Map.lookup op binops of
274 case Map.lookup op binops of
268 Just binop ->
275 Just binop ->
269 let
276 let
@@ -275,18 +282,23 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg
275 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
282 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
276
283
277
284
278−
279−toCtors :: Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> Map.Map Name.Name Name.Name
285+checkForCtorMistake :: Name.Name -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> [Name.Name]
280−toCtors types =
286+checkForCtorMistake givenName types =
281− Map.foldr addCtors Map.empty types
287+ Map.foldr addMatches [] types
282 where
288 where
283− addCtors (_, exposedCtors) dict =
289+ addMatches (_, exposedCtors) matches =
284− Map.foldrWithKey addCtor dict exposedCtors
290+ Map.foldrWithKey addMatch matches exposedCtors
285−
291+
286− addCtor ctorName homes dict =
292+ addMatch ctorName info matches =
293+ if ctorName /= givenName
294+ then matches
295+ else
287− case Map.elems homes of
296+ case info of
288− [Env.Ctor _ tipeName _ _ _] ->
297+ Env.Specific _ (Env.Ctor _ tipeName _ _ _) ->
289− Map.insert ctorName tipeName dict
298+ tipeName : matches
290−
299+
291− _ ->
300+ Env.Specific _ (Env.RecordCtor _ _ _) ->
292− dict
301+ matches
302+
303+ Env.Ambiguous _ _ ->
304+ matches
compiler/src/Canonicalize/Environment/Local.hs+5−5
@@ -110,7 +110,7 @@ addTypes (Src.Module _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs
110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)
110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)
111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =
111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =
112 do arity <- checkUnionFreeVars union
112 do arity <- checkUnionFreeVars union
113− let one = Map.singleton home (Env.Union arity home)
113+ let one = Env.Specific home (Env.Union arity home)
114 Result.ok $ Map.insert name one types
114 Result.ok $ Map.insert name one types
115
115
116
116
@@ -133,7 +133,7 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =
133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->
133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->
134 do args <- checkAliasFreeVars alias
134 do args <- checkAliasFreeVars alias
135 ctype <- Type.canonicalize env tipe
135 ctype <- Type.canonicalize env tipe
136− let one = Map.singleton home (Env.Alias (length args) home args ctype)
136+ let one = Env.Specific home (Env.Alias (length args) home args ctype)
137 let ts1 = Map.insert name one ts
137 let ts1 = Map.insert name one ts
138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
139
139
@@ -281,7 +281,7 @@ addCtors (Src.Module _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs
281 )
281 )
282
282
283
283
284−type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)
284+type CtorDups = Dups.Dict (Env.Info Env.Ctor)
285
285
286
286
287
287
@@ -297,7 +297,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At regi
297 ,
297 ,
298 case ctipe of
298 case ctipe of
299 Can.TRecord fields Nothing ->
299 Can.TRecord fields Nothing ->
300− Dups.one name region (Map.singleton home (toRecordCtor home name vars fields))
300+ Dups.one name region (Env.Specific home (toRecordCtor home name vars fields))
301
301
302 _ ->
302 _ ->
303 Dups.none
303 Dups.none
@@ -351,5 +351,5 @@ toOpts ctors =
351
351
352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
354− Dups.one name region $ Map.singleton home $
354+ Dups.one name region $ Env.Specific home $
355 Env.Ctor home typeName union index args
355 Env.Ctor home typeName union index args
compiler/src/Canonicalize/Expression.hs+6−7
@@ -14,7 +14,6 @@ import Control.Monad (foldM)
14import qualified Data.Graph as Graph
14import qualified Data.Graph as Graph
15import qualified Data.List as List
15import qualified Data.List as List
16import qualified Data.Map.Strict as Map
16import qualified Data.Map.Strict as Map
17−import qualified Data.Map.Strict.Internal as I
18import qualified Data.Name as Name
17import qualified Data.Name as Name
19
18
20import qualified AST.Canonical as Can
19import qualified AST.Canonical as Can
@@ -696,15 +695,15 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =
696 Env.TopLevel _ ->
695 Env.TopLevel _ ->
697 logVar name (Can.VarTopLevel localHome name)
696 logVar name (Can.VarTopLevel localHome name)
698
697
699− Env.Foreign (I.Bin 1 home annotation _ _) ->
698+ Env.Foreign home annotation ->
700 Result.ok $
699 Result.ok $
701 if home == ModuleName.debug then
700 if home == ModuleName.debug then
702 Can.VarDebug localHome name annotation
701 Can.VarDebug localHome name annotation
703 else
702 else
704 Can.VarForeign home name annotation
703 Can.VarForeign home name annotation
705
704
706− Env.Foreign homes ->
705+ Env.Foreigns h hs ->
707− Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))
706+ Result.throw (Error.AmbiguousVar region Nothing name h hs)
708
707
709 Nothing ->
708 Nothing ->
710 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
709 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
@@ -715,15 +714,15 @@ findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =
715 case Map.lookup prefix qvs of
714 case Map.lookup prefix qvs of
716 Just qualified ->
715 Just qualified ->
717 case Map.lookup name qualified of
716 case Map.lookup name qualified of
718− Just (I.Bin 1 home annotation _ _) ->
717+ Just (Env.Specific home annotation) ->
719 Result.ok $
718 Result.ok $
720 if home == ModuleName.debug then
719 if home == ModuleName.debug then
721 Can.VarDebug localHome name annotation
720 Can.VarDebug localHome name annotation
722 else
721 else
723 Can.VarForeign home name annotation
722 Can.VarForeign home name annotation
724
723
725− Just homes ->
724+ Just (Env.Ambiguous h hs) ->
726− Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))
725+ Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)
727
726
728 Nothing ->
727 Nothing ->
729 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))
728 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))
compiler/src/Canonicalize/Module.hs+7−7
@@ -236,11 +236,11 @@ checkExposed
236 -> Map.Map Name.Name alias
236 -> Map.Map Name.Name alias
237 -> Map.Map Name.Name binop
237 -> Map.Map Name.Name binop
238 -> Can.Effects
238 -> Can.Effects
239− -> A.Located Src.Exposed
239+ -> Src.Exposed
240 -> Result i w (Dups.Dict (A.Located Can.Export))
240 -> Result i w (Dups.Dict (A.Located Can.Export))
241−checkExposed values unions aliases binops effects (A.At region exposed) =
241+checkExposed values unions aliases binops effects exposed =
242 case exposed of
242 case exposed of
243− Src.Lower name ->
243+ Src.Lower (A.At region name) ->
244 if Map.member name values then
244 if Map.member name values then
245 ok name region Can.ExportValue
245 ok name region Can.ExportValue
246 else
246 else
@@ -252,23 +252,23 @@ checkExposed values unions aliases binops effects (A.At region exposed) =
252 Result.throw $ Error.ExportNotFound region Error.BadVar name $
252 Result.throw $ Error.ExportNotFound region Error.BadVar name $
253 ports ++ Map.keys values
253 ports ++ Map.keys values
254
254
255− Src.Operator name ->
255+ Src.Operator region name ->
256 if Map.member name binops then
256 if Map.member name binops then
257 ok name region Can.ExportBinop
257 ok name region Can.ExportBinop
258 else
258 else
259 Result.throw $ Error.ExportNotFound region Error.BadOp name $
259 Result.throw $ Error.ExportNotFound region Error.BadOp name $
260 Map.keys binops
260 Map.keys binops
261
261
262− Src.Upper name Src.Public ->
262+ Src.Upper (A.At region name) (Src.Public dotDotRegion) ->
263 if Map.member name unions then
263 if Map.member name unions then
264 ok name region Can.ExportUnionOpen
264 ok name region Can.ExportUnionOpen
265 else if Map.member name aliases then
265 else if Map.member name aliases then
266− Result.throw $ Error.ExportOpenAlias region name
266+ Result.throw $ Error.ExportOpenAlias dotDotRegion name
267 else
267 else
268 Result.throw $ Error.ExportNotFound region Error.BadType name $
268 Result.throw $ Error.ExportNotFound region Error.BadType name $
269 Map.keys unions ++ Map.keys aliases
269 Map.keys unions ++ Map.keys aliases
270
270
271− Src.Upper name Src.Private ->
271+ Src.Upper (A.At region name) Src.Private ->
272 if Map.member name unions then
272 if Map.member name unions then
273 ok name region Can.ExportUnionClosed
273 ok name region Can.ExportUnionClosed
274 else if Map.member name aliases then
274 else if Map.member name aliases then
compiler/src/Canonicalize/Pattern.hs+3−2
@@ -8,6 +8,7 @@ module Canonicalize.Pattern
8 where
8 where
9
9
10
10
11+import qualified Data.List as List
11import qualified Data.Map.Strict as Map
12import qualified Data.Map.Strict as Map
12import qualified Data.Name as Name
13import qualified Data.Name as Name
13
14
@@ -173,8 +174,8 @@ logVar name region value =
173logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a
174logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a
174logFields fields value =
175logFields fields value =
175 let
176 let
176− addField (A.At region name) dict =
177+ addField dict (A.At region name) =
177 Dups.insert name region region dict
178 Dups.insert name region region dict
178 in
179 in
179 Result.Result $ \bindings warnings _ ok ->
180 Result.Result $ \bindings warnings _ ok ->
180− ok (foldr addField bindings fields) warnings value
181+ ok (List.foldl' addField bindings fields) warnings value
compiler/src/Data/Name.hs+1−1
@@ -304,7 +304,7 @@ fromManyNames names =
304 case names of
304 case names of
305 [] ->
305 [] ->
306 blank
306 blank
307− -- this case is needed for (let _ = Debug.log "x" x in ...)
307+ -- NOTE: this case is needed for (let _ = Debug.log "x" x in ...)
308 -- but maybe unused patterns should be stripped out instead
308 -- but maybe unused patterns should be stripped out instead
309
309
310 Utf8.Utf8 ba# : _ ->
310 Utf8.Utf8 ba# : _ ->
compiler/src/Data/Utf8.hs+3−1
@@ -261,7 +261,9 @@ instance Eq (Utf8 t) where
261
261
262
262
263-- COMPARE
263-- COMPARE
264−
264+--
265+-- TODO: is it fine to sort by length and only compare bytes on length ties?
266+--
265
267
266instance Ord (Utf8 t) where
268instance Ord (Utf8 t) where
267 compare (Utf8 ba1#) (Utf8 ba2#) =
269 compare (Utf8 ba1#) (Utf8 ba2#) =
compiler/src/Elm/Compiler/Imports.hs+3−3
@@ -49,14 +49,14 @@ closed =
49
49
50typeOpen :: Name.Name -> Src.Exposing
50typeOpen :: Name.Name -> Src.Exposing
51typeOpen name =
51typeOpen name =
52− Src.Explicit [ A.At A.zero (Src.Upper name Src.Public) ]
52+ Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]
53
53
54
54
55typeClosed :: Name.Name -> Src.Exposing
55typeClosed :: Name.Name -> Src.Exposing
56typeClosed name =
56typeClosed name =
57− Src.Explicit [ A.At A.zero (Src.Upper name Src.Private) ]
57+ Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]
58
58
59
59
60operator :: Name.Name -> Src.Exposing
60operator :: Name.Name -> Src.Exposing
61operator op =
61operator op =
62− Src.Explicit [ A.At A.zero (Src.Operator op) ]
62+ Src.Explicit [ Src.Operator A.zero op ]
compiler/src/Elm/Kernel.hs+9−9
@@ -15,7 +15,7 @@ import qualified Data.ByteString.Internal as B
15import qualified Data.List as List
15import qualified Data.List as List
16import qualified Data.Map as Map
16import qualified Data.Map as Map
17import qualified Data.Name as Name
17import qualified Data.Name as Name
18−import Data.Word (Word8, Word16)
18+import Data.Word (Word8)
19import Foreign.Ptr (Ptr, plusPtr, minusPtr)
19import Foreign.Ptr (Ptr, plusPtr, minusPtr)
20import Foreign.ForeignPtr (ForeignPtr)
20import Foreign.ForeignPtr (ForeignPtr)
21import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
21import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
@@ -128,7 +128,7 @@ parseChunks vtable enums fields =
128 cerr row col toError
128 cerr row col toError
129
129
130
130
131−chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
131+chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)
132chompChunks vs es fs src pos end row col lastPos revChunks =
132chompChunks vs es fs src pos end row col lastPos revChunks =
133 if pos >= end then
133 if pos >= end then
134 let !js = toByteString src lastPos end in
134 let !js = toByteString src lastPos end in
@@ -168,7 +168,7 @@ toByteString src pos end =
168
168
169
169
170-- relies on external checks in chompChunks
170-- relies on external checks in chompChunks
171−chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> [Chunk] -> (# [Chunk], Ptr Word8, Word16, Word16 #)
171+chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Row -> Col -> [Chunk] -> (# [Chunk], Ptr Word8, Row, Col #)
172chompTag vs es fs src pos end row col revChunks =
172chompTag vs es fs src pos end row col revChunks =
173 let
173 let
174 (# newPos, newCol #) = Var.chompInnerChars pos end col
174 (# newPos, newCol #) = Var.chompInnerChars pos end col
@@ -319,19 +319,19 @@ toNames exposing =
319 map toName exposedList
319 map toName exposedList
320
320
321
321
322−toName :: A.Located Src.Exposed -> Name.Name
322+toName :: Src.Exposed -> Name.Name
323−toName (A.At _ exposed) =
323+toName exposed =
324 case exposed of
324 case exposed of
325− Src.Lower name ->
325+ Src.Lower (A.At _ name) ->
326 name
326 name
327
327
328− Src.Upper name Src.Private ->
328+ Src.Upper (A.At _ name) Src.Private ->
329 name
329 name
330
330
331− Src.Upper _ Src.Public ->
331+ Src.Upper _ (Src.Public _) ->
332 error "cannot have Maybe(..) syntax in kernel code header"
332 error "cannot have Maybe(..) syntax in kernel code header"
333
333
334− Src.Operator _ ->
334+ Src.Operator _ _ ->
335 error "cannot use binops in kernel code"
335 error "cannot use binops in kernel code"
336
336
337
337
compiler/src/Elm/Licenses.hs+25−25
@@ -83,63 +83,61 @@ check givenCode =
83osiApprovedSpdxLicenses :: Map.Map Json.String [Char]
83osiApprovedSpdxLicenses :: Map.Map Json.String [Char]
84osiApprovedSpdxLicenses =
84osiApprovedSpdxLicenses =
85 Map.fromList
85 Map.fromList
86+ [ "0BSD" ==> "BSD Zero Clause License"
87+ , "AAL" ==> "Attribution Assurance License"
86− [ "AFL-1.1" ==> "Academic Free License v1.1"
88+ , "AFL-1.1" ==> "Academic Free License v1.1"
87 , "AFL-1.2" ==> "Academic Free License v1.2"
89 , "AFL-1.2" ==> "Academic Free License v1.2"
88 , "AFL-2.0" ==> "Academic Free License v2.0"
90 , "AFL-2.0" ==> "Academic Free License v2.0"
89 , "AFL-2.1" ==> "Academic Free License v2.1"
91 , "AFL-2.1" ==> "Academic Free License v2.1"
90 , "AFL-3.0" ==> "Academic Free License v3.0"
92 , "AFL-3.0" ==> "Academic Free License v3.0"
91− , "APL-1.0" ==> "Adaptive Public License 1.0"
93+ , "AGPL-3.0" ==> "GNU Affero General Public License v3.0"
92 , "Apache-1.1" ==> "Apache License 1.1"
94 , "Apache-1.1" ==> "Apache License 1.1"
93 , "Apache-2.0" ==> "Apache License 2.0"
95 , "Apache-2.0" ==> "Apache License 2.0"
96+ , "APL-1.0" ==> "Adaptive Public License 1.0"
94 , "APSL-1.0" ==> "Apple Public Source License 1.0"
97 , "APSL-1.0" ==> "Apple Public Source License 1.0"
95 , "APSL-1.1" ==> "Apple Public Source License 1.1"
98 , "APSL-1.1" ==> "Apple Public Source License 1.1"
96 , "APSL-1.2" ==> "Apple Public Source License 1.2"
99 , "APSL-1.2" ==> "Apple Public Source License 1.2"
97 , "APSL-2.0" ==> "Apple Public Source License 2.0"
100 , "APSL-2.0" ==> "Apple Public Source License 2.0"
98 , "Artistic-1.0" ==> "Artistic License 1.0"
101 , "Artistic-1.0" ==> "Artistic License 1.0"
99− , "Artistic-1.0-Perl" ==> "Artistic License 1.0 (Perl)"
100 , "Artistic-1.0-cl8" ==> "Artistic License 1.0 w/clause 8"
102 , "Artistic-1.0-cl8" ==> "Artistic License 1.0 w/clause 8"
103+ , "Artistic-1.0-Perl" ==> "Artistic License 1.0 (Perl)"
101 , "Artistic-2.0" ==> "Artistic License 2.0"
104 , "Artistic-2.0" ==> "Artistic License 2.0"
102− , "AAL" ==> "Attribution Assurance License"
103− , "BSL-1.0" ==> "Boost Software License 1.0"
104 , "BSD-2-Clause" ==> "BSD 2-clause \"Simplified\" License"
105 , "BSD-2-Clause" ==> "BSD 2-clause \"Simplified\" License"
105 , "BSD-3-Clause" ==> "BSD 3-clause \"New\" or \"Revised\" License"
106 , "BSD-3-Clause" ==> "BSD 3-clause \"New\" or \"Revised\" License"
106− , "0BSD" ==> "BSD Zero Clause 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"
107 , "CECILL-2.1" ==> "CeCILL Free Software License Agreement v2.1"
110 , "CECILL-2.1" ==> "CeCILL Free Software License Agreement v2.1"
108 , "CNRI-Python" ==> "CNRI Python License"
111 , "CNRI-Python" ==> "CNRI Python License"
109− , "CDDL-1.0" ==> "Common Development and Distribution License 1.0"
110 , "CPAL-1.0" ==> "Common Public Attribution License 1.0"
112 , "CPAL-1.0" ==> "Common Public Attribution License 1.0"
111 , "CPL-1.0" ==> "Common Public License 1.0"
113 , "CPL-1.0" ==> "Common Public License 1.0"
112− , "CATOSL-1.1" ==> "Computer Associates Trusted Open Source License 1.1"
113 , "CUA-OPL-1.0" ==> "CUA Office Public License v1.0"
114 , "CUA-OPL-1.0" ==> "CUA Office Public License v1.0"
114− , "EPL-1.0" ==> "Eclipse Public License 1.0"
115 , "ECL-1.0" ==> "Educational Community License v1.0"
115 , "ECL-1.0" ==> "Educational Community License v1.0"
116 , "ECL-2.0" ==> "Educational Community License v2.0"
116 , "ECL-2.0" ==> "Educational Community License v2.0"
117 , "EFL-1.0" ==> "Eiffel Forum License v1.0"
117 , "EFL-1.0" ==> "Eiffel Forum License v1.0"
118 , "EFL-2.0" ==> "Eiffel Forum License v2.0"
118 , "EFL-2.0" ==> "Eiffel Forum License v2.0"
119 , "Entessa" ==> "Entessa Public License v1.0"
119 , "Entessa" ==> "Entessa Public License v1.0"
120+ , "EPL-1.0" ==> "Eclipse Public License 1.0"
120 , "EUDatagrid" ==> "EU DataGrid Software License"
121 , "EUDatagrid" ==> "EU DataGrid Software License"
121 , "EUPL-1.1" ==> "European Union Public License 1.1"
122 , "EUPL-1.1" ==> "European Union Public License 1.1"
122 , "Fair" ==> "Fair License"
123 , "Fair" ==> "Fair License"
123 , "Frameworx-1.0" ==> "Frameworx Open License 1.0"
124 , "Frameworx-1.0" ==> "Frameworx Open License 1.0"
124− , "AGPL-3.0" ==> "GNU Affero General Public License v3.0"
125 , "GPL-2.0" ==> "GNU General Public License v2.0 only"
125 , "GPL-2.0" ==> "GNU General Public License v2.0 only"
126 , "GPL-3.0" ==> "GNU General Public License v3.0 only"
126 , "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"
130 , "HPND" ==> "Historic Permission Notice and Disclaimer"
127 , "HPND" ==> "Historic Permission Notice and Disclaimer"
131− , "IPL-1.0" ==> "IBM Public License v1.0"
132 , "Intel" ==> "Intel Open Source License"
128 , "Intel" ==> "Intel Open Source License"
133 , "IPA" ==> "IPA Font License"
129 , "IPA" ==> "IPA Font License"
130+ , "IPL-1.0" ==> "IBM Public License v1.0"
134 , "ISC" ==> "ISC License"
131 , "ISC" ==> "ISC License"
135− , "LPPL-1.3c" ==> "LaTeX Project Public License v1.3c"
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"
136 , "LiLiQ-P-1.1" ==> "Licence Libre du Québec – Permissive version 1.1"
135 , "LiLiQ-P-1.1" ==> "Licence Libre du Québec – Permissive version 1.1"
137− , "LiLiQ-Rplus-1.1" ==> "Licence Libre du Québec – Réciprocité forte version 1.1"
138 , "LiLiQ-R-1.1" ==> "Licence Libre du Québec – Réciprocité version 1.1"
136 , "LiLiQ-R-1.1" ==> "Licence Libre du Québec – Réciprocité version 1.1"
139− , "LPL-1.02" ==> "Lucent Public License v1.02"
137+ , "LiLiQ-Rplus-1.1" ==> "Licence Libre du Québec – Réciprocité forte version 1.1"
140 , "LPL-1.0" ==> "Lucent Public License Version 1.0"
138 , "LPL-1.0" ==> "Lucent Public License Version 1.0"
141− , "MS-PL" ==> "Microsoft Public License"
139+ , "LPL-1.02" ==> "Lucent Public License v1.02"
142− , "MS-RL" ==> "Microsoft Reciprocal License"
140+ , "LPPL-1.3c" ==> "LaTeX Project Public License v1.3c"
143 , "MirOS" ==> "MirOS Licence"
141 , "MirOS" ==> "MirOS Licence"
144 , "MIT" ==> "MIT License"
142 , "MIT" ==> "MIT License"
145 , "Motosoto" ==> "Motosoto License"
143 , "Motosoto" ==> "Motosoto License"
@@ -147,38 +145,40 @@ osiApprovedSpdxLicenses =
147 , "MPL-1.1" ==> "Mozilla Public License 1.1"
145 , "MPL-1.1" ==> "Mozilla Public License 1.1"
148 , "MPL-2.0" ==> "Mozilla Public License 2.0"
146 , "MPL-2.0" ==> "Mozilla Public License 2.0"
149 , "MPL-2.0-no-copyleft-exception" ==> "Mozilla Public License 2.0 (no copyleft exception)"
147 , "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"
150 , "Multics" ==> "Multics License"
150 , "Multics" ==> "Multics License"
151 , "NASA-1.3" ==> "NASA Open Source Agreement 1.3"
151 , "NASA-1.3" ==> "NASA Open Source Agreement 1.3"
152 , "Naumen" ==> "Naumen Public License"
152 , "Naumen" ==> "Naumen Public License"
153+ , "NCSA" ==> "University of Illinois/NCSA Open Source License"
153 , "NGPL" ==> "Nethack General Public License"
154 , "NGPL" ==> "Nethack General Public License"
154 , "Nokia" ==> "Nokia Open Source License"
155 , "Nokia" ==> "Nokia Open Source License"
155 , "NPOSL-3.0" ==> "Non-Profit Open Software License 3.0"
156 , "NPOSL-3.0" ==> "Non-Profit Open Software License 3.0"
156 , "NTP" ==> "NTP License"
157 , "NTP" ==> "NTP License"
157 , "OCLC-2.0" ==> "OCLC Research Public License 2.0"
158 , "OCLC-2.0" ==> "OCLC Research Public License 2.0"
159+ , "OFL-1.1" ==> "SIL Open Font License 1.1"
158 , "OGTSL" ==> "Open Group Test Suite License"
160 , "OGTSL" ==> "Open Group Test Suite License"
161+ , "OSET-PL-2.1" ==> "OSET Public License version 2.1"
159 , "OSL-1.0" ==> "Open Software License 1.0"
162 , "OSL-1.0" ==> "Open Software License 1.0"
160 , "OSL-2.0" ==> "Open Software License 2.0"
163 , "OSL-2.0" ==> "Open Software License 2.0"
161 , "OSL-2.1" ==> "Open Software License 2.1"
164 , "OSL-2.1" ==> "Open Software License 2.1"
162 , "OSL-3.0" ==> "Open Software License 3.0"
165 , "OSL-3.0" ==> "Open Software License 3.0"
163− , "OSET-PL-2.1" ==> "OSET Public License version 2.1"
164 , "PHP-3.0" ==> "PHP License v3.0"
166 , "PHP-3.0" ==> "PHP License v3.0"
165 , "PostgreSQL" ==> "PostgreSQL License"
167 , "PostgreSQL" ==> "PostgreSQL License"
166 , "Python-2.0" ==> "Python License 2.0"
168 , "Python-2.0" ==> "Python License 2.0"
167 , "QPL-1.0" ==> "Q Public License 1.0"
169 , "QPL-1.0" ==> "Q Public License 1.0"
168− , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"
169 , "RPL-1.1" ==> "Reciprocal Public License 1.1"
170 , "RPL-1.1" ==> "Reciprocal Public License 1.1"
170 , "RPL-1.5" ==> "Reciprocal Public License 1.5"
171 , "RPL-1.5" ==> "Reciprocal Public License 1.5"
172+ , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"
171 , "RSCPL" ==> "Ricoh Source Code Public License"
173 , "RSCPL" ==> "Ricoh Source Code Public License"
172− , "OFL-1.1" ==> "SIL Open Font License 1.1"
173 , "SimPL-2.0" ==> "Simple Public License 2.0"
174 , "SimPL-2.0" ==> "Simple Public License 2.0"
174− , "Sleepycat" ==> "Sleepycat License"
175 , "SISSL" ==> "Sun Industry Standards Source License v1.1"
175 , "SISSL" ==> "Sun Industry Standards Source License v1.1"
176+ , "Sleepycat" ==> "Sleepycat License"
176 , "SPL-1.0" ==> "Sun Public License v1.0"
177 , "SPL-1.0" ==> "Sun Public License v1.0"
177− , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"
178 , "UPL-1.0" ==> "Universal Permissive License v1.0"
178 , "UPL-1.0" ==> "Universal Permissive License v1.0"
179− , "NCSA" ==> "University of Illinois/NCSA Open Source License"
180 , "VSL-1.0" ==> "Vovida Software License v1.0"
179 , "VSL-1.0" ==> "Vovida Software License v1.0"
181 , "W3C" ==> "W3C Software Notice and License (2002-12-31)"
180 , "W3C" ==> "W3C Software Notice and License (2002-12-31)"
181+ , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"
182 , "Xnet" ==> "X.Net License"
182 , "Xnet" ==> "X.Net License"
183 , "Zlib" ==> "zlib License"
183 , "Zlib" ==> "zlib License"
184 , "ZPL-2.0" ==> "Zope Public License 2.0"
184 , "ZPL-2.0" ==> "Zope Public License 2.0"
compiler/src/Elm/ModuleName.hs+2−6
@@ -7,12 +7,13 @@ module Elm.ModuleName
7 --
7 --
8 , encode
8 , encode
9 , decoder
9 , decoder
10+ , parser
10 --
11 --
11 , Canonical(..)
12 , Canonical(..)
12 , basics, char, string
13 , basics, char, string
13 , maybe, result, list, array, dict, tuple
14 , maybe, result, list, array, dict, tuple
14 , platform, cmd, sub
15 , platform, cmd, sub
15− , debug, bitwise
16+ , debug
16 , virtualDom
17 , virtualDom
17 , jsonDecode, jsonEncode
18 , jsonDecode, jsonEncode
18 , webgl, texture, vector2, vector3, vector4, matrix4
19 , webgl, texture, vector2, vector3, vector4, matrix4
@@ -225,11 +226,6 @@ debug :: Canonical
225debug = Canonical Pkg.core Name.debug
226debug = Canonical Pkg.core Name.debug
226
227
227
228
228−{-# NOINLINE bitwise #-}
229−bitwise :: Canonical
230−bitwise = Canonical Pkg.core Name.bitwise
231−
232−
233
229
234-- HTML
230-- HTML
235
231
compiler/src/Generate/Html.hs+4−8
@@ -29,20 +29,16 @@ sandwich moduleName javascript =
29
29
30<body>
30<body>
31
31
32−<pre id="elm">
32+<pre id="elm"></pre>
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>
39
33
40<script>
34<script>
41try {
35try {
42|] <> javascript <> [r|
36|] <> javascript <> [r|
43
37
44 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
38 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
39+}
45−} catch (e) {
40+catch (e)
41+{
46 // display initialization errors (e.g. bad flags, infinite recursion)
42 // display initialization errors (e.g. bad flags, infinite recursion)
47 var header = document.createElement("h1");
43 var header = document.createElement("h1");
48 header.style.fontFamily = "monospace";
44 header.style.fontFamily = "monospace";
compiler/src/Generate/JavaScript.hs+45−10
@@ -2,6 +2,7 @@
2module Generate.JavaScript
2module Generate.JavaScript
3 ( generate
3 ( generate
4 , generateForRepl
4 , generateForRepl
5+ , generateForReplEndpoint
5 )
6 )
6 where
7 where
7
8
@@ -85,7 +86,8 @@ generateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _
85 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")
86 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")
86 evalState = addGlobal mode graph debugState (Opt.Global home name)
87 evalState = addGlobal mode graph debugState (Opt.Global home name)
87 in
88 in
89+ "process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\n'); process.exit(1); });"
88− Functions.functions
90+ <> Functions.functions
89 <> stateToBuilder evalState
91 <> stateToBuilder evalState
90 <> print ansi localizer home name tipe
92 <> print ansi localizer home name tipe
91
93
@@ -98,14 +100,47 @@ print ansi localizer home name tipe =
98 tipeDoc = RT.canToDoc localizer RT.None tipe
100 tipeDoc = RT.canToDoc localizer RT.None tipe
99 bool = if ansi then "true" else "false"
101 bool = if ansi then "true" else "false"
100 in
102 in
101− "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\
103+ "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\
102− \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\
104+ \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\
103− \function _print(t) { console.log(_value + (" <> bool <> " ? '\x1b[90m' + t + '\x1b[0m' : t)); }\n\
105+ \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\
106+ \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\
105− \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\
107+ \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\
106− \} else {\n\
108+ \} else {\n\
107− \ _print(' : ' + _type);\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\
108− \}\n"
143+ \});\n"
109
144
110
145
111
146
@@ -257,7 +292,7 @@ generateCycle mode (Opt.Global home _) names values functions =
257 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"
292 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"
258 <> drawCycle names
293 <> drawCycle names
259 <> "\\n\\nThese errors are very tricky, so read "
294 <> "\\n\\nThese errors are very tricky, so read "
260− <> B.stringUtf8 (D.makeNakedLink "halting-problem")
295+ <> B.stringUtf8 (D.makeNakedLink "bad-recursion")
261 <> " to learn how to fix it!"
296 <> " to learn how to fix it!"
262 ]
297 ]
263
298
compiler/src/Json/Decode.hs+3−3
@@ -32,7 +32,7 @@ module Json.Decode
32import qualified Data.ByteString.Internal as B
32import qualified Data.ByteString.Internal as B
33import qualified Data.Map as Map
33import qualified Data.Map as Map
34import qualified Data.NonEmptyList as NE
34import qualified Data.NonEmptyList as NE
35−import Data.Word (Word8, Word16)
35+import Data.Word (Word8)
36import Foreign.Ptr (Ptr, plusPtr, minusPtr)
36import Foreign.Ptr (Ptr, plusPtr, minusPtr)
37import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
37import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
38
38
@@ -630,7 +630,7 @@ data StringStatus
630 | BadString StringProblem
630 | BadString StringProblem
631
631
632
632
633−pStringHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# StringStatus, Ptr Word8, Word16, Word16 #)
633+pStringHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# StringStatus, Ptr Word8, Row, Col #)
634pStringHelp pos end row col =
634pStringHelp pos end row col =
635 if pos >= end then
635 if pos >= end then
636 (# BadString BadStringEnd, pos, row, col #)
636 (# BadString BadStringEnd, pos, row, col #)
@@ -708,7 +708,7 @@ spaces =
708 cok () newState
708 cok () newState
709
709
710
710
711−eatSpaces :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Ptr Word8, Word16, Word16 #)
711+eatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Ptr Word8, Row, Col #)
712eatSpaces pos end row col =
712eatSpaces pos end row col =
713 if pos >= end then
713 if pos >= end then
714 (# pos, row, col #)
714 (# pos, row, col #)
compiler/src/Optimize/Port.hs+1−1
@@ -58,7 +58,7 @@ toEncoder tipe =
58 | name == Name.array -> encodeArray arg
58 | name == Name.array -> encodeArray arg
59
59
60 _ ->
60 _ ->
61− error "toEncoder: bad union type"
61+ error "toEncoder: bad custom type"
62
62
63 Can.TRecord _ (Just _) ->
63 Can.TRecord _ (Just _) ->
64 error "toEncoder: bad record"
64 error "toEncoder: bad record"
compiler/src/Parse/Module.hs+81−35
@@ -2,6 +2,8 @@
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
3module Parse.Module
4 ( fromByteString
4 ( fromByteString
5+ , ProjectType(..)
6+ , isKernel
5 , chompImports
7 , chompImports
6 , chompImport
8 , chompImport
7 )
9 )
@@ -29,14 +31,37 @@ import qualified Reporting.Error.Syntax as E
29-- FROM BYTE STRING
31-- FROM BYTE STRING
30
32
31
33
32−fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module
34+fromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module
33−fromByteString pkg source =
35+fromByteString projectType source =
34− case P.fromByteString (chompModule pkg) E.ModuleBadEnd source of
36+ case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of
35− Right modul -> checkModule modul
37+ Right modul -> checkModule projectType modul
36 Left err -> Left (E.ParseError err)
38 Left err -> Left (E.ParseError err)
37
39
38
40
39
41
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+
40-- MODULE
65-- MODULE
41
66
42
67
@@ -49,11 +74,11 @@ data Module =
49 }
74 }
50
75
51
76
52−chompModule :: Pkg.Name -> Parser E.Module Module
77+chompModule :: ProjectType -> Parser E.Module Module
53−chompModule pkg =
78+chompModule projectType =
54 do header <- chompHeader
79 do header <- chompHeader
55− imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)
80+ imports <- chompImports (if isCore projectType then [] else Imports.defaults)
56− infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []
81+ infixes <- if isKernel projectType then chompInfixes [] else return []
57 decls <- specialize E.Declarations $ chompDecls []
82 decls <- specialize E.Declarations $ chompDecls []
58 return (Module header imports infixes decls)
83 return (Module header imports infixes decls)
59
84
@@ -62,15 +87,15 @@ chompModule pkg =
62-- CHECK MODULE
87-- CHECK MODULE
63
88
64
89
65−checkModule :: Module -> Either E.Error Src.Module
90+checkModule :: ProjectType -> Module -> Either E.Error Src.Module
66−checkModule (Module maybeHeader imports infixes decls) =
91+checkModule projectType (Module maybeHeader imports infixes decls) =
67 let
92 let
68 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
93 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
69 in
94 in
70 case maybeHeader of
95 case maybeHeader of
71 Just (Header name effects exports docs) ->
96 Just (Header name effects exports docs) ->
72 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
97 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
73− <$> checkEffects ports effects
98+ <$> checkEffects projectType ports effects
74
99
75 Nothing ->
100 Nothing ->
76 Right $
101 Right $
@@ -80,23 +105,37 @@ checkModule (Module maybeHeader imports infixes decls) =
80 _:_ -> Src.Ports ports
105 _:_ -> Src.Ports ports
81
106
82
107
83−checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects
108+checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects
84−checkEffects ports effects =
109+checkEffects projectType ports effects =
85 case effects of
110 case effects of
86 NoEffects region ->
111 NoEffects region ->
87 case ports of
112 case ports of
113+ [] ->
88− [] -> Right Src.NoEffects
114+ Right Src.NoEffects
115+
116+ Src.Port name _ : _ ->
117+ case projectType of
118+ Package _ -> Left (E.NoPortsInPackage name)
89− _:_ -> Left (E.UnexpectedPort region)
119+ Application -> Left (E.UnexpectedPort region)
90
120
91 Ports region ->
121 Ports region ->
92− case ports of
122+ case projectType of
123+ Package _ ->
124+ Left (E.NoPortModulesInPackage region)
125+
126+ Application ->
127+ case ports of
93− [] -> Left (E.NoPorts region)
128+ [] -> Left (E.NoPorts region)
94− _:_ -> Right (Src.Ports ports)
129+ _:_ -> Right (Src.Ports ports)
95
130
96 Manager region manager ->
131 Manager region manager ->
132+ if isKernel projectType then
97− case ports of
133+ case ports of
98− [] -> Right (Src.Manager region manager)
134+ [] -> Right (Src.Manager region manager)
99− _:_ -> Left (E.UnexpectedPort region)
135+ _:_ -> Left (E.UnexpectedPort region)
136+ else
137+ Left (E.NoEffectsOutsideKernel region)
138+
100
139
101
140
102categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )
141categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )
@@ -395,18 +434,18 @@ exposing =
395 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
434 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
396 word1 0x29 {-)-} E.ExposingEnd
435 word1 0x29 {-)-} E.ExposingEnd
397 return Src.Open
436 return Src.Open
398− , do exposed <- addLocation chompExposed
437+ , do exposed <- chompExposed
399 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
438 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
400 exposingHelp [exposed]
439 exposingHelp [exposed]
401 ]
440 ]
402
441
403
442
404−exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing
443+exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing
405exposingHelp revExposed =
444exposingHelp revExposed =
406 oneOf E.ExposingEnd
445 oneOf E.ExposingEnd
407 [ do word1 0x2C {-,-} E.ExposingEnd
446 [ do word1 0x2C {-,-} E.ExposingEnd
408 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
447 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
409− exposed <- addLocation chompExposed
448+ exposed <- chompExposed
410 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
449 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
411 exposingHelp (exposed:revExposed)
450 exposingHelp (exposed:revExposed)
412 , do word1 0x29 {-)-} E.ExposingEnd
451 , do word1 0x29 {-)-} E.ExposingEnd
@@ -416,16 +455,21 @@ exposingHelp revExposed =
416
455
417chompExposed :: Parser E.Exposing Src.Exposed
456chompExposed :: Parser E.Exposing Src.Exposed
418chompExposed =
457chompExposed =
458+ do start <- getPosition
419− oneOf E.ExposingValue
459+ oneOf E.ExposingValue
420− [ Src.Lower <$> Var.lower E.ExposingValue
460+ [ do name <- Var.lower E.ExposingValue
461+ end <- getPosition
462+ return $ Src.Lower $ A.at start end name
421− , do word1 0x28 {-(-} E.ExposingValue
463+ , do word1 0x28 {-(-} E.ExposingValue
422− op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
464+ op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
423− word1 0x29 {-)-} E.ExposingOperatorRightParen
465+ word1 0x29 {-)-} E.ExposingOperatorRightParen
466+ end <- getPosition
424− return (Src.Operator op)
467+ return $ Src.Operator (A.Region start end) op
425− , do name <- Var.upper E.ExposingValue
468+ , do name <- Var.upper E.ExposingValue
469+ end <- getPosition
426− Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
470+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
427− Src.Upper name <$> privacy
471+ Src.Upper (A.at start end name) <$> privacy
428− ]
472+ ]
429
473
430
474
431privacy :: Parser E.Exposing Src.Privacy
475privacy :: Parser E.Exposing Src.Privacy
@@ -433,9 +477,11 @@ privacy =
433 oneOfWithFallback
477 oneOfWithFallback
434 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
478 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
435 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
479 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
480+ start <- getPosition
436 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
481 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
482+ end <- getPosition
437 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
483 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
438 word1 0x29 {-)-} E.ExposingTypePrivacy
484 word1 0x29 {-)-} E.ExposingTypePrivacy
439− return Src.Public
485+ return $ Src.Public (A.Region start end)
440 ]
486 ]
441 Src.Private
487 Src.Private
compiler/src/Parse/Pattern.hs+1−1
@@ -129,7 +129,7 @@ recordHelp start vars =
129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd
129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd
130 recordHelp start (var:vars)
130 recordHelp start (var:vars)
131 , do word1 0x7D {-}-} E.PRecordEnd
131 , do word1 0x7D {-}-} E.PRecordEnd
132− addEnd start (Src.PRecord vars)
132+ addEnd start (Src.PRecord (reverse vars))
133 ]
133 ]
134
134
135
135
compiler/src/Parse/Space.hs+2−2
@@ -157,7 +157,7 @@ eatSpaces pos end row col =
157-- LINE COMMENTS
157-- LINE COMMENTS
158
158
159
159
160−eatLineComment :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)
160+eatLineComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)
161eatLineComment pos end row col =
161eatLineComment pos end row col =
162 if pos >= end then
162 if pos >= end then
163 (# Good, pos, row, col #)
163 (# Good, pos, row, col #)
@@ -208,7 +208,7 @@ data MultiStatus
208 | MultiEndless
208 | MultiEndless
209
209
210
210
211−eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Word16, Word16 #)
211+eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Row, Col #)
212eatMultiCommentHelp pos end row col openComments =
212eatMultiCommentHelp pos end row col openComments =
213 if pos >= end then
213 if pos >= end then
214 (# MultiEndless, pos, row, col #)
214 (# MultiEndless, pos, row, col #)
compiler/src/Parse/String.hs+2−2
@@ -165,7 +165,7 @@ addEscape chunk start end revChunks =
165-- SINGLE STRINGS
165-- SINGLE STRINGS
166
166
167
167
168−singleString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [ES.Chunk] -> StringResult
168+singleString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [ES.Chunk] -> StringResult
169singleString pos end row col initialPos revChunks =
169singleString pos end row col initialPos revChunks =
170 if pos >= end then
170 if pos >= end then
171 Err row col E.StringEndless_Single
171 Err row col E.StringEndless_Single
@@ -211,7 +211,7 @@ singleString pos end row col initialPos revChunks =
211-- MULTI STRINGS
211-- MULTI STRINGS
212
212
213
213
214−multiString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> Word16 -> Word16 -> [ES.Chunk] -> StringResult
214+multiString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> Row -> Col -> [ES.Chunk] -> StringResult
215multiString pos end row col initialPos sr sc revChunks =
215multiString pos end row col initialPos sr sc revChunks =
216 if pos >= end then
216 if pos >= end then
217 Err sr sc E.StringEndless_Multi
217 Err sr sc E.StringEndless_Multi
compiler/src/Parse/Variable.hs+2−2
@@ -149,14 +149,14 @@ foreignUpper toError =
149 let
149 let
150 !newState = P.State src upperEnd end indent row newCol
150 !newState = P.State src upperEnd end indent row newCol
151 !name = Name.fromPtr upperStart upperEnd
151 !name = Name.fromPtr upperStart upperEnd
152− !foreign =
152+ !upperName =
153 if upperStart == pos then
153 if upperStart == pos then
154 Unqualified name
154 Unqualified name
155 else
155 else
156 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in
156 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in
157 Qualified home name
157 Qualified home name
158 in
158 in
159− cok foreign newState
159+ cok upperName newState
160
160
161
161
162foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)
162foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)
compiler/src/Reporting/Error.hs+20−16
@@ -12,6 +12,7 @@ module Reporting.Error
12import qualified Data.ByteString as B
12import qualified Data.ByteString as B
13import qualified Data.NonEmptyList as NE
13import qualified Data.NonEmptyList as NE
14import qualified Data.OneOrMore as OneOrMore
14import qualified Data.OneOrMore as OneOrMore
15+import qualified System.FilePath as FP
15
16
16import qualified Elm.ModuleName as ModuleName
17import qualified Elm.ModuleName as ModuleName
17import qualified File
18import qualified File
@@ -38,8 +39,8 @@ import qualified Reporting.Report as Report
38data Module =
39data Module =
39 Module
40 Module
40 { _name :: ModuleName.Raw
41 { _name :: ModuleName.Raw
41− , _path :: FilePath
42+ , _absolutePath :: FilePath
42− , _time :: File.Time
43+ , _modificationTime :: File.Time
43 , _source :: B.ByteString
44 , _source :: B.ByteString
44 , _error :: Error
45 , _error :: Error
45 }
46 }
@@ -92,26 +93,26 @@ toReports source err =
92-- TO DOC
93-- TO DOC
93
94
94
95
95−toDoc :: Module -> [Module] -> D.Doc
96+toDoc :: FilePath -> Module -> [Module] -> D.Doc
96−toDoc err errs =
97+toDoc root err errs =
97 let
98 let
98− (NE.List m ms) = NE.sortBy _time (NE.List err errs)
99+ (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)
99 in
100 in
100− D.vcat (toDocHelp m ms)
101+ D.vcat (toDocHelp root m ms)
101
102
102
103
103−toDocHelp :: Module -> [Module] -> [D.Doc]
104+toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]
104−toDocHelp module1 modules =
105+toDocHelp root module1 modules =
105 case modules of
106 case modules of
106 [] ->
107 [] ->
107− [moduleToDoc module1
108+ [moduleToDoc root module1
108 ,""
109 ,""
109 ]
110 ]
110
111
111 module2 : otherModules ->
112 module2 : otherModules ->
112− moduleToDoc module1
113+ moduleToDoc root module1
113 : toSeparator module1 module2
114 : toSeparator module1 module2
114− : toDocHelp module2 otherModules
115+ : toDocHelp root module2 otherModules
115
116
116
117
117toSeparator :: Module -> Module -> D.Doc
118toSeparator :: Module -> Module -> D.Doc
@@ -133,19 +134,22 @@ toSeparator beforeModule afterModule =
133-- MODULE TO DOC
134-- MODULE TO DOC
134
135
135
136
136−moduleToDoc :: Module -> D.Doc
137+moduleToDoc :: FilePath -> Module -> D.Doc
137−moduleToDoc (Module _ path _ source err) =
138+moduleToDoc root (Module _ absolutePath _ source err) =
138 let
139 let
139 reports =
140 reports =
140 toReports (Code.toSource source) err
141 toReports (Code.toSource source) err
142+
143+ relativePath =
144+ FP.makeRelative root absolutePath
141 in
145 in
142− D.vcat $ map (reportToDoc path) (NE.toList reports)
146+ D.vcat $ map (reportToDoc relativePath) (NE.toList reports)
143
147
144
148
145reportToDoc :: FilePath -> Report.Report -> D.Doc
149reportToDoc :: FilePath -> Report.Report -> D.Doc
146−reportToDoc path (Report.Report title _ _ message) =
150+reportToDoc relativePath (Report.Report title _ _ message) =
147 D.vcat
151 D.vcat
148− [ toMessageBar title path
152+ [ toMessageBar title relativePath
149 , ""
153 , ""
150 , message
154 , message
151 , ""
155 , ""
compiler/src/Reporting/Error/Canonicalize.hs+27−27
@@ -14,8 +14,10 @@ module Reporting.Error.Canonicalize
14
14
15
15
16import qualified Data.Char as Char
16import qualified Data.Char as Char
17+import qualified Data.List as List
17import qualified Data.Map as Map
18import qualified Data.Map as Map
18import qualified Data.Name as Name
19import qualified Data.Name as Name
20+import qualified Data.OneOrMore as OneOrMore
19import qualified Data.Set as Set
21import qualified Data.Set as Set
20
22
21import qualified AST.Canonical as Can
23import qualified AST.Canonical as Can
@@ -37,10 +39,10 @@ import qualified Reporting.Suggest as Suggest
37
39
38data Error
40data Error
39 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
41 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
40− | AmbiguousVar A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
42+ | AmbiguousVar A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
41− | AmbiguousType A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
43+ | AmbiguousType A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
42− | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
44+ | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
43− | AmbiguousBinop A.Region Name.Name [ModuleName.Canonical]
45+ | AmbiguousBinop A.Region Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
44 | BadArity A.Region BadArityContext Name.Name Int Int
46 | BadArity A.Region BadArityContext Name.Name Int Int
45 | Binop A.Region Name.Name Name.Name
47 | Binop A.Region Name.Name Name.Name
46 | DuplicateDecl Name.Name A.Region A.Region
48 | DuplicateDecl Name.Name A.Region A.Region
@@ -164,17 +166,17 @@ toReport source err =
164 <> " be deleted? Maybe some parentheses are missing?"
166 <> " be deleted? Maybe some parentheses are missing?"
165 )
167 )
166
168
167− AmbiguousVar region maybePrefix name possibleHomes ->
169+ AmbiguousVar region maybePrefix name h hs ->
168− ambiguousName source region maybePrefix name possibleHomes "variable"
170+ ambiguousName source region maybePrefix name h hs "variable"
169
171
170− AmbiguousType region maybePrefix name possibleHomes ->
172+ AmbiguousType region maybePrefix name h hs ->
171− ambiguousName source region maybePrefix name possibleHomes "type"
173+ ambiguousName source region maybePrefix name h hs "type"
172
174
173− AmbiguousVariant region maybePrefix name possibleHomes ->
175+ AmbiguousVariant region maybePrefix name h hs ->
174− ambiguousName source region maybePrefix name possibleHomes "variant"
176+ ambiguousName source region maybePrefix name h hs "variant"
175
177
176− AmbiguousBinop region name possibleHomes ->
178+ AmbiguousBinop region name h hs ->
177− ambiguousName source region Nothing name possibleHomes "operator"
179+ ambiguousName source region Nothing name h hs "operator"
178
180
179 BadArity region badArityContext name expected actual ->
181 BadArity region badArityContext name expected actual ->
180 let
182 let
@@ -274,7 +276,7 @@ toReport source err =
274 "You have declared that `" ++ Name.toChars name ++ "` is an effect type:"
276 "You have declared that `" ++ Name.toChars name ++ "` is an effect type:"
275 ,
277 ,
276 D.reflow $
278 D.reflow $
277− "But I cannot find a union type named `" ++ Name.toChars name ++ "` in this file!"
279+ "But I cannot find a custom type named `" ++ Name.toChars name ++ "` in this file!"
278 )
280 )
279
281
280 EffectFunctionNotFound region name ->
282 EffectFunctionNotFound region name ->
@@ -342,7 +344,7 @@ toReport source err =
342 Code.toSnippet source region Nothing
344 Code.toSnippet source region Nothing
343 (
345 (
344 D.reflow $
346 D.reflow $
345− "The (..) syntax is for exposing union type constructors. It cannot be used with a type alias like `"
347+ "The (..) syntax is for exposing variants of a custom type. It cannot be used with a type alias like `"
346 ++ Name.toChars name ++ "` though."
348 ++ Name.toChars name ++ "` though."
347 ,
349 ,
348 D.reflow $
350 D.reflow $
@@ -355,12 +357,12 @@ toReport source err =
355 (
357 (
356 D.reflow $
358 D.reflow $
357 "You are trying to import the `" <> Name.toChars ctor
359 "You are trying to import the `" <> Name.toChars ctor
358− <> "` type constructor by name:"
360+ <> "` variant by name:"
359 ,
361 ,
360 D.fillSep
362 D.fillSep
361 ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."
363 ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."
362 ,"The","dots","mean","“expose","the",D.fromName tipe,"type","and"
364 ,"The","dots","mean","“expose","the",D.fromName tipe,"type","and"
363− ,"all","its","constructors”","so","it","gives","you","access","to"
365+ ,"all","its","variants","so","it","gives","you","access","to"
364 , D.fromName ctor <> "."
366 , D.fromName ctor <> "."
365 ]
367 ]
366 )
368 )
@@ -386,13 +388,8 @@ toReport source err =
386 D.reflow $
388 D.reflow $
387 "The `" <> Name.toChars name <> "` type alias cannot be followed by (..) like this:"
389 "The `" <> Name.toChars name <> "` type alias cannot be followed by (..) like this:"
388 ,
390 ,
389− D.stack
391+ D.reflow $
390− [ "Remove the (..) and it should work."
392+ "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− ]
396 )
393 )
397
394
398 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->
395 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->
@@ -682,7 +679,7 @@ toReport source err =
682 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
679 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
683 ,
680 ,
684 D.stack
681 D.stack
685− [ makeTheory "Are you are trying to mutate a variable?" $
682+ [ makeTheory "Are you trying to mutate a variable?" $
686 "Elm does not have mutation, so when I see " ++ Name.toChars name
683 "Elm does not have mutation, so when I see " ++ Name.toChars name
687 ++ " defined in terms of " ++ Name.toChars name
684 ++ " defined in terms of " ++ Name.toChars name
688 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
685 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -728,7 +725,7 @@ toReport source err =
728 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
725 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."
729 ,
726 ,
730 D.stack
727 D.stack
731− [ makeTheory "Are you are trying to mutate a variable?" $
728+ [ makeTheory "Are you trying to mutate a variable?" $
732 "Elm does not have mutation, so when I see " ++ Name.toChars name
729 "Elm does not have mutation, so when I see " ++ Name.toChars name
733 ++ " defined in terms of " ++ Name.toChars name
730 ++ " defined in terms of " ++ Name.toChars name
734 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
731 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"
@@ -979,8 +976,11 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =
979-- AMBIGUOUS NAME
976-- AMBIGUOUS NAME
980
977
981
978
982−ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> [ModuleName.Canonical] -> String -> Report.Report
979+ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> ModuleName.Canonical -> OneOrMore.OneOrMore ModuleName.Canonical -> String -> Report.Report
983−ambiguousName source region maybePrefix name possibleHomes thing =
980+ambiguousName source region maybePrefix name h hs thing =
981+ let
982+ possibleHomes = List.sort (h : OneOrMore.destruct (:) hs)
983+ in
984 Report.Report "AMBIGUOUS NAME" region [] $
984 Report.Report "AMBIGUOUS NAME" region [] $
985 Code.toSnippet source region Nothing $
985 Code.toSnippet source region Nothing $
986 case maybePrefix of
986 case maybePrefix of
compiler/src/Reporting/Error/Docs.hs+2−2
@@ -69,7 +69,7 @@ toReports source err =
69 \ declaration and the imports."
69 \ declaration and the imports."
70 ,
70 ,
71 D.reflow
71 D.reflow
72− "Learn more at <http://package.elm-lang.org/help/documentation-format>"
72+ "Learn more at <https://package.elm-lang.org/help/documentation-format>"
73 )
73 )
74
74
75 ImplicitExposing region ->
75 ImplicitExposing region ->
@@ -116,7 +116,7 @@ toSyntaxProblemReport source problem =
116 , D.stack $
116 , D.stack $
117 [ D.reflow details
117 [ D.reflow details
118 , D.toSimpleHint $
118 , 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\
120 \ tips on how to write module documentation!"
120 \ tips on how to write module documentation!"
121 ]
121 ]
122 )
122 )
compiler/src/Reporting/Error/Import.hs+1−1
@@ -56,7 +56,7 @@ toReport source (Error region name unimportedModules problem) =
56 D.stack
56 D.stack
57 [
57 [
58 D.reflow $
58 D.reflow $
59− "I checked the \"dependencies\" and \"source-directories\" listend in your elm.json,\
59+ "I checked the \"dependencies\" and \"source-directories\" listed in your elm.json,\
60 \ but I cannot find it! Maybe it is a typo for one of these names?"
60 \ but I cannot find it! Maybe it is a typo for one of these names?"
61 ,
61 ,
62 D.dullyellow $ D.indent 4 $ D.vcat $
62 D.dullyellow $ D.indent 4 $ D.vcat $
compiler/src/Reporting/Error/Json.hs+16−4
@@ -51,9 +51,13 @@ parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Re
51parseErrorToReport path source parseError reason =
51parseErrorToReport path source parseError reason =
52 let
52 let
53 toSnippet title row col (problem, details) =
53 toSnippet title row col (problem, details) =
54+ let
54− let pos = A.Position row col in
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
55 Help.jsonReport title (Just path) $
59 Help.jsonReport title (Just path) $
56− Code.toSnippet source (A.Region pos pos) Nothing
60+ Code.toSnippet source surroundings (Just region)
57 ( D.reflow (because reason problem)
61 ( D.reflow (because reason problem)
58 , details
62 , details
59 )
63 )
@@ -77,12 +81,20 @@ parseErrorToReport path source parseError reason =
77 )
81 )
78
82
79 ObjectField row col ->
83 ObjectField row col ->
80− toSnippet "UNFINISHED OBJECT" row col
84+ toSnippet "EXTRA COMMA" row col
81 (
85 (
82 "I was partway through parsing a JSON object when I got stuck here:"
86 "I was partway through parsing a JSON object when I got stuck here:"
83 ,
87 ,
84 D.stack
88 D.stack
89+ [ D.fillSep
90+ ["I","saw","a","comma","right","before","I","got","stuck","here,"
85− [ D.reflow $ "I was expecting to see a field name next."
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."
86 , objectNote
98 , objectNote
87 ]
99 ]
88 )
100 )
compiler/src/Reporting/Error/Pattern.hs+2−2
@@ -41,7 +41,7 @@ toReport source err =
41 Report.Report "UNSAFE PATTERN" region [] $
41 Report.Report "UNSAFE PATTERN" region [] $
42 Code.toSnippet source region Nothing
42 Code.toSnippet source region Nothing
43 (
43 (
44− "This pattern does not cover all possiblities:"
44+ "This pattern does not cover all possibilities:"
45 ,
45 ,
46 D.stack
46 D.stack
47 [ "Other possibilities include:"
47 [ "Other possibilities include:"
@@ -64,7 +64,7 @@ toReport source err =
64 , unhandledPatternsToDocBlock unhandled
64 , unhandledPatternsToDocBlock unhandled
65 , D.reflow $
65 , D.reflow $
66 "I would have to crash if I saw one of those! You can use\
66 "I would have to crash if I saw one of those! You can use\
67− \ `let` to deconstruct values only if there is ONE possiblity.\
67+ \ `let` to deconstruct values only if there is ONE possibility.\
68 \ Switch to a `case` expression to account for all possibilities."
68 \ Switch to a `case` expression to account for all possibilities."
69 , D.toSimpleHint $
69 , D.toSimpleHint $
70 "Are you calling a function that definitely returns values\
70 "Are you calling a function that definitely returns values\
compiler/src/Reporting/Error/Syntax.hs+965−518
@@ -69,6 +69,9 @@ data Error
69 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)
69 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)
70 | UnexpectedPort A.Region
70 | UnexpectedPort A.Region
71 | NoPorts A.Region
71 | NoPorts A.Region
72+ | NoPortsInPackage (A.Located Name.Name)
73+ | NoPortModulesInPackage A.Region
74+ | NoEffectsOutsideKernel A.Region
72 | ParseError Module
75 | ParseError Module
73
76
74
77
@@ -561,10 +564,84 @@ toReport source err =
561 ]
564 ]
562 )
565 )
563
566
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+
564 ParseError modul ->
619 ParseError modul ->
565 toParseErrorReport source modul
620 toParseErrorReport source modul
566
621
567
622
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+
568toParseErrorReport :: Code.Source -> Module -> Report.Report
645toParseErrorReport :: Code.Source -> Module -> Report.Report
569toParseErrorReport source modul =
646toParseErrorReport source modul =
570 case modul of
647 case modul of
@@ -572,156 +649,9 @@ toParseErrorReport source modul =
572 toSpaceReport source space row col
649 toSpaceReport source space row col
573
650
574 ModuleBadEnd row col ->
651 ModuleBadEnd row col ->
575− case Code.whatIsNext source row col of
652+ if col == 1
576− Code.Keyword keyword ->
653+ then toDeclStartReport source row col
577− let
654+ else toWeirdEndReport source row col
578− region = toKeywordRegion row col keyword
579− in
580− Report.Report "RESERVED WORD" region [] $
581− Code.toSnippet source region Nothing
582− (
583− D.reflow $
584− "I got stuck on this reserved word:"
585− ,
586− D.reflow $
587− "The name `" ++ keyword ++ "` is reserved, so try using a different name?"
588− )
589−
590− Code.Operator op ->
591− let
592− region = toKeywordRegion row col op
593− in
594− Report.Report "UNEXPECTED SYMBOL" region [] $
595− Code.toSnippet source region Nothing
596− (
597− D.reflow $
598− "I ran into an unexpected symbol:"
599− ,
600− D.reflow $
601− "I was not expecting to see a " ++ op ++ " here. Try deleting it? Maybe\
602− \ I can give a better hint from there?"
603− )
604−
605− Code.Close term bracket ->
606− let
607− region = toRegion row col
608− in
609− Report.Report ("UNEXPECTED " ++ map Char.toUpper term) region [] $
610− Code.toSnippet source region Nothing
611− (
612− D.reflow $
613− "I ran into an unexpected " ++ term ++ ":"
614− ,
615− D.reflow $
616− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"
617− )
618−
619− Code.Other maybeChar ->
620− let
621− region = toRegion row col
622− in
623− case maybeChar of
624− Just ';' ->
625− Report.Report "UNEXPECTED SEMICOLON" region [] $
626− Code.toSnippet source region Nothing
627− (
628− D.reflow $
629− "I got stuck on this semicolon:"
630− ,
631− D.stack
632− [ D.reflow $ "Try removing it?"
633− , D.toSimpleNote $
634− "Some languages require semicolons at the end of each statement. These are\
635− \ often called C-like languages, and they usually share a lot of language design\
636− \ choices. (E.g. side-effects, for loops, etc.) Elm manages effects with commands\
637− \ and subscriptions instead, so there is no special syntax for \"statements\" and\
638− \ therefore no need to use semicolons to separate them. I think this will make\
639− \ more sense as you work through https://guide.elm-lang.org though!"
640− ]
641− )
642−
643− Just ',' ->
644− Report.Report "UNEXPECTED COMMA" region [] $
645− Code.toSnippet source region Nothing
646− (
647− D.reflow $
648− "I got stuck on this comma:"
649− ,
650− D.stack
651− [ D.reflow $
652− "I do not think I am parsing a list or tuple right now. Try deleting the comma?"
653− , D.toSimpleNote $
654− "If this is supposed to be part of a list, the problem may be a bit earlier.\
655− \ Perhaps the opening [ is missing? Or perhaps some value in the list has an extra\
656− \ closing ] that is making me think the list ended earlier? The same kinds of\
657− \ things could be going wrong if this is supposed to be a tuple."
658− ]
659− )
660−
661− Just '`' ->
662− Report.Report "UNEXPECTED CHARACTER" region [] $
663− Code.toSnippet source region Nothing
664− (
665− D.reflow $
666− "I got stuck on this character:"
667− ,
668− D.stack
669− [ D.reflow $
670− "It is not used for anything in Elm syntax. It is used for multi-line strings in\
671− \ some languages though, so if you want a string that spans multiple lines, you\
672− \ can use Elm's multi-line string syntax like this:"
673− , D.vcat
674− [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
675− , mempty
676− , D.dullyellow "# Multi-line Strings"
677− , mempty
678− , D.dullyellow "- start with triple double quotes"
679− , D.dullyellow "- write whatever you want"
680− , D.dullyellow "- no need to escape newlines or double quotes"
681− , D.dullyellow "- end with triple double quotes"
682− , mempty
683− , D.dullyellow "\"\"\""
684− ]
685− , D.reflow $
686− "Otherwise I do not know what is going on! Try removing the character?"
687− ]
688− )
689−
690− Just '$' ->
691− Report.Report "UNEXPECTED SYMBOL" region [] $
692− Code.toSnippet source region Nothing
693− (
694− D.reflow $
695− "I got stuck on this dollar sign:"
696− ,
697− D.reflow $
698− "It is not used for anything in Elm syntax. Are you coming from a language where\
699− \ dollar signs can be used in variable names? If so, try a name that (1) starts\
700− \ with a letter and (2) only contains letters, numbers, and underscores."
701− )
702−
703− Just c | elem c ['#','@','!','%','~'] ->
704− Report.Report "UNEXPECTED SYMBOL" region [] $
705− Code.toSnippet source region Nothing
706− (
707− D.reflow $
708− "I got stuck on this symbol:"
709− ,
710− D.reflow $
711− "It is not used for anything in Elm syntax. Try removing it?"
712− )
713−
714− _ ->
715− Report.Report "SYNTAX PROBLEM" region [] $
716− Code.toSnippet source region Nothing
717− (
718− D.reflow $
719− "I got stuck here:"
720− ,
721− D.reflow $
722− "Whatever I am running into is confusing me a lot! Normally I can give fairly\
723− \ specific hints, but something is really tripping me up this time."
724− )
725
655
726 ModuleProblem row col ->
656 ModuleProblem row col ->
727 let
657 let
@@ -867,15 +797,15 @@ toParseErrorReport source modul =
867 [ D.reflow $
797 [ D.reflow $
868 "I am not sure what is going on, but I recommend starting an Elm\
798 "I am not sure what is going on, but I recommend starting an Elm\
869 \ file with the following lines:"
799 \ file with the following lines:"
870− , D.vcat
800+ , D.indent 4 $ D.vcat $
871 [ D.fillSep [D.cyan "import","Html"]
801 [ D.fillSep [D.cyan "import","Html"]
872 , ""
802 , ""
873− , D.fillSep [D.green "main","="]
803+ , "main ="
874− , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]
804+ , " Html.text " <> D.dullyellow "\"Hello!\""
875 ]
805 ]
876 , D.reflow $
806 , D.reflow $
877− "You should be able to copy those lines directly into your file. Check out\
807+ "You should be able to copy those lines directly into your file. Check out the\
878− \ some of the examples on https://elm-lang.org for more help getting started!"
808+ \ examples at <https://elm-lang.org/examples> for more help getting started!"
879 , D.toSimpleNote $
809 , D.toSimpleNote $
880 "This can also happen when something is indented too much!"
810 "This can also happen when something is indented too much!"
881 ]
811 ]
@@ -900,11 +830,12 @@ toParseErrorReport source modul =
900 , D.indent 4 $ D.vcat $
830 , D.indent 4 $ D.vcat $
901 [ D.fillSep [D.cyan "import","Dict"]
831 [ D.fillSep [D.cyan "import","Dict"]
902 , D.fillSep [D.cyan "import","Maybe"]
832 , D.fillSep [D.cyan "import","Maybe"]
903− , D.fillSep [D.cyan "import","Html.Attributes"]
833+ , D.fillSep [D.cyan "import","Html.Attributes",D.cyan "as","A"]
904− , D.fillSep [D.cyan "import","Json.Decode"]
834+ , D.fillSep [D.cyan "import","Json.Decode",D.cyan "exposing","(..)"]
905 ]
835 ]
906 , D.reflow $
836 , D.reflow $
907 "Notice that the module names all start with capital letters. That is required!"
837 "Notice that the module names all start with capital letters. That is required!"
838+ , D.reflowLink "Read" "imports" "to learn more."
908 ]
839 ]
909 )
840 )
910
841
@@ -931,6 +862,7 @@ toParseErrorReport source modul =
931 ]
862 ]
932 , D.reflow $
863 , D.reflow $
933 "Notice that the alias always starts with a capital letter. That is required!"
864 "Notice that the alias always starts with a capital letter. That is required!"
865+ , D.reflowLink "Read" "imports" "to learn more."
934 ]
866 ]
935 )
867 )
936
868
@@ -993,6 +925,192 @@ toParseErrorReport source modul =
993
925
994
926
995
927
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+
996-- IMPORTS
1114-- IMPORTS
997
1115
998
1116
@@ -1018,6 +1136,7 @@ toImportReport source row col =
1018 ]
1136 ]
1019 , D.reflow $
1137 , D.reflow $
1020 "You are probably trying to import a different module, but try to make it look like one of these examples!"
1138 "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."
1021 ]
1140 ]
1022 )
1141 )
1023
1142
@@ -1324,106 +1443,7 @@ toDeclarationsReport :: Code.Source -> Decl -> Report.Report
1324toDeclarationsReport source decl =
1443toDeclarationsReport source decl =
1325 case decl of
1444 case decl of
1326 DeclStart row col ->
1445 DeclStart row col ->
1327− case Code.whatIsNext source row col of
1446+ toDeclStartReport source row col
1328− Code.Close term bracket ->
1329− let
1330− region = toRegion row col
1331− in
1332− Report.Report ("STRAY " ++ map Char.toUpper term) region [] $
1333− Code.toSnippet source region Nothing
1334− (
1335− D.reflow $
1336− "I was not expecting to see a " ++ term ++ " here:"
1337− , D.reflow $
1338− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"
1339− )
1340−
1341− Code.Keyword keyword ->
1342− let
1343− region = toKeywordRegion row col keyword
1344− in
1345− Report.Report "RESERVED WORD" region [] $
1346− Code.toSnippet source region Nothing
1347− (
1348− D.reflow $
1349− "I was not expecting to run into the `" ++ keyword ++ "` keyword here:"
1350− ,
1351− case keyword of
1352− "import" ->
1353− D.reflow $
1354− "It is reserved for declaring imports at the top of your module. If you want\
1355− \ another import, try moving it up top with the other imports. If you want to\
1356− \ define a value or function, try changing the name to something else!"
1357−
1358− "case" ->
1359− D.stack
1360− [ D.reflow $
1361− "It is reserved for writing `case` expressions. Try using a different name?"
1362− , D.toSimpleNote $
1363− "If you are trying to write a `case` expression, it needs to be part of a\
1364− \ definition. So you could write something like this instead:"
1365− , D.vcat $
1366− [ D.indent 0 $ D.fillSep [D.green "getWidth","maybeWidth","="]
1367− , D.indent 2 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]
1368− , D.indent 4 $ D.fillSep [D.blue "Just","width","->"]
1369− , D.indent 6 $ D.fillSep ["width","+",D.dullyellow "200"]
1370− , ""
1371− , D.indent 4 $ D.fillSep [D.blue "Nothing","->"]
1372− , D.indent 6 $ D.fillSep [D.dullyellow "400"]
1373− ]
1374− , D.reflow $
1375− "This defines a `getWidth` function that we can use elsewhere in our program."
1376− ]
1377−
1378− "if" ->
1379− D.stack
1380− [ D.reflow $
1381− "It is reserved for writing `if` expressions. Try using a different name?"
1382− , D.toSimpleNote $
1383− "If you are trying to write an `if` expression, it needs to be part of a\
1384− \ definition. So you could write something like this instead:"
1385− , D.vcat $
1386− [ D.indent 0 $ D.fillSep [D.green "reviewPowerLevel","powerLevel","="]
1387− , D.indent 2 $ D.fillSep $
1388− [D.cyan "if","powerLevel",">",D.dullyellow "9000"
1389− ,D.cyan "then",D.dullyellow "\"OVER 9000!!!\""
1390− ,D.cyan "else",D.dullyellow "\"not bad\""
1391− ]
1392− ]
1393− , D.reflow $
1394− "This defines a `reviewPowerLevel` function that we can use elsewhere in our program."
1395− ]
1396−
1397− _ ->
1398− D.reflow $
1399− "It is a reserved word. Try changing the name to something else?"
1400− )
1401−
1402− _ ->
1403− let
1404− region = toRegion row col
1405− in
1406− Report.Report "SYNTAX PROBLEM" region [] $
1407− Code.toSnippet source region Nothing
1408− (
1409− D.reflow $
1410− "I was expecting to see a new declaration here:"
1411− ,
1412− D.stack
1413− [ D.reflow $
1414− "I am not sure what is going wrong exactly, but here are a couple valid\
1415− \ declarations for reference:"
1416− , D.vcat
1417− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
1418− , D.fillSep [D.green "add","x","y","="]
1419− , D.fillSep [" ","x","+","y"]
1420− ]
1421− , D.fillSep [D.cyan "type",D.green "User","=","Anonymous","|","LoggedIn String"]
1422− , D.reflow $
1423− "Note that all declarations start with lower-case letters in Elm. Capitalization\
1424− \ makes a difference, so be conscious of that if you are working from examples!"
1425− ]
1426− )
1427
1447
1428 DeclSpace space row col ->
1448 DeclSpace space row col ->
1429 toSpaceReport source space row col
1449 toSpaceReport source space row col
@@ -1453,6 +1473,165 @@ toDeclarationsReport source decl =
1453 )
1473 )
1454
1474
1455
1475
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+
1456
1635
1457-- PORT
1636-- PORT
1458
1637
@@ -1579,7 +1758,7 @@ toPortReport source port_ startRow startCol =
1579 [ D.reflow $
1758 [ D.reflow $
1580 "I was expecting to see a type next. Here are examples of outgoing and\
1759 "I was expecting to see a type next. Here are examples of outgoing and\
1581 \ incoming ports for reference:"
1760 \ incoming ports for reference:"
1582− , D.vcat
1761+ , D.indent 4 $ D.vcat $
1583 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1762 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1584 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1763 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1585 ]
1764 ]
@@ -1598,7 +1777,7 @@ portNote =
1598 D.stack
1777 D.stack
1599 [ D.toSimpleNote $
1778 [ D.toSimpleNote $
1600 "Here are some example `port` declarations for reference:"
1779 "Here are some example `port` declarations for reference:"
1601− , D.vcat
1780+ , D.indent 4 $ D.vcat $
1602 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1781 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]
1603 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1782 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]
1604 ]
1783 ]
@@ -1781,8 +1960,8 @@ typeAliasNote =
1781 [ D.toSimpleNote $
1960 [ D.toSimpleNote $
1782 "Here is an example of a valid `type alias` for reference:"
1961 "Here is an example of a valid `type alias` for reference:"
1783 , D.vcat $
1962 , D.vcat $
1784− [ D.indent 0 $ D.fillSep [D.cyan "type",D.cyan "alias",D.green "Person","="]
1963+ [ D.indent 4 $ D.fillSep [D.cyan "type",D.cyan "alias","Person","="]
1785− , D.indent 2 $ D.vcat $
1964+ , D.indent 6 $ D.vcat $
1786 ["{ name : String"
1965 ["{ name : String"
1787 ,", age : Int"
1966 ,", age : Int"
1788 ,", height : Float"
1967 ,", height : Float"
@@ -1982,10 +2161,10 @@ customTypeNote =
1982 [ D.toSimpleNote $
2161 [ D.toSimpleNote $
1983 "Here is an example of a valid `type` declaration for reference:"
2162 "Here is an example of a valid `type` declaration for reference:"
1984 , D.vcat $
2163 , D.vcat $
1985− [ D.indent 0 $ D.fillSep [D.cyan "type",D.green "Status"]
2164+ [ D.indent 4 $ D.fillSep [D.cyan "type","Status"]
1986− , D.indent 2 $ D.fillSep ["=","Failure"]
2165+ , D.indent 6 $ D.fillSep ["=","Failure"]
1987− , D.indent 2 $ D.fillSep ["|","Waiting"]
2166+ , D.indent 6 $ D.fillSep ["|","Waiting"]
1988− , D.indent 2 $ D.fillSep ["|","Success","String"]
2167+ , D.indent 6 $ D.fillSep ["|","Success","String"]
1989 ]
2168 ]
1990 , D.reflow $
2169 , D.reflow $
1991 "This defines a new `Status` type with three variants. This could be useful if\
2170 "This defines a new `Status` type with three variants. This could be useful if\
@@ -2016,11 +2195,55 @@ toDeclDefReport source name declDef startRow startCol =
2016 Report.Report "RESERVED WORD" region [] $
2195 Report.Report "RESERVED WORD" region [] $
2017 Code.toSnippet source surroundings (Just region)
2196 Code.toSnippet source surroundings (Just region)
2018 (
2197 (
2019− D.reflow $
2198+ D.fillSep
2020− "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
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+ ]
2021 ,
2204 ,
2205+ D.stack
2206+ [ D.reflow $
2207+ "Try renaming it to something else."
2208+ , case keyword of
2209+ "as" ->
2210+ D.toFancyNote
2211+ ["This","keyword","is","reserved","for","pattern","matches","like"
2212+ ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"
2213+ ,"the","values","it","contains."
2214+ ]
2215+
2216+ _ ->
2217+ D.toSimpleNote $
2218+ "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."
2219+ ]
2220+ )
2221+
2222+ Code.Operator "->" ->
2223+ let
2224+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
2225+ region = toWiderRegion row col 2
2226+ in
2227+ Report.Report "MISSING COLON?" region [] $
2228+ Code.toSnippet source surroundings (Just region)
2229+ (
2022 D.reflow $
2230 D.reflow $
2023− "This is a reserved word! Try using some other name?"
2231+ "I was not expecting to see an arrow here:"
2232+ ,
2233+ D.stack
2234+ [ D.fillSep
2235+ ["This","usually","means","a",D.green ":","is","missing","a","bit","earlier","in"
2236+ ,"a","type","annotation.","It","could","be","something","else","though,","so"
2237+ ,"here","is","a","valid","definition","for","reference:"
2238+ ]
2239+ , D.indent 4 $ D.vcat $
2240+ [ "greet : String -> String"
2241+ , "greet name ="
2242+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2243+ ]
2244+ , D.reflow $
2245+ "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
2246+ ]
2024 )
2247 )
2025
2248
2026 Code.Operator op ->
2249 Code.Operator op ->
@@ -2038,10 +2261,10 @@ toDeclDefReport source name declDef startRow startCol =
2038 [ D.reflow $
2261 [ D.reflow $
2039 "I am not sure what is going wrong exactly, so here is a valid\
2262 "I am not sure what is going wrong exactly, so here is a valid\
2040 \ definition (with an optional type annotation) for reference:"
2263 \ definition (with an optional type annotation) for reference:"
2041− , D.vcat
2264+ , D.indent 4 $ D.vcat $
2042− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2265+ [ "greet : String -> String"
2043− , D.fillSep [D.green "add","x","y","="]
2266+ , "greet name ="
2044− , D.fillSep [" ","x","+","y"]
2267+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2045 ]
2268 ]
2046 , D.reflow $
2269 , D.reflow $
2047 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
2270 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -2063,10 +2286,10 @@ toDeclDefReport source name declDef startRow startCol =
2063 [ D.reflow $
2286 [ D.reflow $
2064 "I am not sure what is going wrong exactly, so here is a valid\
2287 "I am not sure what is going wrong exactly, so here is a valid\
2065 \ definition (with an optional type annotation) for reference:"
2288 \ definition (with an optional type annotation) for reference:"
2066− , D.vcat
2289+ , D.indent 4 $ D.vcat $
2067− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2290+ [ "greet : String -> String"
2068− , D.fillSep [D.green "add","x","y","="]
2291+ , "greet name ="
2069− , D.fillSep [" ","x","+","y"]
2292+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2070 ]
2293 ]
2071 , D.reflow $
2294 , D.reflow $
2072 "Try to use that format!"
2295 "Try to use that format!"
@@ -2181,10 +2404,10 @@ declDefNote =
2181 D.stack
2404 D.stack
2182 [ D.reflow $
2405 [ D.reflow $
2183 "Here is a valid definition (with a type annotation) for reference:"
2406 "Here is a valid definition (with a type annotation) for reference:"
2184− , D.vcat
2407+ , D.indent 4 $ D.vcat $
2185− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
2408+ [ "greet : String -> String"
2186− , D.fillSep [D.green "add","x","y","="]
2409+ , "greet name ="
2187− , D.fillSep [" ","x","+","y"]
2410+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
2188 ]
2411 ]
2189 , D.reflow $
2412 , D.reflow $
2190 "The top line (called a \"type annotation\") is optional. You can leave it off\
2413 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -2296,25 +2519,40 @@ toExprReport source context expr startRow startCol =
2296 )
2519 )
2297
2520
2298 OperatorRight op row col ->
2521 OperatorRight op row col ->
2522+ let
2523+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
2299− let region = toRegion row col in
2524+ region = toRegion row col
2525+ isMath = elem op ["-","+","*","/","^"]
2526+ in
2300 Report.Report "MISSING EXPRESSION" region [] $
2527 Report.Report "MISSING EXPRESSION" region [] $
2301− Code.toSnippet source region Nothing
2528+ Code.toSnippet source surroundings (Just region)
2302 (
2529 (
2303 D.reflow $
2530 D.reflow $
2304− "I was expecting to see an expression after this " ++ Name.toChars op ++ " operator:"
2531+ "I just saw a " ++ Name.toChars op ++ " "
2532+ ++ (if isMath then "sign" else "operator")
2533+ ++ ", so I am getting stuck here:"
2305 ,
2534 ,
2306− D.stack
2535+ if isMath then
2307− [ D.fillSep $
2536+ D.fillSep
2308− ["You","can","just","put","anything","for","now,","like"
2537+ ["I","was","expecting","to","see","an","expression","next."
2309− ,D.dullyellow "42","or",D.dullyellow"\"hello\"" <> "."
2538+ ,"Something","like",D.dullyellow "42","or",D.dullyellow "1000"
2310− ,"Once","there","is","something","there,","I","can","probably"
2539+ ,"that","makes","sense","with","a",D.fromName op,"sign."
2311− ,"give","a","more","specific","hint!"
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."
2312− ]
2546+ ]
2313− , D.toSimpleNote $
2547+ else if op == "|>" then
2314− "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
2548+ D.reflow $
2315− \ Or if I run into operators in unexpected spots. Point is, there are a\
2549+ "I was expecting to see a function next."
2316− \ couple ways I can get confused and give sort of weird advice!"
2550+ else if op == "<|" then
2317− ]
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."
2318 )
2556 )
2319
2557
2320 OperatorReserved operator row col ->
2558 OperatorReserved operator row col ->
@@ -2353,7 +2591,7 @@ toExprReport source context expr startRow startCol =
2353 ,"give","a","more","specific","hint!"
2591 ,"give","a","more","specific","hint!"
2354 ]
2592 ]
2355 , D.toSimpleNote $
2593 , D.toSimpleNote $
2356− "This can also happen if run into reserved words like `let` or `as` unexpectedly.\
2594+ "This can also happen if I run into reserved words like `let` or `as` unexpectedly.\
2357 \ Or if I run into operators in unexpected spots. Point is, there are a\
2595 \ Or if I run into operators in unexpected spots. Point is, there are a\
2358 \ couple ways I can get confused and give sort of weird advice!"
2596 \ couple ways I can get confused and give sort of weird advice!"
2359 ]
2597 ]
@@ -2502,17 +2740,15 @@ toStringReport source string row col =
2502 , D.toSimpleNote $
2740 , D.toSimpleNote $
2503 "For a string that spans multiple lines, you can use the multi-line string\
2741 "For a string that spans multiple lines, you can use the multi-line string\
2504 \ syntax like this:"
2742 \ syntax like this:"
2505− , D.vcat
2743+ , D.dullyellow $ D.indent 4 $ D.vcat $
2506− [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2744+ [ "\"\"\""
2507− , mempty
2508− , D.dullyellow "# Multi-line Strings"
2745+ , "# Multi-line Strings"
2509− , mempty
2746+ , ""
2510− , D.dullyellow "- start with triple double quotes"
2747+ , "- start with triple double quotes"
2511− , D.dullyellow "- write whatever you want"
2748+ , "- write whatever you want"
2512− , D.dullyellow "- no need to escape newlines or double quotes"
2749+ , "- no need to escape newlines or double quotes"
2513− , D.dullyellow "- end with triple double quotes"
2750+ , "- end with triple double quotes"
2514− , mempty
2515− , D.dullyellow "\"\"\""
2751+ , "\"\"\""
2516 ]
2752 ]
2517 ]
2753 ]
2518 )
2754 )
@@ -2531,17 +2767,15 @@ toStringReport source string row col =
2531 [ D.reflow "Add a \"\"\" somewhere after this to end the string."
2767 [ D.reflow "Add a \"\"\" somewhere after this to end the string."
2532 , D.toSimpleNote $
2768 , D.toSimpleNote $
2533 "Here is a valid multi-line string for reference:"
2769 "Here is a valid multi-line string for reference:"
2534− , D.vcat
2770+ , D.dullyellow $ D.indent 4 $ D.vcat $
2535− [ D.fillSep [D.green "markdown","=",D.dullyellow "\"\"\""]
2771+ [ "\"\"\""
2536− , mempty
2537− , D.dullyellow "# Multi-line Strings"
2772+ , "# Multi-line Strings"
2538− , mempty
2773+ , ""
2539− , D.dullyellow "- start with triple double quotes"
2774+ , "- start with triple double quotes"
2540− , D.dullyellow "- write whatever you want"
2775+ , "- write whatever you want"
2541− , D.dullyellow "- no need to escape newlines or double quotes"
2776+ , "- no need to escape newlines or double quotes"
2542− , D.dullyellow "- end with triple double quotes"
2777+ , "- end with triple double quotes"
2543− , mempty
2544− , D.dullyellow "\"\"\""
2778+ , "\"\"\""
2545 ]
2779 ]
2546 ]
2780 ]
2547 )
2781 )
@@ -2793,7 +3027,7 @@ toOperatorReport source context operator row col =
2793 ,
3027 ,
2794 D.stack
3028 D.stack
2795 [ D.reflow $
3029 [ D.reflow $
2796− "It makes sense to see arrows around here, so I suspect it is something earlier."
3030+ "It makes sense to see arrows around here, so I suspect it is something earlier. Maybe this pattern is indented a bit farther than the previous patterns?"
2797 , noteForCaseIndentError
3031 , noteForCaseIndentError
2798 ]
3032 ]
2799 )
3033 )
@@ -2801,11 +3035,15 @@ toOperatorReport source context operator row col =
2801 else
3035 else
2802 (
3036 (
2803 D.reflow $
3037 D.reflow $
2804− "I was not expecting an arrow here:"
3038+ "I was partway through parsing an expression when I got stuck on this arrow:"
2805 ,
3039 ,
2806− D.reflow $
3040+ D.stack
2807− "Arrows should only appear in `case` expressions and anonymous functions. Maybe\
3041+ [ "Arrows should only appear in `case` expressions and anonymous functions.\n\
2808− \ you want > or >= instead?"
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+ ]
2809 )
3047 )
2810
3048
2811 BadEquals ->
3049 BadEquals ->
@@ -3002,8 +3240,8 @@ toUnfinishLetReport source row col startRow startCol message =
3002 [ message
3240 [ message
3003 , D.toSimpleNote $
3241 , D.toSimpleNote $
3004 "Here is an example with a valid `let` expression for reference:"
3242 "Here is an example with a valid `let` expression for reference:"
3005− , D.vcat $
3243+ , D.indent 4 $ D.vcat $
3006− [ D.indent 0 $ D.fillSep [D.green "viewPerson","person","="]
3244+ [ D.indent 0 $ D.fillSep ["viewPerson","person","="]
3007 , D.indent 2 $ D.fillSep [D.cyan "let"]
3245 , D.indent 2 $ D.fillSep [D.cyan "let"]
3008 , D.indent 4 $ D.fillSep ["fullName","="]
3246 , D.indent 4 $ D.fillSep ["fullName","="]
3009 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]
3247 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]
@@ -3075,16 +3313,60 @@ toLetDefReport source name def startRow startCol =
3075 Code.Keyword keyword ->
3313 Code.Keyword keyword ->
3076 let
3314 let
3077 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3315 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3078− region = toKeywordRegion row col keyword
3316+ region = toKeywordRegion row col keyword
3317+ in
3318+ Report.Report "RESERVED WORD" region [] $
3319+ Code.toSnippet source surroundings (Just region)
3320+ (
3321+ D.fillSep
3322+ ["The","name"
3323+ ,"`" <> D.cyan (D.fromChars keyword) <> "`"
3324+ ,"is","reserved","in","Elm,","so","it","cannot"
3325+ ,"be","used","as","an","argument","here:"
3326+ ]
3327+ ,
3328+ D.stack
3329+ [ D.reflow $
3330+ "Try renaming it to something else."
3331+ , case keyword of
3332+ "as" ->
3333+ D.toFancyNote
3334+ ["This","keyword","is","reserved","for","pattern","matches","like"
3335+ ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"
3336+ ,"the","values","it","contains."
3337+ ]
3338+
3339+ _ ->
3340+ D.toSimpleNote $
3341+ "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."
3342+ ]
3343+ )
3344+
3345+ Code.Operator "->" ->
3346+ let
3347+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3348+ region = toWiderRegion row col 2
3079 in
3349 in
3080− Report.Report "RESERVED WORD" region [] $
3350+ Report.Report "MISSING COLON?" region [] $
3081 Code.toSnippet source surroundings (Just region)
3351 Code.toSnippet source surroundings (Just region)
3082 (
3352 (
3083 D.reflow $
3353 D.reflow $
3084− "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"
3354+ "I was not expecting to see an arrow here:"
3085 ,
3355 ,
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+ ]
3086− D.reflow $
3367+ , D.reflow $
3087− "This is a reserved word! Try using some other name?"
3368+ "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
3369+ ]
3088 )
3370 )
3089
3371
3090 Code.Operator op ->
3372 Code.Operator op ->
@@ -3102,10 +3384,10 @@ toLetDefReport source name def startRow startCol =
3102 [ D.reflow $
3384 [ D.reflow $
3103 "I am not sure what is going wrong exactly, so here is a valid\
3385 "I am not sure what is going wrong exactly, so here is a valid\
3104 \ definition (with an optional type annotation) for reference:"
3386 \ definition (with an optional type annotation) for reference:"
3105− , D.vcat
3387+ , D.indent 4 $ D.vcat $
3106− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3388+ [ "greet : String -> String"
3107− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3389+ , "greet name ="
3108− , D.indent 6 $ D.fillSep ["x","+","y"]
3390+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3109 ]
3391 ]
3110 , D.reflow $
3392 , D.reflow $
3111 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
3393 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"
@@ -3127,10 +3409,10 @@ toLetDefReport source name def startRow startCol =
3127 [ D.reflow $
3409 [ D.reflow $
3128 "I am not sure what is going wrong exactly, so here is a valid\
3410 "I am not sure what is going wrong exactly, so here is a valid\
3129 \ definition (with an optional type annotation) for reference:"
3411 \ definition (with an optional type annotation) for reference:"
3130− , D.vcat
3412+ , D.indent 4 $ D.vcat $
3131− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3413+ [ "greet : String -> String"
3132− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3414+ , "greet name ="
3133− , D.indent 4 $ D.fillSep ["x","+","y"]
3415+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3134 ]
3416 ]
3135 , D.reflow $
3417 , D.reflow $
3136 "Try to use that format!"
3418 "Try to use that format!"
@@ -3220,10 +3502,10 @@ defNote =
3220 D.stack
3502 D.stack
3221 [ D.reflow $
3503 [ D.reflow $
3222 "Here is a valid definition (with a type annotation) for reference:"
3504 "Here is a valid definition (with a type annotation) for reference:"
3223− , D.vcat
3505+ , D.indent 4 $ D.vcat $
3224− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]
3506+ [ "greet : String -> String"
3225− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]
3507+ , "greet name ="
3226− , D.indent 6 $ D.fillSep ["x","+","y"]
3508+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""
3227 ]
3509 ]
3228 , D.reflow $
3510 , D.reflow $
3229 "The top line (called a \"type annotation\") is optional. You can leave it off\
3511 "The top line (called a \"type annotation\") is optional. You can leave it off\
@@ -3482,8 +3764,9 @@ noteForCaseIndentError =
3482 , D.indent 8 $ D.fillSep [D.dullyellow "400"]
3764 , D.indent 8 $ D.fillSep [D.dullyellow "400"]
3483 ]
3765 ]
3484 , D.reflow $
3766 , D.reflow $
3485− "Notice the indentation! Each pattern is aligned, and each branch is indented\
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.\
3486− \ a bit more than the corresponding pattern. That is important!"
3769+ \ That is important!"
3487 ]
3770 ]
3488
3771
3489
3772
@@ -3635,23 +3918,43 @@ toIfReport source context if_ startRow startCol =
3635 )
3918 )
3636
3919
3637 IfIndentElse row col ->
3920 IfIndentElse row col ->
3921+ case Code.nextLineStartsWithKeyword "else" source row of
3922+ Just (elseRow, elseCol) ->
3638− let
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
3639− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3941+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3640− region = toRegion row col
3942+ region = toRegion row col
3641− in
3943+ in
3642− Report.Report "UNFINISHED IF" region [] $
3944+ Report.Report "UNFINISHED IF" region [] $
3643− Code.toSnippet source surroundings (Just region)
3945+ Code.toSnippet source surroundings (Just region)
3644− (
3946+ (
3645− D.reflow $
3947+ D.reflow $
3646− "I was expecting to see an `else` branch after this:"
3948+ "I was expecting to see an `else` branch after this:"
3647− ,
3949+ ,
3648− D.stack
3950+ D.stack
3649− [ D.reflow $
3951+ [ D.fillSep
3650− "I know what to do when the condition is `True`, but not when it is `False`."
3952+ ["I","know","what","to","do","when","the","condition","is","True,"
3651− , D.fillSep
3953+ ,"but","what","happens","when","it","is","False?"
3652− ["Add","an",D.cyan "else","branch","to","handle","that","scenario!"]
3954+ ,"Add","an",D.cyan "else","branch","to","handle","that","scenario!"
3955+ ]
3653− ]
3956+ ]
3654− )
3957+ )
3655
3958
3656
3959
3657
3960
@@ -3684,15 +3987,22 @@ toRecordReport source context record startRow startCol =
3684 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3987 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3685 region = toRegion row col
3988 region = toRegion row col
3686 in
3989 in
3687− Report.Report "UNFINISHED RECORD" region [] $
3990+ Report.Report "PROBLEM IN RECORD" region [] $
3688 Code.toSnippet source surroundings (Just region)
3991 Code.toSnippet source surroundings (Just region)
3689 (
3992 (
3690 D.reflow $
3993 D.reflow $
3691 "I just started parsing a record, but I got stuck here:"
3994 "I just started parsing a record, but I got stuck here:"
3692 ,
3995 ,
3996+ D.stack
3693− D.fillSep
3997+ [ D.fillSep
3694− ["Records","look","like",D.dullyellow "{ x = 3, y = 4 },"
3695− ,"so","I","was","expecting","to","see","a","field","name","next."
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
3696 ]
4006 ]
3697 )
4007 )
3698
4008
@@ -3701,7 +4011,7 @@ toRecordReport source context record startRow startCol =
3701 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4011 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3702 region = toRegion row col
4012 region = toRegion row col
3703 in
4013 in
3704− Report.Report "UNFINISHED RECORD" region [] $
4014+ Report.Report "PROBLEM IN RECORD" region [] $
3705 Code.toSnippet source surroundings (Just region)
4015 Code.toSnippet source surroundings (Just region)
3706 (
4016 (
3707 D.reflow $
4017 D.reflow $
@@ -3736,22 +4046,67 @@ toRecordReport source context record startRow startCol =
3736 \ that is a reserved word. Try using a different name!"
4046 \ that is a reserved word. Try using a different name!"
3737 )
4047 )
3738
4048
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+
3739 _ ->
4088 _ ->
3740 let
4089 let
3741 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4090 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3742 region = toRegion row col
4091 region = toRegion row col
3743 in
4092 in
3744− Report.Report "UNFINISHED RECORD" region [] $
4093+ Report.Report "PROBLEM IN RECORD" region [] $
3745 Code.toSnippet source surroundings (Just region)
4094 Code.toSnippet source surroundings (Just region)
3746 (
4095 (
3747 D.reflow $
4096 D.reflow $
3748− "I am partway through parsing a record, but I got stuck after that last comma:"
4097+ "I am partway through parsing a record, but I got stuck here:"
3749 ,
4098 ,
3750− addNoteForRecordError $
4099+ D.stack
3751− D.reflow $
4100+ [ D.fillSep
3752− "Trailing commas are not allowed in records, so I was expecting to see another\
4101+ ["I","was","expecting","to","see","another","record","field","defined","next,"
3753− \ record field defined next. If you are done defining the record, the fix may\
4102+ ,"so","I","am","looking","for","a","name","like"
3754− \ be to delete that last comma?"
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+ ]
3755 )
4110 )
3756
4111
3757 RecordEquals row col ->
4112 RecordEquals row col ->
@@ -3759,17 +4114,19 @@ toRecordReport source context record startRow startCol =
3759 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4114 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3760 region = toRegion row col
4115 region = toRegion row col
3761 in
4116 in
3762− Report.Report "UNFINISHED RECORD" region [] $
4117+ Report.Report "PROBLEM IN RECORD" region [] $
3763 Code.toSnippet source surroundings (Just region)
4118 Code.toSnippet source surroundings (Just region)
3764 (
4119 (
3765 D.reflow $
4120 D.reflow $
3766 "I am partway through parsing a record, but I got stuck here:"
4121 "I am partway through parsing a record, but I got stuck here:"
3767 ,
4122 ,
3768− addNoteForRecordError $
4123+ D.stack
3769− D.fillSep $
4124+ [ D.fillSep $
3770− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
4125+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
3771− ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"
4126+ ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"
4127+ ]
4128+ , noteForRecordError
3772− ]
4129+ ]
3773 )
4130 )
3774
4131
3775 RecordExpr expr row col ->
4132 RecordExpr expr row col ->
@@ -3789,29 +4146,54 @@ toRecordReport source context record startRow startCol =
3789 D.reflow $
4146 D.reflow $
3790 "I just saw the opening curly brace of a record, but then I got stuck here:"
4147 "I just saw the opening curly brace of a record, but then I got stuck here:"
3791 ,
4148 ,
3792− addNoteForRecordIndentError $
4149+ D.stack
3793− D.fillSep $
4150+ [ D.fillSep $
3794− ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."
4151+ ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."
3795− ,"Try","defining","some","fields","of","your","own?"
4152+ ,"Try","defining","some","fields","of","your","own?"
4153+ ]
4154+ , noteForRecordIndentError
3796− ]
4155+ ]
3797 )
4156 )
3798
4157
3799 RecordIndentEnd row col ->
4158 RecordIndentEnd row col ->
4159+ case Code.nextLineStartsWithCloseCurly source row of
4160+ Just (curlyRow, curlyCol) ->
3800− let
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
3801− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
4180+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
3802− region = toRegion row col
4181+ region = toRegion row col
3803− in
4182+ in
3804− Report.Report "UNFINISHED RECORD" region [] $
4183+ Report.Report "UNFINISHED RECORD" region [] $
3805− Code.toSnippet source surroundings (Just region)
4184+ Code.toSnippet source surroundings (Just region)
3806− (
4185+ (
3807− D.reflow $
4186+ D.reflow $
4187+ "I was partway through parsing a record, but I got stuck here:"
4188+ ,
4189+ D.stack
4190+ [ D.fillSep $
3808− "I was expecting to see a closing curly brace next:"
4191+ ["I","was","expecting","to","see","a","closing","curly","brace","next."
3809− ,
3810− addNoteForRecordIndentError $
3811− D.fillSep $
3812− ["Try","putting","an",D.green "}","and","see","if","that","helps?"
4192+ ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"
4193+ ]
4194+ , noteForRecordIndentError
3813− ]
4195+ ]
3814− )
4196+ )
3815
4197
3816 RecordIndentField row col ->
4198 RecordIndentField row col ->
3817 let
4199 let
@@ -3824,11 +4206,13 @@ toRecordReport source context record startRow startCol =
3824 D.reflow $
4206 D.reflow $
3825 "I am partway through parsing a record, but I got stuck after that last comma:"
4207 "I am partway through parsing a record, but I got stuck after that last comma:"
3826 ,
4208 ,
3827− addNoteForRecordError $
4209+ D.stack
3828− D.reflow $
4210+ [ D.reflow $
3829− "Trailing commas are not allowed in records, so the fix may be to\
4211+ "Trailing commas are not allowed in records, so the fix may be to\
3830− \ delete that last comma? Or maybe you were in the middle of defining\
4212+ \ delete that last comma? Or maybe you were in the middle of defining\
3831− \ an additional field?"
4213+ \ an additional field?"
4214+ , noteForRecordError
4215+ ]
3832 )
4216 )
3833
4217
3834 RecordIndentEquals row col ->
4218 RecordIndentEquals row col ->
@@ -3843,10 +4227,12 @@ toRecordReport source context record startRow startCol =
3843 "I am partway through parsing a record. I just saw a record\
4227 "I am partway through parsing a record. I just saw a record\
3844 \ field, so I was expecting to see an equals sign next:"
4228 \ field, so I was expecting to see an equals sign next:"
3845 ,
4229 ,
3846− addNoteForRecordIndentError $
4230+ D.stack
3847− D.fillSep $
4231+ [ D.fillSep $
3848− ["Try","putting","an",D.green "=","followed","by","an","expression?"
4232+ ["Try","putting","an",D.green "=","followed","by","an","expression?"
4233+ ]
4234+ , noteForRecordIndentError
3849− ]
4235+ ]
3850 )
4236 )
3851
4237
3852 RecordIndentExpr row col ->
4238 RecordIndentExpr row col ->
@@ -3860,52 +4246,48 @@ toRecordReport source context record startRow startCol =
3860 D.reflow $
4246 D.reflow $
3861 "I am partway through parsing a record, and I was expecting to run into an expression next:"
4247 "I am partway through parsing a record, and I was expecting to run into an expression next:"
3862 ,
4248 ,
3863− addNoteForRecordIndentError $
4249+ D.stack
3864− D.fillSep $
4250+ [ D.fillSep $
3865− ["Try","putting","something","like"
4251+ ["Try","putting","something","like"
3866− ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"
4252+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"
4253+ ]
4254+ , noteForRecordIndentError
3867− ]
4255+ ]
3868 )
4256 )
3869
4257
3870
4258
3871−addNoteForRecordError :: D.Doc -> D.Doc
4259+noteForRecordError :: D.Doc
3872−addNoteForRecordError normalRecommendation =
4260+noteForRecordError =
3873 D.stack $
4261 D.stack $
3874− normalRecommendation
3875− :
3876 [ D.toSimpleNote
4262 [ D.toSimpleNote
3877 "If you are trying to define a record across multiple lines, I recommend using this format:"
4263 "If you are trying to define a record across multiple lines, I recommend using this format:"
3878 , D.indent 4 $ D.vcat $
4264 , D.indent 4 $ D.vcat $
3879− [ "{ name = \"Alice\""
4265+ [ "{ name = " <> D.dullyellow "\"Alice\""
3880− , ", age = 42"
4266+ , ", age = " <> D.dullyellow "42"
3881− , ", height = 1.75"
4267+ , ", height = " <> D.dullyellow "1.75"
3882 , "}"
4268 , "}"
3883 ]
4269 ]
3884 , D.reflow $
4270 , D.reflow $
3885− "Notice that each line starts with some indentation. Usually two or four spaces. I\
4271+ "Notice that each line starts with some indentation. Usually two or four spaces.\
3886− \ know this style can be jarring for people coming from C-like syntax, but folks generally\
4272+ \ This is the stylistic convention in the Elm ecosystem."
3887− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
3888 ]
4273 ]
3889
4274
3890
4275
3891−addNoteForRecordIndentError :: D.Doc -> D.Doc
4276+noteForRecordIndentError :: D.Doc
3892−addNoteForRecordIndentError normalRecommendation =
4277+noteForRecordIndentError =
3893− D.stack $
4278+ D.stack
3894− normalRecommendation
3895− :
3896 [ D.toSimpleNote
4279 [ D.toSimpleNote
3897 "I may be confused by indentation. For example, if you are trying to define\
4280 "I may be confused by indentation. For example, if you are trying to define\
3898 \ a record across multiple lines, I recommend using this format:"
4281 \ a record across multiple lines, I recommend using this format:"
3899 , D.indent 4 $ D.vcat $
4282 , D.indent 4 $ D.vcat $
3900− [ "{ name = \"Alice\""
4283+ [ "{ name = " <> D.dullyellow "\"Alice\""
3901− , ", age = 42"
4284+ , ", age = " <> D.dullyellow "42"
3902− , ", height = 1.75"
4285+ , ", height = " <> D.dullyellow "1.75"
3903 , "}"
4286 , "}"
3904 ]
4287 ]
3905 , D.reflow $
4288 , D.reflow $
3906− "Notice that each line starts with some indentation. Usually two or four spaces. I\
4289+ "Notice that each line starts with some indentation. Usually two or four spaces.\
3907− \ know this style can be jarring for people coming from C-like syntax, but folks generally\
4290+ \ This is the stylistic convention in the Elm ecosystem!"
3908− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
3909 ]
4291 ]
3910
4292
3911
4293
@@ -4094,15 +4476,14 @@ toListReport source context list startRow startCol =
4094 , D.toSimpleNote
4476 , D.toSimpleNote
4095 "I recommend using the following format for lists that span multiple lines:"
4477 "I recommend using the following format for lists that span multiple lines:"
4096 , D.indent 4 $ D.vcat $
4478 , D.indent 4 $ D.vcat $
4097− [ "[ \"Alice\""
4479+ [ "[ " <> D.dullyellow "\"Alice\""
4098− , ", \"Bob\""
4480+ , ", " <> D.dullyellow "\"Bob\""
4099− , ", \"Chuck\""
4481+ , ", " <> D.dullyellow "\"Chuck\""
4100 , "]"
4482 , "]"
4101 ]
4483 ]
4102 , D.reflow $
4484 , D.reflow $
4103− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4485+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4104− \ This style can be jarring for people coming from C-like syntax, but folks generally\
4486+ \ This is the stylistic convention in the Elm ecosystem."
4105− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4106 ]
4487 ]
4107 )
4488 )
4108
4489
@@ -4155,15 +4536,14 @@ toListReport source context list startRow startCol =
4155 "I may be confused by indentation. For example, if you are trying to define\
4536 "I may be confused by indentation. For example, if you are trying to define\
4156 \ a list across multiple lines, I recommend using this format:"
4537 \ a list across multiple lines, I recommend using this format:"
4157 , D.indent 4 $ D.vcat $
4538 , D.indent 4 $ D.vcat $
4158− [ "[ \"Alice\""
4539+ [ "[ " <> D.dullyellow "\"Alice\""
4159− , ", \"Bob\""
4540+ , ", " <> D.dullyellow "\"Bob\""
4160− , ", \"Chuck\""
4541+ , ", " <> D.dullyellow "\"Chuck\""
4161 , "]"
4542 , "]"
4162 ]
4543 ]
4163 , D.reflow $
4544 , D.reflow $
4164− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4545+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4165− \ This style can be jarring for people coming from C-like syntax, but folks generally\
4546+ \ This is the stylistic convention in the Elm ecosystem."
4166− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4167 ]
4547 ]
4168 )
4548 )
4169
4549
@@ -4187,15 +4567,14 @@ toListReport source context list startRow startCol =
4187 "I may be confused by indentation. For example, if you are trying to define\
4567 "I may be confused by indentation. For example, if you are trying to define\
4188 \ a list across multiple lines, I recommend using this format:"
4568 \ a list across multiple lines, I recommend using this format:"
4189 , D.indent 4 $ D.vcat $
4569 , D.indent 4 $ D.vcat $
4190− [ "[ \"Alice\""
4570+ [ "[ " <> D.dullyellow "\"Alice\""
4191− , ", \"Bob\""
4571+ , ", " <> D.dullyellow "\"Bob\""
4192− , ", \"Chuck\""
4572+ , ", " <> D.dullyellow "\"Chuck\""
4193 , "]"
4573 , "]"
4194 ]
4574 ]
4195 , D.reflow $
4575 , D.reflow $
4196− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4576+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4197− \ This style can be jarring for people coming from C-like syntax, but folks generally\
4577+ \ This is the stylistic convention in the Elm ecosystem."
4198− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4199 ]
4578 ]
4200 )
4579 )
4201
4580
@@ -4216,15 +4595,14 @@ toListReport source context list startRow startCol =
4216 , D.toSimpleNote
4595 , D.toSimpleNote
4217 "I recommend using the following format for lists that span multiple lines:"
4596 "I recommend using the following format for lists that span multiple lines:"
4218 , D.indent 4 $ D.vcat $
4597 , D.indent 4 $ D.vcat $
4219− [ "[ \"Alice\""
4598+ [ "[ " <> D.dullyellow "\"Alice\""
4220− , ", \"Bob\""
4599+ , ", " <> D.dullyellow "\"Bob\""
4221− , ", \"Chuck\""
4600+ , ", " <> D.dullyellow "\"Chuck\""
4222 , "]"
4601 , "]"
4223 ]
4602 ]
4224 , D.reflow $
4603 , D.reflow $
4225− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\
4604+ "Notice that each line starts with some indentation. Usually two or four spaces.\
4226− \ This style can be jarring for people coming from C-like syntax, but folks generally\
4605+ \ This is the stylistic convention in the Elm ecosystem."
4227− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
4228 ]
4606 ]
4229 )
4607 )
4230
4608
@@ -5097,22 +5475,64 @@ toTRecordReport source context record startRow startCol =
5097 \ that is a reserved word. Try using a different name!"
5475 \ that is a reserved word. Try using a different name!"
5098 )
5476 )
5099
5477
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+
5100 _ ->
5517 _ ->
5101 let
5518 let
5102 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5519 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5103 region = toRegion row col
5520 region = toRegion row col
5104 in
5521 in
5105− Report.Report "UNFINISHED RECORD TYPE" region [] $
5522+ Report.Report "PROBLEM IN RECORD TYPE" region [] $
5106 Code.toSnippet source surroundings (Just region)
5523 Code.toSnippet source surroundings (Just region)
5107 (
5524 (
5108 D.reflow $
5525 D.reflow $
5109− "I am partway through parsing a record type, but I got stuck after that last comma:"
5526+ "I am partway through parsing a record type, but I got stuck here:"
5110 ,
5527 ,
5111− addNoteForRecordTypeError $
5528+ D.stack
5112− D.reflow $
5529+ [ D.fillSep
5113− "Trailing commas are not allowed in records, so I was expecting to see another\
5530+ ["I","was","expecting","to","see","another","record","field","defined","next,"
5114− \ record field defined next. If you are done defining the record, the fix may\
5531+ ,"so","I","am","looking","for","a","name","like"
5115− \ be to delete that last comma?"
5532+ ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."
5533+ ]
5534+ , noteForRecordTypeError
5535+ ]
5116 )
5536 )
5117
5537
5118 TRecordColon row col ->
5538 TRecordColon row col ->
@@ -5126,11 +5546,13 @@ toTRecordReport source context record startRow startCol =
5126 D.reflow $
5546 D.reflow $
5127 "I am partway through parsing a record type, but I got stuck here:"
5547 "I am partway through parsing a record type, but I got stuck here:"
5128 ,
5548 ,
5129− addNoteForRecordTypeError $
5549+ D.stack
5130− D.fillSep $
5550+ [ D.fillSep $
5131− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
5551+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"
5132− ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"
5552+ ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"
5553+ ]
5554+ , noteForRecordTypeError
5133− ]
5555+ ]
5134 )
5556 )
5135
5557
5136 TRecordType tipe row col ->
5558 TRecordType tipe row col ->
@@ -5150,29 +5572,54 @@ toTRecordReport source context record startRow startCol =
5150 D.reflow $
5572 D.reflow $
5151 "I just saw the opening curly brace of a record type, but then I got stuck here:"
5573 "I just saw the opening curly brace of a record type, but then I got stuck here:"
5152 ,
5574 ,
5153− addNoteForRecordTypeIndentError $
5575+ D.stack
5154− D.fillSep $
5576+ [ D.fillSep $
5155− ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."
5577+ ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."
5156− ,"Try","defining","some","fields","of","your","own?"
5578+ ,"Try","defining","some","fields","of","your","own?"
5579+ ]
5580+ , noteForRecordTypeIndentError
5157− ]
5581+ ]
5158 )
5582 )
5159
5583
5160 TRecordIndentEnd row col ->
5584 TRecordIndentEnd row col ->
5585+ case Code.nextLineStartsWithCloseCurly source row of
5586+ Just (curlyRow, curlyCol) ->
5161− let
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
5162− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5606+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)
5163− region = toRegion row col
5607+ region = toRegion row col
5164− in
5608+ in
5165− Report.Report "UNFINISHED RECORD TYPE" region [] $
5609+ Report.Report "UNFINISHED RECORD TYPE" region [] $
5166− Code.toSnippet source surroundings (Just region)
5610+ Code.toSnippet source surroundings (Just region)
5167− (
5611+ (
5168− D.reflow $
5612+ D.reflow $
5613+ "I was partway through parsing a record type, but I got stuck here:"
5614+ ,
5615+ D.stack
5616+ [ D.fillSep $
5169− "I was expecting to see a closing curly brace next:"
5617+ ["I","was","expecting","to","see","a","closing","curly","brace","next."
5170− ,
5171− addNoteForRecordTypeIndentError $
5172− D.fillSep $
5173− ["Try","putting","an",D.green "}","and","see","if","that","helps?"
5618+ ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"
5619+ ]
5620+ , noteForRecordTypeIndentError
5174− ]
5621+ ]
5175− )
5622+ )
5176
5623
5177 TRecordIndentField row col ->
5624 TRecordIndentField row col ->
5178 let
5625 let
@@ -5185,11 +5632,13 @@ toTRecordReport source context record startRow startCol =
5185 D.reflow $
5632 D.reflow $
5186 "I am partway through parsing a record type, but I got stuck after that last comma:"
5633 "I am partway through parsing a record type, but I got stuck after that last comma:"
5187 ,
5634 ,
5188− addNoteForRecordTypeIndentError $
5635+ D.stack
5189− D.reflow $
5636+ [ D.reflow $
5190− "Trailing commas are not allowed in record types, so the fix may be to\
5637+ "Trailing commas are not allowed in record types, so the fix may be to\
5191− \ delete that last comma? Or maybe you were in the middle of defining\
5638+ \ delete that last comma? Or maybe you were in the middle of defining\
5192− \ an additional field?"
5639+ \ an additional field?"
5640+ , noteForRecordTypeIndentError
5641+ ]
5193 )
5642 )
5194
5643
5195 TRecordIndentColon row col ->
5644 TRecordIndentColon row col ->
@@ -5204,10 +5653,12 @@ toTRecordReport source context record startRow startCol =
5204 "I am partway through parsing a record type. I just saw a record\
5653 "I am partway through parsing a record type. I just saw a record\
5205 \ field, so I was expecting to see a colon next:"
5654 \ field, so I was expecting to see a colon next:"
5206 ,
5655 ,
5207− addNoteForRecordTypeIndentError $
5656+ D.stack
5208− D.fillSep $
5657+ [ D.fillSep $
5209− ["Try","putting","an",D.green ":","followed","by","a","type?"
5658+ ["Try","putting","an",D.green ":","followed","by","a","type?"
5659+ ]
5660+ , noteForRecordTypeIndentError
5210− ]
5661+ ]
5211 )
5662 )
5212
5663
5213 TRecordIndentType row col ->
5664 TRecordIndentType row col ->
@@ -5221,19 +5672,19 @@ toTRecordReport source context record startRow startCol =
5221 D.reflow $
5672 D.reflow $
5222 "I am partway through parsing a record type, and I was expecting to run into a type next:"
5673 "I am partway through parsing a record type, and I was expecting to run into a type next:"
5223 ,
5674 ,
5224− addNoteForRecordTypeIndentError $
5675+ D.stack
5225− D.fillSep $
5676+ [ D.fillSep $
5226− ["Try","putting","something","like"
5677+ ["Try","putting","something","like"
5227− ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"
5678+ ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"
5679+ ]
5680+ , noteForRecordTypeIndentError
5228− ]
5681+ ]
5229 )
5682 )
5230
5683
5231
5684
5232−addNoteForRecordTypeError :: D.Doc -> D.Doc
5685+noteForRecordTypeError :: D.Doc
5233−addNoteForRecordTypeError normalRecommendation =
5686+noteForRecordTypeError =
5234 D.stack $
5687 D.stack $
5235− normalRecommendation
5236− :
5237 [ D.toSimpleNote
5688 [ D.toSimpleNote
5238 "If you are trying to define a record type across multiple lines, I recommend using this format:"
5689 "If you are trying to define a record type across multiple lines, I recommend using this format:"
5239 , D.indent 4 $ D.vcat $
5690 , D.indent 4 $ D.vcat $
@@ -5243,17 +5694,14 @@ addNoteForRecordTypeError normalRecommendation =
5243 , "}"
5694 , "}"
5244 ]
5695 ]
5245 , D.reflow $
5696 , D.reflow $
5246− "Notice that each line starts with some indentation. Usually two or four spaces. I\
5697+ "Notice that each line starts with some indentation. Usually two or four spaces.\
5247− \ know this style can be jarring for people coming from C-like syntax, but folks generally\
5698+ \ This is the stylistic convention in the Elm ecosystem."
5248− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
5249 ]
5699 ]
5250
5700
5251
5701
5252−addNoteForRecordTypeIndentError :: D.Doc -> D.Doc
5702+noteForRecordTypeIndentError :: D.Doc
5253−addNoteForRecordTypeIndentError normalRecommendation =
5703+noteForRecordTypeIndentError =
5254 D.stack $
5704 D.stack $
5255− normalRecommendation
5256− :
5257 [ D.toSimpleNote
5705 [ D.toSimpleNote
5258 "I may be confused by indentation. For example, if you are trying to define\
5706 "I may be confused by indentation. For example, if you are trying to define\
5259 \ a record type across multiple lines, I recommend using this format:"
5707 \ a record type across multiple lines, I recommend using this format:"
@@ -5264,9 +5712,8 @@ addNoteForRecordTypeIndentError normalRecommendation =
5264 , "}"
5712 , "}"
5265 ]
5713 ]
5266 , D.reflow $
5714 , D.reflow $
5267− "Notice that each line starts with some indentation. Usually two or four spaces. I\
5715+ "Notice that each line starts with some indentation. Usually two or four spaces.\
5268− \ know this style can be jarring for people coming from C-like syntax, but folks generally\
5716+ \ This is the stylistic convention in the Elm ecosystem."
5269− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."
5270 ]
5717 ]
5271
5718
5272
5719
compiler/src/Reporting/Error/Type.hs+36−20
@@ -231,7 +231,7 @@ toPatternReport source localizer patternRegion category tipe expected =
231 "But all the previous patterns match:"
231 "But all the previous patterns match:"
232 [ D.link "Note"
232 [ D.link "Note"
233 "A `case` expression can only handle one type of value, so you may want to use"
233 "A `case` expression can only handle one type of value, so you may want to use"
234− "union-types"
234+ "custom-types"
235 "to handle “mixing” types."
235 "to handle “mixing” types."
236 ]
236 ]
237 )
237 )
@@ -253,11 +253,11 @@ toPatternReport source localizer patternRegion category tipe expected =
253 , patternTypeComparison localizer tipe expectedType
253 , patternTypeComparison localizer tipe expectedType
254 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)
254 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)
255 "But all the previous patterns in the list are:"
255 "But all the previous patterns in the list are:"
256− [ D.toSimpleHint $
256+ [ D.link "Hint"
257− "Everything in the list needs to be the same type of value.\
257+ "Everything in a list must be the same type of value. This way, we never\
258− \ This way you never run into unexpected values partway through.\
258+ \ run into unexpected values partway through a List.map, List.foldl, etc. Read"
259− \ To mix different types in a single list, create a \"union type\" as\
259+ "custom-types"
260− \ described in: <http://guide.elm-lang.org/types/union_types.html>"
260+ "to learn how to “mix” types."
261 ]
261 ]
262 )
262 )
263
263
@@ -431,10 +431,6 @@ problemToHint problem =
431 ]
431 ]
432 ]
432 ]
433
433
434− T.AnythingToList ->
435− [ D.toSimpleHint "Did you forget to add [] around it?"
436− ]
437−
438 T.ArityMismatch x y ->
434 T.ArityMismatch x y ->
439 [ D.toSimpleHint $
435 [ D.toSimpleHint $
440 if x < y then
436 if x < y then
@@ -563,11 +559,31 @@ badFlexSuper :: T.Direction -> T.Super -> T.Type -> [D.Doc]
563badFlexSuper direction super tipe =
559badFlexSuper direction super tipe =
564 case super of
560 case super of
565 T.Comparable ->
561 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 $
566− [ D.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable."
581+ "I only know how to compare ints, floats, chars, strings, lists of\
582+ \ comparable values, and tuples of comparable values."
567− ]
583+ ]
568
584
569 T.Appendable ->
585 T.Appendable ->
570− [ D.toSimpleHint "Only strings and lists are appendable."
586+ [ D.toSimpleHint "I only know how to append strings and lists."
571 ]
587 ]
572
588
573 T.CompAppend ->
589 T.CompAppend ->
@@ -694,11 +710,11 @@ toExprReport source localizer exprRegion category tipe expected =
694 , "The " <> ith <> " element of this list does not match all the previous elements:"
710 , "The " <> ith <> " element of this list does not match all the previous elements:"
695 , "The " <> ith <> " element is"
711 , "The " <> ith <> " element is"
696 , "But all the previous elements in the list are:"
712 , "But all the previous elements in the list are:"
697− , [ D.toSimpleHint $
713+ , [ D.link "Hint"
698− "Everything in the list needs to be the same type of value.\
714+ "Everything in a list must be the same type of value. This way, we never\
699− \ This way you never run into unexpected values partway through.\
715+ \ run into unexpected values partway through a List.map, List.foldl, etc. Read"
700− \ To mix different types in a single list, create a \"union type\" as\
716+ "custom-types"
701− \ described in: <http://guide.elm-lang.org/types/union_types.html>"
717+ "to learn how to “mix” types."
702 ]
718 ]
703 )
719 )
704
720
@@ -745,7 +761,7 @@ toExprReport source localizer exprRegion category tipe expected =
745 , [ D.link "Hint"
761 , [ D.link "Hint"
746 "All branches in an `if` must produce the same type of values. This way, no\
762 "All branches in an `if` must produce the same type of values. This way, no\
747 \ matter which branch we take, the result is always a consistent shape. Read"
763 \ matter which branch we take, the result is always a consistent shape. Read"
748− "union-types"
764+ "custom-types"
749 "to learn how to “mix” types."
765 "to learn how to “mix” types."
750 ]
766 ]
751 )
767 )
@@ -760,7 +776,7 @@ toExprReport source localizer exprRegion category tipe expected =
760 , [ D.link "Hint"
776 , [ D.link "Hint"
761 "All branches in a `case` must produce the same type of values. This way, no\
777 "All branches in a `case` must produce the same type of values. This way, no\
762 \ matter which branch we take, the result is always a consistent shape. Read"
778 \ matter which branch we take, the result is always a consistent shape. Read"
763− "union-types"
779+ "custom-types"
764 "to learn how to “mix” types."
780 "to learn how to “mix” types."
765 ]
781 ]
766 )
782 )
compiler/src/Reporting/Render/Code.hs+65−24
@@ -7,6 +7,8 @@ module Reporting.Render.Code
7 , toPair
7 , toPair
8 , Next(..)
8 , Next(..)
9 , whatIsNext
9 , whatIsNext
10+ , nextLineStartsWithKeyword
11+ , nextLineStartsWithCloseCurly
10 )
12 )
11 where
13 where
12
14
@@ -120,7 +122,7 @@ makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end
120 spaces = replicate (fromIntegral c1 + width + 1) ' '
122 spaces = replicate (fromIntegral c1 + width + 1) ' '
121 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
123 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'
122 in
124 in
123− Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))
125+ Just (D.fromChars spaces <> D.red (D.fromChars zigzag))
124
126
125
127
126drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
128drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc
@@ -146,7 +148,7 @@ addLineNumber addZigZag width start end n line =
146
148
147 spacer =
149 spacer =
148 if addZigZag && start <= n && n <= end then
150 if addZigZag && start <= n && n <= end then
149− D.dullred ">"
151+ D.red ">"
150 else
152 else
151 " "
153 " "
152 in
154 in
@@ -181,8 +183,8 @@ renderPair source@(Source sourceLines) region1 region2 =
181 OneLine $
183 OneLine $
182 D.vcat
184 D.vcat
183 [ D.fromChars lineNumber <> "| " <> D.fromChars line
185 [ D.fromChars lineNumber <> "| " <> D.fromChars line
184− , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>
186+ , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>
185− D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)
187+ D.fromChars spaces2 <> D.red (D.fromChars zigzag2)
186 ]
188 ]
187
189
188 else
190 else
@@ -199,6 +201,8 @@ data Next
199 = Keyword [Char]
201 = Keyword [Char]
200 | Operator [Char]
202 | Operator [Char]
201 | Close [Char] Char
203 | Close [Char] Char
204+ | Upper Char [Char]
205+ | Lower Char [Char]
202 | Other (Maybe Char)
206 | Other (Maybe Char)
203
207
204
208
@@ -209,25 +213,34 @@ whatIsNext (Source sourceLines) row col =
209 Other Nothing
213 Other Nothing
210
214
211 Just line ->
215 Just line ->
212− let
213− chars = drop (fromIntegral col - 1) line
216+ case drop (fromIntegral col - 1) line of
214− keywords = map Name.toChars (Set.toList reservedWords)
217+ [] ->
215− in
218+ Other Nothing
216− case List.find (startsWithKeyword chars) keywords of
219+
217− Just keyword ->
220+ c:cs
218− Keyword keyword
221+ | Char.isUpper c -> Upper c (takeWhile isInner cs)
219−
222+ | Char.isLower c -> detectKeywords c cs
220− Nothing ->
221− case chars of
222− [] ->
223− Other Nothing
224−
225− c:cs
226− | isSymbol c -> Operator (c : takeWhile isSymbol cs)
223+ | isSymbol c -> Operator (c : takeWhile isSymbol cs)
227− | c == ')' -> Close "parenthesis" ')'
224+ | c == ')' -> Close "parenthesis" ')'
228− | c == ']' -> Close "square bracket" ']'
225+ | c == ']' -> Close "square bracket" ']'
229− | c == '}' -> Close "curly brace" '}'
226+ | c == '}' -> Close "curly brace" '}'
230− | otherwise -> Other (Just c)
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 == '_'
231
244
232
245
233isSymbol :: Char -> Bool
246isSymbol :: Char -> Bool
@@ -244,4 +257,32 @@ startsWithKeyword restOfLine keyword =
244 True
257 True
245
258
246 c:_ ->
259 c:_ ->
247− not (Char.isAlphaNum c || c == '_')
260+ not (isInner c)
261+
262+
263+nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)
264+nextLineStartsWithKeyword keyword (Source sourceLines) row =
265+ case List.lookup (row + 1) sourceLines of
266+ Nothing ->
267+ Nothing
268+
269+ Just line ->
270+ if startsWithKeyword (dropWhile (==' ') line) keyword then
271+ Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
272+ else
273+ Nothing
274+
275+
276+nextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col)
277+nextLineStartsWithCloseCurly (Source sourceLines) row =
278+ case List.lookup (row + 1) sourceLines of
279+ Nothing ->
280+ Nothing
281+
282+ Just line ->
283+ case dropWhile (==' ') line of
284+ '}':_ ->
285+ Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))
286+
287+ _ ->
288+ Nothing
compiler/src/Reporting/Render/Type/Localizer.hs+5−5
@@ -112,9 +112,9 @@ toExposing exposing =
112 Only (foldr addType Set.empty exposedList)
112 Only (foldr addType Set.empty exposedList)
113
113
114
114
115−addType :: A.Located Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
115+addType :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name
116−addType (A.At _ exposed) types =
116+addType exposed types =
117 case exposed of
117 case exposed of
118− Src.Lower _ -> types
118+ Src.Lower _ -> types
119− Src.Upper name _ -> Set.insert name types
119+ Src.Upper (A.At _ name) _ -> Set.insert name types
120− Src.Operator _ -> types
120+ Src.Operator _ _ -> types
compiler/src/Type/Error.hs+8−2
@@ -175,7 +175,6 @@ data Problem
175 | StringToFloat
175 | StringToFloat
176 | AnythingToBool
176 | AnythingToBool
177 | AnythingFromMaybe
177 | AnythingFromMaybe
178− | AnythingToList
179 | ArityMismatch Int Int
178 | ArityMismatch Int Int
180 | BadFlexSuper Direction Super Name.Name Type
179 | BadFlexSuper Direction Super Name.Name Type
181 | BadRigidVar Name.Name Type
180 | BadRigidVar Name.Name Type
@@ -301,7 +300,7 @@ toDiff localizer ctx tipe1 tipe2 =
301 different
300 different
302 (toDoc localizer ctx t1)
301 (toDoc localizer ctx t1)
303 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])
302 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])
304− (Bag.one AnythingToList)
303+ Bag.empty
305
304
306 (Alias home1 name1 args1 t1, t2) ->
305 (Alias home1 name1 args1 t1, t2) ->
307 case diffAliasedRecord localizer t1 t2 of
306 case diffAliasedRecord localizer t1 t2 of
@@ -450,6 +449,13 @@ isSuper super tipe =
450 Appendable -> isString h n || isList h n
449 Appendable -> isString h n || isList h n
451 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)
450 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)
452
451
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+
453 _ ->
459 _ ->
454 False
460 False
455
461
compiler/src/Type/Unify.hs+5−8
@@ -391,13 +391,13 @@ unifyFlexSuperStructure context super flatType =
391
391
392 Comparable ->
392 Comparable ->
393 do comparableOccursCheck context
393 do comparableOccursCheck context
394− merge context (Structure flatType)
395 unifyComparableRecursive variable
394 unifyComparableRecursive variable
395+ merge context (Structure flatType)
396
396
397 CompAppend ->
397 CompAppend ->
398 do comparableOccursCheck context
398 do comparableOccursCheck context
399− merge context (Structure flatType)
400 unifyComparableRecursive variable
399 unifyComparableRecursive variable
400+ merge context (Structure flatType)
401
401
402 Tuple1 a b maybeC ->
402 Tuple1 a b maybeC ->
403 case super of
403 case super of
@@ -409,15 +409,12 @@ unifyFlexSuperStructure context super flatType =
409
409
410 Comparable ->
410 Comparable ->
411 do comparableOccursCheck context
411 do comparableOccursCheck context
412− merge context (Structure flatType)
413 unifyComparableRecursive a
412 unifyComparableRecursive a
414 unifyComparableRecursive b
413 unifyComparableRecursive b
415 case maybeC of
414 case maybeC of
416− Nothing ->
415+ Nothing -> return ()
417− return ()
418−
419− Just c ->
420− unifyComparableRecursive c
416+ Just c -> unifyComparableRecursive c
417+ merge context (Structure flatType)
421
418
422 CompAppend ->
419 CompAppend ->
423 mismatch
420 mismatch
docs/elm.json/application.md+2−2
@@ -8,7 +8,7 @@ This is a decent baseline for pretty much any applications made with Elm. You wi
8 "source-directories": [
8 "source-directories": [
9 "src"
9 "src"
10 ],
10 ],
11− "elm-version": "0.19.0",
11+ "elm-version": "0.19.1",
12 "dependencies": {
12 "dependencies": {
13 "direct": {
13 "direct": {
14 "elm/browser": "1.0.0",
14 "elm/browser": "1.0.0",
@@ -48,7 +48,7 @@ A list of directories where Elm code lives. Most projects just use `"src"` for e
48
48
49## `"elm-version"`
49## `"elm-version"`
50
50
51−The exact version of Elm this builds with. Should be `"0.19.0"` for most people!
51+The exact version of Elm this builds with. Should be `"0.19.1"` for most people!
52
52
53<br>
53<br>
54
54
docs/elm.json/package.md+1−1
@@ -49,7 +49,7 @@ A short summary that will appear on [`package.elm-lang.org`](https://package.elm
49
49
50## `"license"`
50## `"license"`
51
51
52−An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, but you can see the full list of options [here](https://spdx.org/licenses/).
52+An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, and BSD-3-Clause is a good default. But you can see the full list of options [here](https://spdx.org/licenses/).
53
53
54<br>
54<br>
55
55
upgrade-docs/0.16.md → docs/upgrade-instructions/0.16.mdrenamed

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

docs/upgrade-instructions/0.19.1.mdnew file+60
@@ -0,0 +1,60 @@
1+# Upgrading to 0.19.1
2+
3+**There are no language changes**, so once you swap to `"elm-version": "0.19.1"` in your `elm.json`, most users should be able to proceed without any further code changes. **You may run into a handful of bugfixes though!** These cases are outlined below!
4+
5+
6+<br>
7+
8+## Improvements
9+
10+- Parse error message quality (like [this](https://github.com/elm/error-message-catalog/issues/255) and [this](https://github.com/elm/error-message-catalog/issues/225))
11+- Faster compilation, especially for incremental compiles
12+- Uses filelocks so that cached files are not corrupted when plugins run `elm make` multiple times on the same project at the same time. (Still worth avoiding that though!)
13+- More intuitive multiline declarations in REPL
14+- Various bug fixes (e.g. `--debug`, `x /= 0`, `type Height = Height Float` in `--optimize`)
15+
16+
17+<br>
18+
19+## Detectable Bug Fixes
20+
21+There are three known cases where code that compiled with 0.19.0 will not compile with 0.19.1 due to bug fixes:
22+
23+
24+### 1. Ambiguous Imports
25+
26+Say you have an import like this:
27+
28+```elm
29+import Html exposing (min)
30+import Regex exposing (never)
31+
32+x = min
33+y = never
34+```
35+
36+These should be reported as ambiguous usages since the names are also exposed by `Basics`, but there was a regression in 0.19.0 described [here](https://github.com/elm/compiler/issues/1945) such that they weren't caught in specific circumstances.
37+
38+The fix is to use a qualified name like `Html.min` or `Regex.never` to make it unambiguous.
39+
40+We found a couple instances of this in packages and have submitted PRs to the relevant authors in August 2019. You may run into this in your own code as well.
41+
42+For more details on why this is considered a regression, check out the details [here](https://github.com/elm/compiler/issues/1945#issuecomment-507871919) or try it in 0.18.0 to see how it worked before.
43+
44+
45+### 2. Tabs in Comments
46+
47+The 0.19.0 binaries did not catch tab characters in comments. The new parser is better at checking for tabs, so it will object when it finds these.
48+
49+Again, we found this in some packages and reached out to the relevant authors with PRs so patches would be published before the 0.19.1 release.
50+
51+
52+### 3. Port Module with no Ports
53+
54+If you have any files that start with:
55+
56+```elm
57+port module Main exposing (..)
58+```
59+
60+But they do not actually have any `port` declarations, the 0.19.1 binary will ask you to switch to a normal module declaration like `module Main exposing (..)`
upgrade-docs/earlier.md → docs/upgrade-instructions/earlier.mdrenamed

The content is the same.

elm.cabal+6−5
@@ -45,6 +45,7 @@ Executable elm
45 Hs-Source-Dirs:
45 Hs-Source-Dirs:
46 compiler/src
46 compiler/src
47 builder/src
47 builder/src
48+ terminal/impl
48 terminal/src
49 terminal/src
49
50
50 other-extensions:
51 other-extensions:
@@ -64,11 +65,11 @@ Executable elm
64 Repl
65 Repl
65
66
66 -- terminal args
67 -- terminal args
67− Terminal.Args
68+ Terminal
68− Terminal.Args.Chomp
69+ Terminal.Chomp
69− Terminal.Args.Error
70+ Terminal.Error
70− Terminal.Args.Helpers
71+ Terminal.Helpers
71− Terminal.Args.Internal
72+ Terminal.Internal
72
73
73 -- from terminal/
74 -- from terminal/
74 Develop.Generate.Help
75 Develop.Generate.Help
hints/bad-recursion.mdnew file+133
@@ -0,0 +1,133 @@
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.mdnew file+98
@@ -0,0 +1,98 @@
1+# Comparing Custom Types
2+
3+The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare custom types?
4+
5+This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
6+
7+
8+## Wrapped Types
9+
10+It is common to try to get some extra type safety by creating really simple custom types:
11+
12+```elm
13+type Id = Id Int
14+type Age = Age Int
15+
16+type Comment = Comment String
17+type Description = Description String
18+```
19+
20+By wrapping the primitive values like this, the type system can now help you make sure that you never mix up a `Id` and an `Age`. Those are different types! This trick is extra cool because it has no runtime cost in `--optimize` mode. The compiler can just use an `Int` or `String` directly when you use that flag!
21+
22+The problem arises when you want to use a `Id` as a key in a dictionary. This is a totally reasonable thing to do, but the current version of Elm cannot handle this scenario.
23+
24+Instead of creating a `Dict Id Info` type, one thing you can do is create a custom data structure like this:
25+
26+```elm
27+module User exposing (Id, Table, empty, get, add)
28+
29+import Dict exposing (Dict)
30+
31+
32+-- USER
33+
34+type Id = Id Int
35+
36+
37+-- TABLE
38+
39+type Table info =
40+ Table Int (Dict Int info)
41+
42+empty : Table info
43+empty =
44+ Table 0 Dict.empty
45+
46+get : Id -> Table info -> Maybe info
47+get (Id id) (Table _ dict) =
48+ Dict.get id dict
49+
50+add : info -> Table info -> (Table info, Id)
51+add info (Table nextId dict) =
52+ ( Table (nextId + 1) (Dict.insert nextId info dict)
53+ , Id nextId
54+ )
55+```
56+
57+There are a couple nice things about this approach:
58+
59+1. The only way to get a new `User.Id` is to `add` information to a `User.Table`.
60+2. All the operations on a `User.Table` are explicit. Does it make sense to remove users? To merge two tables together? Are there any special details to consider in those cases? This will always be captured explicitly in the interface of the `User` module.
61+3. If you ever want to switch the internal representation from `Dict` to `Array` or something else, it is no problem. All the changes will be within the `User` module.
62+
63+So while this approach is not as convenient as using a `Dict` directly, it has some benefits of its own that can be helpful in some cases.
64+
65+
66+## Enumerations to Ints
67+
68+Say you need to define a `trafficLightToInt` function:
69+
70+```elm
71+type TrafficLight = Green | Yellow | Red
72+
73+trafficLightToInt : TrafficLight -> Int
74+trafficLightToInt trafficLight =
75+ ???
76+```
77+
78+We have heard that some people would prefer to use a dictionary for this sort of thing. That way you do not need to write the numbers yourself, they can be generated such that you never have a typo.
79+
80+I would recommend using a `case` expression though:
81+
82+```elm
83+type TrafficLight = Green | Yellow | Red
84+
85+trafficLightToInt : TrafficLight -> Int
86+trafficLightToInt trafficLight =
87+ case trafficLight of
88+ Green -> 1
89+ Yellow -> 2
90+ Red -> 3
91+```
92+
93+This is really straight-forward while avoiding questions like “is `Green` less than or greater than `Red`?”
94+
95+
96+## Something else?
97+
98+If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!
hints/comparing-records.mdnew file+85
@@ -0,0 +1,85 @@
1+# Comparing Records
2+
3+The built-in comparison operators work on a fixed set of types, like `Int` and `String`. That covers a lot of cases, but what happens when you want to compare records?
4+
5+This page aims to catalog these scenarios and offer alternative paths that can get you unstuck.
6+
7+
8+## Sorting Records
9+
10+Say we want a `view` function that can show a list of students sorted by different characteristics.
11+
12+We could create something like this:
13+
14+```elm
15+import Html exposing (..)
16+
17+type alias Student =
18+ { name : String
19+ , age : Int
20+ , gpa : Float
21+ }
22+
23+type Order = Name | Age | GPA
24+
25+viewStudents : Order -> List Student -> Html msg
26+viewStudents order students =
27+ let
28+ orderlyStudents =
29+ case order of
30+ Name -> List.sortBy .name students
31+ Age -> List.sortBy .age students
32+ GPA -> List.sortBy .gpa students
33+ in
34+ ul [] (List.map viewStudent orderlyStudents)
35+
36+viewStudent : Student -> Html msg
37+viewStudent student =
38+ li [] [ text student.name ]
39+```
40+
41+If you are worried about the performance of changing the order or updating information about particular students, you can start using the [`Html.Lazy`](https://package.elm-lang.org/packages/elm/html/latest/Html-Lazy) and [`Html.Keyed`](https://package.elm-lang.org/packages/elm/html/latest/Html-Keyed) modules. The updated code would look something like this:
42+
43+```elm
44+import Html exposing (..)
45+import Html.Lazy exposing (lazy)
46+import Html.Keyed as Keyed
47+
48+type Order = Name | Age | GPA
49+
50+type alias Student =
51+ { name : String
52+ , age : Int
53+ , gpa : Float
54+ }
55+
56+viewStudents : Order -> List Student -> Html msg
57+viewStudents order students =
58+ let
59+ orderlyStudents =
60+ case order of
61+ Name -> List.sortBy .name students
62+ Age -> List.sortBy .age students
63+ GPA -> List.sortBy .gpa students
64+ in
65+ Keyed.ul [] (List.map viewKeyedStudent orderlyStudents)
66+
67+viewKeyedStudent : Student -> (String, Html msg)
68+viewKeyedStudent student =
69+ ( student.name, lazy viewStudent student )
70+
71+viewStudent : Student -> Html msg
72+viewStudent student =
73+ li [] [ text student.name ]
74+```
75+
76+By using `Keyed.ul` we help the renderer move the DOM nodes around based on their key. This makes it much cheaper to reorder a bunch of students. And by using `lazy` we help the renderer skip a bunch of work. If the `Student` is the same as last time, the render can skip over it.
77+
78+> **Note:** Some people are skeptical of having logic like this in `view` functions, but I think the alternative (maintaining sort order in your `Model`) has some serious downsides. Say a colleague is adding a message to `Add` students, but they do not know about the sort order rules needed for presentation. Bug! So in this alternate design, you must diligently test your `update` function to make sure that no message disturbs the sort order. This is bound to lead to bugs over time!
79+>
80+> With all the optimizations possible with `Html.Lazy` and `Html.Keyed`, I would always be inclined to work on optimizing my `view` functions rather than making my `update` functions more complicated and error prone.
81+
82+
83+## Something else?
84+
85+If you have some other situation, please tell us about it [here](https://github.com/elm/error-message-catalog/issues). That is a log of error messages that can be improved, and we can use the particulars of your scenario to add more advice on this page!
hints/implicit-casts.mdnew file+50
@@ -0,0 +1,50 @@
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.mdnew file+184
@@ -0,0 +1,184 @@
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.mdnew file+126
@@ -0,0 +1,126 @@
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.mdnew file+42
@@ -0,0 +1,42 @@
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.mdnew file+55
@@ -0,0 +1,55 @@
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.mdnew file+139
@@ -0,0 +1,139 @@
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.mdnew file+59
@@ -0,0 +1,59 @@
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.mdnew file+32
@@ -0,0 +1,32 @@
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.mdnew file+162
@@ -0,0 +1,162 @@
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.mdnew file+73
@@ -0,0 +1,73 @@
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.mdnew file+70
@@ -0,0 +1,70 @@
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.mdnew file+19
@@ -0,0 +1,19 @@
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.mdnew file+60
@@ -0,0 +1,60 @@
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.mdnew file+32
@@ -0,0 +1,32 @@
1+# Installing Elm
2+
3+The normal path is to work through [the guide](https://guide.elm-lang.org/) until you need to install, but you can skip to installation directly by going [here](https://guide.elm-lang.org/install/terminal.html).
4+
5+
6+<br/>
7+
8+## Installing Multiple Versions
9+
10+The secret is that Elm is just a single executable file. If you are developing a project in `~/Desktop/project/` you can download this file into that directory and run commands like `~/Desktop/project/elm make src/Main.elm` or `./elm make src/Main.elm`. You just run the local copy of the executable file!
11+
12+The instructions for [Mac][mac] and [Linux][lin] explain how to do this in more detail. You can follow the same steps on Windows, but you need to do each step by hand. (E.g. download the file through your browser rather than with a terminal command.)
13+
14+[mac]: https://github.com/elm/compiler/blob/master/installers/mac/README.md
15+[lin]: https://github.com/elm/compiler/blob/master/installers/linux/README.md
16+
17+<br/>
18+
19+## Installing Previous Versions
20+
21+The past binaries for Mac, Linux, and Windows are hosted [here](https://github.com/elm/compiler/releases).
22+
23+You can download the executable files directly and use them locally.
24+
25+
26+<br/>
27+
28+## Uninstall
29+
30+- [Mac](https://github.com/elm/compiler/blob/master/installers/mac/README.md#uninstall)
31+- [Linux](https://github.com/elm/compiler/blob/master/installers/linux/README.md#uninstall)
32+- [Windows](https://github.com/elm/compiler/blob/master/installers/win/README.md#uninstall)
installers/linux/Dockerfile+33−18
@@ -1,24 +1,39 @@
1−# https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9
1+# Based initially on https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9
2+#
3+# Build Linux x64 binary from elm compiler top-level directory:
4+# $ docker build -t elm -f installers/linux/Dockerfile .
5+#
6+# Retrieve elm Linux binary:
7+# $ docker cp $(docker create elm):/usr/local/bin/elm DESTINATION_DIRECTORY
8+#
9+# Delete docker elm image:
10+# $ docker rmi elm
11+#
12+# Display all images:
13+# $ docker images -a
14+#
15+# Delete all unused docker images:
16+# $ docker system prune -a
2
17
18+# Use Alpine 3.11 with GHC 8.6.5
3−FROM alpine:3.10
19+FROM alpine:3.11
4
20
5−# branch
21+# Install packages required to build elm
6−ARG branch=master
22+RUN apk add --no-cache ghc cabal wget musl-dev zlib-dev zlib-static ncurses-dev ncurses-static
7−# commit or tag
8−ARG commit=HEAD
9
23
10−# Install required packages
24+WORKDIR /elm
11−RUN apk add --update ghc cabal git musl-dev zlib-dev ncurses-dev ncurses-static wget
12
25
26+# Import source code
27+COPY builder builder
13−# Checkout elm compiler
28+COPY compiler compiler
14−WORKDIR /tmp
29+COPY reactor reactor
15−RUN git clone -b $branch https://github.com/elm/compiler.git
30+COPY terminal terminal
31+COPY cabal.config elm.cabal LICENSE ./
16
32
17−# Build a statically linked elm binary
33+# Build statically linked elm binary
18−WORKDIR /tmp/compiler
19−RUN git checkout $commit
20−RUN rm worker/elm.cabal
21RUN cabal new-update
34RUN cabal new-update
22−RUN cabal new-configure --disable-executable-dynamic --ghc-option=-optl=-static --ghc-option=-optl=-pthread
35+RUN cabal new-build --ghc-option=-optl=-static --ghc-option=-split-sections
23−RUN cabal new-build
24−RUN strip -s ./dist-newstyle/build/x86_64-linux/ghc-8.4.3/elm-0.19.1/x/elm/build/elm/elm
36+RUN cp ./dist-newstyle/build/x86_64-linux/ghc-*/elm-*/x/elm/build/elm/elm /usr/local/bin/elm
37+
38+# Remove debug symbols to optimize the binary size
39+RUN strip -s /usr/local/bin/elm
installers/linux/README.mdnew file+93
@@ -0,0 +1,93 @@
1+# Install Instructions
2+
3+The pre-compiled binary for Linux works on a very wide range of distributions.
4+
5+It should be possible to install it by running the following commands in your terminal:
6+
7+```bash
8+# Move to your Desktop so you can see what is going on easier.
9+#
10+cd ~/Desktop/
11+
12+# Download the 0.19.1 binary for Linux.
13+#
14+# +-----------+----------------------+
15+# | FLAG | MEANING |
16+# +-----------+----------------------+
17+# | -L | follow redirects |
18+# | -o elm.gz | name the file elm.gz |
19+# +-----------+----------------------+
20+#
21+curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz
22+
23+# There should now be a file named `elm.gz` on your Desktop.
24+#
25+# The downloaded file is compressed to make it faster to download.
26+# This next command decompresses it, replacing `elm.gz` with `elm`.
27+#
28+gunzip elm.gz
29+
30+# There should now be a file named `elm` on your Desktop!
31+#
32+# Every file has "permissions" about whether it can be read, written, or executed.
33+# So before we use this file, we need to mark this file as executable:
34+#
35+chmod +x elm
36+
37+# The `elm` file is now executable. That means running `~/Desktop/elm --help`
38+# should work. Saying `./elm --help` works the same.
39+#
40+# But we want to be able to say `elm --help` without specifying the full file
41+# path every time. We can do this by moving the `elm` binary to one of the
42+# directories listed in your `PATH` environment variable:
43+#
44+sudo mv elm /usr/local/bin/
45+
46+# Now it should be possible to run the `elm` binary just by saying its name!
47+#
48+elm --help
49+```
50+
51+<br/>
52+
53+## Wait, what is the `PATH` variable?
54+
55+When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.
56+
57+The `PATH` is the list of directories that get searched. You can see these directories by running:
58+
59+```bash
60+echo $PATH
61+```
62+
63+This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.
64+
65+When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.
66+
67+So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.
68+
69+So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.
70+
71+**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.
72+
73+
74+<br/>
75+
76+## Uninstall
77+
78+The following commands should remove everything:
79+
80+```bash
81+# Remove the `elm` executable.
82+#
83+sudo rm /usr/local/bin/elm
84+
85+# Remove any cached files. The files here reduce compile times when
86+# starting new projects and make it possible to work offline in more
87+# cases. No need to keep it around if you are uninstalling though!
88+#
89+rm -r ~/.elm/
90+```
91+
92+If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.
93+
installers/mac/Distribution.xml+5−3
@@ -1,6 +1,6 @@
1<?xml version="1.0" encoding="utf-8" standalone="no"?>
1<?xml version="1.0" encoding="utf-8" standalone="no"?>
2<installer-script minSpecVersion="1.000000" authoringTool="com.apple.PackageMaker" authoringToolVersion="3.0.6" authoringToolBuild="201">
2<installer-script minSpecVersion="1.000000" authoringTool="com.apple.PackageMaker" authoringToolVersion="3.0.6" authoringToolBuild="201">
3− <title>Elm Platform</title>
3+ <title>Elm</title>
4 <options customize="allow" allow-external-scripts="no"/>
4 <options customize="allow" allow-external-scripts="no"/>
5 <domains enable_localSystem="true"/>
5 <domains enable_localSystem="true"/>
6 <volume-check script="pm_volume_check();"/>
6 <volume-check script="pm_volume_check();"/>
@@ -10,7 +10,7 @@
10function pm_volume_check() {
10function pm_volume_check() {
11 if(!(my.target.systemVersion &amp;&amp; /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {
11 if(!(my.target.systemVersion &amp;&amp; /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {
12 my.result.title = 'Failure';
12 my.result.title = 'Failure';
13− my.result.message = 'This version of Elm Platform requires Mac OS X 10.6 or later.';
13+ my.result.message = 'This version of Elm requires Mac OS X 10.6 or later.';
14 my.result.type = 'Fatal';
14 my.result.type = 'Fatal';
15 return false;
15 return false;
16 }
16 }
@@ -18,13 +18,15 @@ function pm_volume_check() {
18}
18}
19
19
20</script>
20</script>
21+ <!--
21 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>
22 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>
23+ -->
22 <welcome mime-type="text/rtf" file="welcome.rtf" />
24 <welcome mime-type="text/rtf" file="welcome.rtf" />
23 <conclusion mime-type="text/rtf" file="conclusion.rtf" />
25 <conclusion mime-type="text/rtf" file="conclusion.rtf" />
24 <choices-outline>
26 <choices-outline>
25 <line choice="choice2"/>
27 <line choice="choice2"/>
26 </choices-outline>
28 </choices-outline>
27− <choice id="choice2" title="Elm Platform ">
29+ <choice id="choice2" title="Elm">
28 <pkg-ref id="org.elm-lang.binaries.pkg"/>
30 <pkg-ref id="org.elm-lang.binaries.pkg"/>
29 </choice>
31 </choice>
30 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>
32 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>
installers/mac/README.mdnew file+93
@@ -0,0 +1,93 @@
1+# Install Instructions
2+
3+The easiest way to install is to to use [the Mac installer](https://github.com/elm/compiler/releases/download/0.19.1/installer-for-mac.pkg)!
4+
5+But it is also possible to install by running the following commands in your terminal:
6+
7+```bash
8+# Move to your Desktop so you can see what is going on easier.
9+#
10+cd ~/Desktop/
11+
12+# Download the 0.19.1 binary for Linux.
13+#
14+# +-----------+----------------------+
15+# | FLAG | MEANING |
16+# +-----------+----------------------+
17+# | -L | follow redirects |
18+# | -o elm.gz | name the file elm.gz |
19+# +-----------+----------------------+
20+#
21+curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-mac-64-bit.gz
22+
23+# There should now be a file named `elm.gz` on your Desktop.
24+#
25+# The downloaded file is compressed to make it faster to download.
26+# This next command decompresses it, replacing `elm.gz` with `elm`.
27+#
28+gunzip elm.gz
29+
30+# There should now be a file named `elm` on your Desktop!
31+#
32+# Every file has "permissions" about whether it can be read, written, or executed.
33+# So before we use this file, we need to mark this file as executable:
34+#
35+chmod +x elm
36+
37+# The `elm` file is now executable. That means running `~/Desktop/elm --help`
38+# should work. Saying `./elm --help` works the same.
39+#
40+# But we want to be able to say `elm --help` without specifying the full file
41+# path every time. We can do this by moving the `elm` binary to one of the
42+# directories listed in your `PATH` environment variable:
43+#
44+sudo mv elm /usr/local/bin/
45+
46+# Now it should be possible to run the `elm` binary just by saying its name!
47+#
48+elm --help
49+```
50+
51+<br/>
52+
53+## What is the `PATH` variable?
54+
55+When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.
56+
57+The `PATH` is the list of directories that get searched. You can see these directories by running:
58+
59+```bash
60+echo $PATH
61+```
62+
63+This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.
64+
65+When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.
66+
67+So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.
68+
69+So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.
70+
71+**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.
72+
73+
74+<br/>
75+
76+## Uninstall
77+
78+The following commands should remove everything:
79+
80+```bash
81+# Remove the `elm` executable.
82+#
83+sudo rm /usr/local/bin/elm
84+
85+# Remove any cached files. The files here reduce compile times when
86+# starting new projects and make it possible to work offline in more
87+# cases. No need to keep it around if you are uninstalling though!
88+#
89+rm -r ~/.elm/
90+```
91+
92+If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.
93+
installers/mac/Resources/en.lproj/background.pngdeleted

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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