4101a0b..master · elk · git.iko.soy

.github/CONTRIBUTING.md+18−20

@@ -4,10 +4,15 @@ Thanks helping with the development of Elm! This document describes the basic

44standards for opening pull requests and making the review process as smooth as

55possible.

66

7−## Licensing

87

9−You need to sign the [contributor agreement](ContributorAgreement.pdf)

10−and send it to <info@elm-lang.org> before opening your pull request.

8+## Expectations

9+

10+- Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.

11+- Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md).

12+- Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc.

13+

14+Finally, please be patient with the core team. They are trying their best with limited resources!

15+

1116

1217## Style Guide

1318

@@ -17,27 +22,20 @@ and send it to <info@elm-lang.org> before opening your pull request.

1722[haskell]: https://gist.github.com/evancz/0a1f3717c92fe71702be

1823[js]: https://google.github.io/styleguide/javascriptguide.xml

1924

20−## Branches

2125

22− * [The master branch][master] is the home of the next release of the compiler

23− so new features and improvements get merged there. Most pull requests

24− should target this branch!

26+## Branches

2527

26− * [The stable branch][stable] is for tagging releases and critical bug fixes.

27− This branch is handy for folks who want to build the most recent public

28− release from source.

28+[The master branch][master] is the home of the next release of the compiler

29+so new features and improvements get merged there. Most pull requests

30+should target this branch!

2931

3032[master]: http://github.com/elm-lang/elm/tree/master

31−[stable]: http://github.com/elm-lang/elm/tree/stable

3233

33−If you are working on a fairly large feature, we will probably want to merge it

34−in as its own branch and do some testing before bringing it into the master

35−branch. This way we can keep releases of the master branch independent of new

36−features.

3734

38−Note that the master branch of the compiler should always be in sync with the

39−master branch of the [website][], and the stable branch of the compiler should

40−always be in sync with the stable branch of the [website][]. Make sure that

41−your changes maintain this compatibility.

35+## Licensing

36+

37+Nothing extra to do for this. The default on GitHub described [here](https://docs.github.com/en/github/site-policy/github-terms-of-service#6-contributions-under-repository-license) is that:

38+

39+> Whenever you add Content to a repository containing notice of a license, you license that Content under the same terms, and you agree that you have the right to license that Content under those terms. If you have a separate agreement to license that Content under different terms, such as a contributor license agreement, that agreement will supersede.

40+

4241

43−[website]: https://github.com/elm-lang/elm-lang.org

.github/PULL_REQUEST_TEMPLATE.mdnew file+18

@@ -0,0 +1,18 @@

1+

2+**Quick Summary:** ???

3+

4+

5+## SSCCE

6+

7+```elm

8+

9+```

10+

11+- **Elm:** ???

12+- **Browser:** ???

13+- **Operating System:** ???

14+

15+

16+## Additional Details

17+

18+???

.github/workflows/set-issue-expectations.ymlnew file+21

@@ -0,0 +1,21 @@

1+name: Set Issue Expectations

2+on:

3+ issues:

4+ types: [opened]

5+jobs:

6+ comment-on-issue:

7+ name: Comment On Issue

8+ runs-on: ubuntu-latest

9+ steps:

10+ - uses: actions/github@v1.0.0

11+ env:

12+ GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}

13+ with:

14+ args: |

15+ comment "Thanks for reporting this! To set expectations:

16+

17+ - Issues are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.

18+ - Ask questions in a [community forum](https://elm-lang.org/community). You will get an answer quicker that way!

19+ - If you experience something similar, open a new issue. [We like duplicates](https://github.com/elm/expectations/blob/master/duplicates.md).

20+

21+ Finally, please be patient with the core team. They are trying their best with limited resources."

.github/workflows/set-pull-expectations.ymlnew file+19

@@ -0,0 +1,19 @@

1+on:

2+ pull_request_target:

3+ types: [opened]

4+

5+jobs:

6+ comment-on-pull:

7+ name: Comment On Pull

8+ runs-on: ubuntu-latest

9+ steps:

10+ - uses: actions/github-script@v3

11+ with:

12+ github-token: ${{secrets.GITHUB_TOKEN}}

13+ script: |

14+ github.issues.createComment({

15+ issue_number: context.issue.number,

16+ owner: context.repo.owner,

17+ repo: context.repo.repo,

18+ body: "Thanks for suggesting these code changes. To set expectations:\n\n- Pull requests are reviewed in [batches](https://github.com/elm/expectations/blob/master/batching.md), so it can take some time to get a response.\n- Smaller pull requests are easier to review. To fix nine typos, nine specific issues will always go faster than one big one. Learn why [here](https://github.com/elm/expectations/blob/master/small-pull-requests.md).\n- Reviewers may not know as much as you about certain situations, so add links to supporting evidence for important claims, especially regarding standards for CSS, HTTP, URI, etc.\n\nFinally, please be patient with the core team. They are trying their best with limited resources."

19+ })

.gitignore+1

@@ -5,3 +5,4 @@ cabal-dev

55cabal.sandbox.config

66.DS_Store

77*~

8+travis.log

.travis.ymlnew file+28

@@ -0,0 +1,28 @@

1+language: minimal

2+services: docker

3+

4+env:

5+ global:

6+ - LINUX_ARCHIVE=binary-for-linux-64-bit.gz

7+

8+before_install:

9+ - docker build -t elm -f installers/linux/Dockerfile .

10+ - docker cp $(docker create elm):/usr/local/bin/elm .

11+ - gzip -9 -c elm > $LINUX_ARCHIVE

12+

13+deploy:

14+ provider: releases

15+ api_key:

16+ secure: Yz2Lo4u9rZQ7Ee7ohAsrZpkqsYDUerCSMdSQIH8ryrf7phHhiloPEkTKsM+NupHqU/LEAVsunxbau4QrCEjA2vPavAPVk8cKomRUWK/YjbXHKa24hPkal2c+A2bnMQ6w3qYk/PjL9rW+Goq++/SNLcYZwHBV0Chl2blivMwWCSA=

17+ file: $LINUX_ARCHIVE

18+ skip_cleanup: true

19+ on:

20+ branch: master

21+ tags: true

22+

23+notifications:

24+ email:

25+ recipients:

26+ - rlefevre@dmy.fr

27+ on_success: change

28+ on_failure: change

ContributorAgreement.pdfdeleted

Binary file not shown.

LICENSE+6−25

@@ -1,30 +1,11 @@

22

3+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

44

5−Redistribution and use in source and binary forms, with or without

6−modification, are permitted provided that the following conditions are met:

5+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

76

8− * Redistributions of source code must retain the above copyright

9− notice, this list of conditions and the following disclaimer.

7+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

108

11− * Redistributions in binary form must reproduce the above

12− copyright notice, this list of conditions and the following

13− disclaimer in the documentation and/or other materials provided

14− with the distribution.

9+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

1510

16− * Neither the name of Evan Czaplicki nor the names of other

17− contributors may be used to endorse or promote products derived

18− from this software without specific prior written permission.

19−

20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

11+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md+10−5

@@ -1,17 +1,22 @@

1−# The Elm Compiler

1+# Elm

22

3−Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/).

3+A delightful language for reliable webapps.

44

5+Check out the [Home Page](http://elm-lang.org/), [Try Online](http://elm-lang.org/try), or [The Official Guide](http://guide.elm-lang.org/)

6+

7+

8+<br>

59

610## Install

711

8−Follow [these instructions][installer]!

12+✨ [Install](https://guide.elm-lang.org/install/elm.html) ✨

913

10− [installer]: https://guide.elm-lang.org/install.html

14+For multiple versions, previous versions, and uninstallation, see the instructions [here](https://github.com/elm/compiler/blob/master/installers/README.md).

1115

16+<br>

1217

1318## Help

1419

1520If you are stuck, ask around on [the Elm slack channel][slack]. Folks are friendly and happy to help with questions!

1621

17−[slack]: http://elmlang.herokuapp.com/

22+[slack]: http://elmlang.herokuapp.com/

builder/src/BackgroundWriter.hsnew file+42

@@ -0,0 +1,42 @@

1+{-# LANGUAGE BangPatterns #-}

2+module BackgroundWriter

3+ ( Scope

4+ , withScope

5+ , writeBinary

6+ )

7+ where

8+

9+

10+import Control.Concurrent (forkIO)

11+import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)

12+import qualified Data.Binary as Binary

13+import Data.Foldable (traverse_)

14+

15+import qualified File

16+

17+

18+

19+-- BACKGROUND WRITER

20+

21+

22+newtype Scope =

23+ Scope (MVar [MVar ()])

24+

25+

26+withScope :: (Scope -> IO a) -> IO a

27+withScope callback =

28+ do workList <- newMVar []

29+ result <- callback (Scope workList)

30+ mvars <- takeMVar workList

31+ traverse_ takeMVar mvars

32+ return result

33+

34+

35+writeBinary :: (Binary.Binary a) => Scope -> FilePath -> a -> IO ()

36+writeBinary (Scope workList) path value =

37+ do mvar <- newEmptyMVar

38+ _ <- forkIO (File.writeBinary path value >> putMVar mvar ())

39+ oldWork <- takeMVar workList

40+ let !newWork = mvar:oldWork

41+ putMVar workList newWork

42+

builder/src/Build.hs+427−254

@@ -2,12 +2,15 @@

22{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings #-}

33module Build

44 ( fromExposed

5− , fromMains

5+ , fromPaths

6+ , fromRepl

67 , Artifacts(..)

7− , Main(..)

8+ , Root(..)

89 , Module(..)

910 , CachedInterface(..)

11+ , ReplArtifacts(..)

1012 , DocsGoal(..)

13+ , getRootNames

1114 )

1215 where

1316

@@ -17,7 +20,6 @@ import Control.Concurrent.MVar

1720import Control.Monad (filterM, mapM_, sequence_)

1821import qualified Data.ByteString as B

1922import qualified Data.Char as Char

20−import qualified Data.Either as Either

2123import qualified Data.Graph as Graph

2224import qualified Data.List as List

2325import qualified Data.Map.Utils as Map

@@ -48,9 +50,11 @@ import qualified Parse.Module as Parse

4850import qualified Reporting

4951import qualified Reporting.Annotation as A

5052import qualified Reporting.Error as Error

53+import qualified Reporting.Error.Docs as EDocs

5154import qualified Reporting.Error.Syntax as Syntax

5255import qualified Reporting.Error.Import as Import

5356import qualified Reporting.Exit as Exit

57+import qualified Reporting.Render.Type.Localizer as L

5458import qualified Stuff

5559

5660

@@ -62,27 +66,57 @@ data Env =

6266 Env

6367 { _key :: Reporting.BKey

6468 , _root :: FilePath

65− , _pkg :: Pkg.Name

66− , _srcDirs :: [FilePath]

69+ , _project :: Parse.ProjectType

70+ , _srcDirs :: [AbsoluteSrcDir]

71+ , _buildID :: Details.BuildID

6772 , _locals :: Map.Map ModuleName.Raw Details.Local

6873 , _foreigns :: Map.Map ModuleName.Raw Details.Foreign

6974 }

7075

7176

72−makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> Env

73−makeEnv key root (Details.Details _ validOutline locals foreigns _) =

77+makeEnv :: Reporting.BKey -> FilePath -> Details.Details -> IO Env

78+makeEnv key root (Details.Details _ validOutline buildID locals foreigns _) =

7479 case validOutline of

75− Details.ValidApp srcDirs ->

76− Env key root Pkg.dummyName (NE.toList srcDirs) locals foreigns

80+ Details.ValidApp givenSrcDirs ->

81+ do srcDirs <- traverse (toAbsoluteSrcDir root) (NE.toList givenSrcDirs)

82+ return $ Env key root Parse.Application srcDirs buildID locals foreigns

7783

78− Details.ValidPkg pkg _ ->

79− Env key root pkg ["src"] locals foreigns

84+ Details.ValidPkg pkg _ _ ->

85+ do srcDir <- toAbsoluteSrcDir root (Outline.RelativeSrcDir "src")

86+ return $ Env key root (Parse.Package pkg) [srcDir] buildID locals foreigns

87+

88+

89+

90+-- SOURCE DIRECTORY

91+

92+

93+newtype AbsoluteSrcDir =

94+ AbsoluteSrcDir FilePath

95+

96+

97+toAbsoluteSrcDir :: FilePath -> Outline.SrcDir -> IO AbsoluteSrcDir

98+toAbsoluteSrcDir root srcDir =

99+ AbsoluteSrcDir <$> Dir.canonicalizePath

100+ (

101+ case srcDir of

102+ Outline.AbsoluteSrcDir dir -> dir

103+ Outline.RelativeSrcDir dir -> root </> dir

104+ )

105+

106+

107+addRelative :: AbsoluteSrcDir -> FilePath -> FilePath

108+addRelative (AbsoluteSrcDir srcDir) path =

109+ srcDir </> path

80110

81111

82112

83113-- FORK

84114

85115

116+-- PERF try using IORef semephore on file crawl phase?

117+-- described in Chapter 13 of Parallel and Concurrent Programming in Haskell by Simon Marlow

118+-- https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/ch13.html#sec_conc-par-overhead

119+--

86120fork :: IO a -> IO (MVar a)

87121fork work =

88122 do mvar <- newEmptyMVar

@@ -103,7 +137,7 @@ forkWithKey func dict =

103137fromExposed :: Reporting.Style -> FilePath -> Details.Details -> DocsGoal docs -> NE.List ModuleName.Raw -> IO (Either Exit.BuildProblem docs)

104138fromExposed style root details docsGoal exposed@(NE.List e es) =

105139 Reporting.trackBuild style $ \key ->

106− do let env = makeEnv key root details

140+ do env <- makeEnv key root details

107141 dmvar <- Details.loadInterfaces root details

108142

109143 -- crawl

@@ -115,7 +149,7 @@ fromExposed style root details docsGoal exposed@(NE.List e es) =

115149 statuses <- traverse readMVar =<< readMVar mvar

116150

117151 -- compile

118− midpoint <- checkExposedMidpoint dmvar statuses

152+ midpoint <- checkMidpoint dmvar statuses

119153 case midpoint of

120154 Left problem ->

121155 return (Left (Exit.BuildProjectProblem problem))

@@ -126,18 +160,18 @@ fromExposed style root details docsGoal exposed@(NE.List e es) =

126160 putMVar rmvar resultMVars

127161 results <- traverse readMVar resultMVars

128162 writeDetails root details results

129− finalizeExposed docsGoal exposed results

163+ finalizeExposed root docsGoal exposed results

130164

131165

132166

133−-- FROM MAINS

167+-- FROM PATHS

134168

135169

136170data Artifacts =

137171 Artifacts

138172 { _name :: Pkg.Name

139173 , _deps :: Dependencies

140− , _mains :: NE.List Main

174+ , _roots :: NE.List Root

141175 , _modules :: [Module]

142176 }

143177

@@ -151,25 +185,25 @@ type Dependencies =

151185 Map.Map ModuleName.Canonical I.DependencyInterface

152186

153187

154−fromMains :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)

155−fromMains style root details paths =

188+fromPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> IO (Either Exit.BuildProblem Artifacts)

189+fromPaths style root details paths =

156190 Reporting.trackBuild style $ \key ->

157− do let env = makeEnv key root details

191+ do env <- makeEnv key root details

158192

159− elmains <- findMains env paths

160− case elmains of

193+ elroots <- findRoots env paths

194+ case elroots of

161195 Left problem ->

162196 return (Left (Exit.BuildProjectProblem problem))

163197

164− Right lmains ->

198+ Right lroots ->

165199 do -- crawl

166200 dmvar <- Details.loadInterfaces root details

167201 smvar <- newMVar Map.empty

168− smainMVars <- traverse (fork . crawlMain env smvar) lmains

169− smains <- traverse readMVar smainMVars

202+ srootMVars <- traverse (fork . crawlRoot env smvar) lroots

203+ sroots <- traverse readMVar srootMVars

170204 statuses <- traverse readMVar =<< readMVar smvar

171205

172− midpoint <- checkMainsMidpoint dmvar statuses smains

206+ midpoint <- checkMidpointAndRoots dmvar statuses sroots

173207 case midpoint of

174208 Left problem ->

175209 return (Left (Exit.BuildProjectProblem problem))

@@ -179,10 +213,26 @@ fromMains style root details paths =

179213 rmvar <- newEmptyMVar

180214 resultsMVars <- forkWithKey (checkModule env foreigns rmvar) statuses

181215 putMVar rmvar resultsMVars

182− rmainMVars <- traverse (fork . checkMain env resultsMVars) smains

216+ rrootMVars <- traverse (fork . checkRoot env resultsMVars) sroots

183217 results <- traverse readMVar resultsMVars

184218 writeDetails root details results

185− toArtifacts env foreigns results <$> traverse readMVar rmainMVars

219+ toArtifacts env foreigns results <$> traverse readMVar rrootMVars

220+

221+

222+

223+-- GET ROOT NAMES

224+

225+

226+getRootNames :: Artifacts -> NE.List ModuleName.Raw

227+getRootNames (Artifacts _ _ roots _) =

228+ fmap getRootName roots

229+

230+

231+getRootName :: Root -> ModuleName.Raw

232+getRootName root =

233+ case root of

234+ Inside name -> name

235+ Outside name _ _ -> name

186236

187237

188238

@@ -216,11 +266,10 @@ crawlDeps env mvar deps blockedValue =

216266

217267

218268crawlModule :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> IO Status

219−crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar docsNeed name =

269+crawlModule env@(Env _ root projectType srcDirs buildID locals foreigns) mvar docsNeed name =

220270 do let fileName = ModuleName.toFilePath name <.> "elm"

221− let inRoot path = File.exists (root </> path)

222271

223− paths <- filterM inRoot (map (</> fileName) srcDirs)

272+ paths <- filterM File.exists (map (`addRelative` fileName) srcDirs)

224273

225274 case paths of

226275 [path] ->

@@ -229,21 +278,18 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar docsNeed name =

229278 return $ SBadImport $ Import.Ambiguous path [] dep deps

230279

231280 Nothing ->

232− case Map.lookup name locals of

233− Nothing ->

234− crawlFile env mvar docsNeed name path

281+ do newTime <- File.getTime path

282+ case Map.lookup name locals of

283+ Nothing ->

284+ crawlFile env mvar docsNeed name path newTime buildID

235285

236− Just local@(Details.Local oldPath oldTime deps _) ->

237− if path /= oldPath

238− then crawlFile env mvar docsNeed name path

239− else

240− do newTime <- File.getTime path

241− if oldTime < newTime || needsDocs docsNeed

242− then crawlFile env mvar docsNeed name path

243− else crawlDeps env mvar deps (SCached local)

286+ Just local@(Details.Local oldPath oldTime deps _ lastChange _) ->

287+ if path /= oldPath || oldTime /= newTime || needsDocs docsNeed

288+ then crawlFile env mvar docsNeed name path newTime lastChange

289+ else crawlDeps env mvar deps (SCached local)

244290

245291 p1:p2:ps ->

246− 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)

247293

248294 [] ->

249295 case Map.lookup name foreigns of

@@ -256,19 +302,18 @@ crawlModule env@(Env _ root pkg srcDirs locals foreigns) mvar docsNeed name =

256302 return $ SBadImport $ Import.AmbiguousForeign dep d ds

257303

258304 Nothing ->

259− if Name.isKernel name && Pkg.isKernel pkg then

305+ if Name.isKernel name && Parse.isKernel projectType then

260306 do exists <- File.exists ("src" </> ModuleName.toFilePath name <.> "js")

261307 return $ if exists then SKernel else SBadImport Import.NotFound

262308 else

263309 return $ SBadImport Import.NotFound

264310

265311

266−crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> IO Status

267−crawlFile env@(Env _ root pkg _ _ _) mvar docsNeed expectedName path =

268− do time <- File.getTime path

269− source <- File.readUtf8 (root </> path)

312+crawlFile :: Env -> MVar StatusDict -> DocsNeed -> ModuleName.Raw -> FilePath -> File.Time -> Details.BuildID -> IO Status

313+crawlFile env@(Env _ root projectType _ buildID _ _) mvar docsNeed expectedName path time lastChange =

314+ do source <- File.readUtf8 (root </> path)

270315

271− case Parse.fromByteString pkg source of

316+ case Parse.fromByteString projectType source of

272317 Left err ->

273318 return $ SBadSyntax path time source err

274319

@@ -281,7 +326,7 @@ crawlFile env@(Env _ root pkg _ _ _) mvar docsNeed expectedName path =

281326 if expectedName == actualName then

282327 let

283328 deps = map Src.getImportName imports

284− local = Details.Local path time deps (any isMain values)

329+ local = Details.Local path time deps (any isMain values) lastChange buildID

285330 in

286331 crawlDeps env mvar deps (SChanged local source modul docsNeed)

287332 else

@@ -304,7 +349,7 @@ type ResultDict =

304349data Result

305350 = RNew !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)

306351 | RSame !Details.Local !I.Interface !Opt.LocalGraph !(Maybe Docs.Module)

307− | RCached Bool (MVar CachedInterface)

352+ | RCached Bool Details.BuildID (MVar CachedInterface)

308353 | RNotFound Import.Problem

309354 | RProblem Error.Module

310355 | RBlocked

@@ -319,15 +364,15 @@ data CachedInterface

319364

320365

321366checkModule :: Env -> Dependencies -> MVar ResultDict -> ModuleName.Raw -> Status -> IO Result

322−checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =

367+checkModule env@(Env _ root projectType _ _ _ _) foreigns resultsMVar name status =

323368 case status of

324− SCached local@(Details.Local path time deps hasMain) ->

369+ SCached local@(Details.Local path time deps hasMain lastChange lastCompile) ->

325370 do results <- readMVar resultsMVar

326− depsStatus <- checkDeps root results deps

371+ depsStatus <- checkDeps root results deps lastCompile

327372 case depsStatus of

328373 DepsChange ifaces ->

329374 do source <- File.readUtf8 path

330− case Parse.fromByteString pkg source of

375+ case Parse.fromByteString projectType source of

331376 Right modul -> compile env (DocsNeed False) local source ifaces modul

332377 Left err ->

333378 return $ RProblem $

@@ -335,7 +380,7 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =

335380

336381 DepsSame _ _ ->

337382 do mvar <- newMVar Unneeded

338− return (RCached hasMain mvar)

383+ return (RCached hasMain lastChange mvar)

339384

340385 DepsBlock ->

341386 return RBlocked

@@ -343,29 +388,25 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =

343388 DepsNotFound problems ->

344389 do source <- File.readUtf8 path

345390 return $ RProblem $ Error.Module name path time source $

346− case Parse.fromByteString pkg source of

391+ case Parse.fromByteString projectType source of

347392 Right (Src.Module _ _ _ imports _ _ _ _ _) ->

348393 Error.BadImports (toImportErrors env results imports problems)

349394

350395 Left err ->

351396 Error.BadSyntax err

352397

353− 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 ->

354399 do results <- readMVar resultsMVar

355− depsStatus <- checkDeps root results deps

400+ depsStatus <- checkDeps root results deps lastCompile

356401 case depsStatus of

357402 DepsChange ifaces ->

358403 compile env docsNeed local source ifaces modul

359404

360405 DepsSame same cached ->

361− do maybeLoaded <- checkCachedInterfaces root cached

406+ do maybeLoaded <- loadInterfaces root same cached

362407 case maybeLoaded of

363− Nothing ->

364− return RBlocked

365−

366− Just loaded ->

367− do let ifaces = Map.union loaded (Map.fromList same)

368− compile env docsNeed local source ifaces modul

408+ Nothing -> return RBlocked

409+ Just ifaces -> compile env docsNeed local source ifaces modul

369410

370411 DepsBlock ->

371412 return RBlocked

@@ -384,7 +425,7 @@ checkModule env@(Env _ root pkg _ _ _) foreigns resultsMVar name status =

384425 SForeign home ->

385426 case foreigns ! ModuleName.Canonical home name of

386427 I.Public iface -> return (RForeign iface)

387− I.Private _ _ _ -> error "loading private interface in Build"

428+ I.Private _ _ _ -> error $ "mistakenly seeing private interface for " ++ Pkg.toChars home ++ " " ++ ModuleName.toChars name

388429

389430 SKernel ->

390431 return RKernel

@@ -401,32 +442,48 @@ data DepsStatus

401442 | DepsNotFound (NE.List (ModuleName.Raw, Import.Problem))

402443

403444

404−checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> IO DepsStatus

405−checkDeps root results deps =

406− checkDepsHelp root results deps [] [] [] [] False

445+checkDeps :: FilePath -> ResultDict -> [ModuleName.Raw] -> Details.BuildID -> IO DepsStatus

446+checkDeps root results deps lastCompile =

447+ checkDepsHelp root results deps [] [] [] [] False 0 lastCompile

407448

408449

409450type Dep = (ModuleName.Raw, I.Interface)

410451type CDep = (ModuleName.Raw, MVar CachedInterface)

411452

412453

413−checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> IO DepsStatus

414−checkDepsHelp root results deps new same cached importProblems isBlocked =

454+checkDepsHelp :: FilePath -> ResultDict -> [ModuleName.Raw] -> [Dep] -> [Dep] -> [CDep] -> [(ModuleName.Raw,Import.Problem)] -> Bool -> Details.BuildID -> Details.BuildID -> IO DepsStatus

455+checkDepsHelp root results deps new same cached importProblems isBlocked lastDepChange lastCompile =

415456 case deps of

416457 dep:otherDeps ->

417458 do result <- readMVar (results ! dep)

418459 case result of

419− RNew _ iface _ _ -> checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked

420− RSame _ iface _ _ -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked

421− RCached _ mvar -> checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked

422− RNotFound prob -> checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True

423− RProblem _ -> checkDepsHelp root results otherDeps new same cached importProblems True

424− RBlocked -> checkDepsHelp root results otherDeps new same cached importProblems True

425− RForeign iface -> checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked

426− RKernel -> checkDepsHelp root results otherDeps new same cached importProblems isBlocked

460+ RNew (Details.Local _ _ _ _ lastChange _) iface _ _ ->

461+ checkDepsHelp root results otherDeps ((dep,iface) : new) same cached importProblems isBlocked (max lastChange lastDepChange) lastCompile

462+

463+ RSame (Details.Local _ _ _ _ lastChange _) iface _ _ ->

464+ checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked (max lastChange lastDepChange) lastCompile

465+

466+ RCached _ lastChange mvar ->

467+ checkDepsHelp root results otherDeps new same ((dep,mvar) : cached) importProblems isBlocked (max lastChange lastDepChange) lastCompile

468+

469+ RNotFound prob ->

470+ checkDepsHelp root results otherDeps new same cached ((dep,prob) : importProblems) True lastDepChange lastCompile

471+

472+ RProblem _ ->

473+ checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile

474+

475+ RBlocked ->

476+ checkDepsHelp root results otherDeps new same cached importProblems True lastDepChange lastCompile

477+

478+ RForeign iface ->

479+ checkDepsHelp root results otherDeps new ((dep,iface) : same) cached importProblems isBlocked lastDepChange lastCompile

480+

481+ RKernel ->

482+ checkDepsHelp root results otherDeps new same cached importProblems isBlocked lastDepChange lastCompile

483+

427484

428485 [] ->

429− case importProblems of

486+ case reverse importProblems of

430487 p:ps ->

431488 return $ DepsNotFound (NE.List p ps)

432489

@@ -434,18 +491,14 @@ checkDepsHelp root results deps new same cached importProblems isBlocked =

434491 if isBlocked then

435492 return $ DepsBlock

436493

437− else if null new then

494+ else if null new && lastDepChange <= lastCompile then

438495 return $ DepsSame same cached

439496

440497 else

441− do maybeLoaded <- checkCachedInterfaces root cached

498+ do maybeLoaded <- loadInterfaces root same cached

442499 case maybeLoaded of

443− Nothing ->

444− return DepsBlock

445−

446− Just loaded ->

447− return $ DepsChange $

448− Map.union loaded (Map.union (Map.fromList new) (Map.fromList same))

500+ Nothing -> return DepsBlock

501+ Just ifaces -> return $ DepsChange $ Map.union (Map.fromList new) ifaces

449502

450503

451504

@@ -453,7 +506,7 @@ checkDepsHelp root results deps new same cached importProblems isBlocked =

453506

454507

455508toImportErrors :: Env -> ResultDict -> [Src.Import] -> NE.List (ModuleName.Raw, Import.Problem) -> NE.List Import.Error

456−toImportErrors (Env _ _ _ _ locals foreigns) results imports problems =

509+toImportErrors (Env _ _ _ _ _ locals foreigns) results imports problems =

457510 let

458511 knownModules =

459512 Set.unions

@@ -475,18 +528,23 @@ toImportErrors (Env _ _ _ _ locals foreigns) results imports problems =

475528

476529

477530

478−-- CACHED INTERFACE

531+-- LOAD CACHED INTERFACES

479532

480533

481−checkCachedInterfaces :: FilePath -> [(ModuleName.Raw, MVar CachedInterface)] -> IO (Maybe (Map.Map ModuleName.Raw I.Interface))

482−checkCachedInterfaces root deps =

483− do loading <- traverse (fork . checkCache root) deps

484− loaded <- traverse readMVar loading

485− return $ Map.fromList <$> sequence loaded

534+loadInterfaces :: FilePath -> [Dep] -> [CDep] -> IO (Maybe (Map.Map ModuleName.Raw I.Interface))

535+loadInterfaces root same cached =

536+ do loading <- traverse (fork . loadInterface root) cached

537+ maybeLoaded <- traverse readMVar loading

538+ case sequence maybeLoaded of

539+ Nothing ->

540+ return Nothing

541+

542+ Just loaded ->

543+ return $ Just $ Map.union (Map.fromList loaded) (Map.fromList same)

486544

487545

488−checkCache :: FilePath -> (ModuleName.Raw, MVar CachedInterface) -> IO (Maybe Dep)

489−checkCache root (name, ciMvar) =

546+loadInterface :: FilePath -> CDep -> IO (Maybe Dep)

547+loadInterface root (name, ciMvar) =

490548 do cachedInterface <- takeMVar ciMvar

491549 case cachedInterface of

492550 Corrupted ->

@@ -513,8 +571,8 @@ checkCache root (name, ciMvar) =

513571-- CHECK PROJECT

514572

515573

516−checkExposedMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> IO (Either Exit.BuildProjectProblem Dependencies)

517−checkExposedMidpoint dmvar statuses =

574+checkMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> IO (Either Exit.BuildProjectProblem Dependencies)

575+checkMidpoint dmvar statuses =

518576 case checkForCycles statuses of

519577 Nothing ->

520578 do maybeForeigns <- readMVar dmvar

@@ -527,11 +585,11 @@ checkExposedMidpoint dmvar statuses =

527585 return (Left (Exit.BP_Cycle name names))

528586

529587

530−checkMainsMidpoint :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List MainStatus -> IO (Either Exit.BuildProjectProblem Dependencies)

531−checkMainsMidpoint dmvar statuses smains =

588+checkMidpointAndRoots :: MVar (Maybe Dependencies) -> Map.Map ModuleName.Raw Status -> NE.List RootStatus -> IO (Either Exit.BuildProjectProblem Dependencies)

589+checkMidpointAndRoots dmvar statuses sroots =

532590 case checkForCycles statuses of

533591 Nothing ->

534− case checkUniqueMains statuses smains of

592+ case checkUniqueRoots statuses sroots of

535593 Nothing ->

536594 do maybeForeigns <- readMVar dmvar

537595 case maybeForeigns of

@@ -582,25 +640,25 @@ addToGraph name status graph =

582640 let

583641 dependencies =

584642 case status of

585− SCached (Details.Local _ _ deps _) -> deps

586− SChanged (Details.Local _ _ deps _) _ _ _ -> deps

587− SBadImport _ -> []

588− SBadSyntax _ _ _ _ -> []

589− SForeign _ -> []

590− SKernel -> []

643+ SCached (Details.Local _ _ deps _ _ _) -> deps

644+ SChanged (Details.Local _ _ deps _ _ _) _ _ _ -> deps

645+ SBadImport _ -> []

646+ SBadSyntax _ _ _ _ -> []

647+ SForeign _ -> []

648+ SKernel -> []

591649 in

592650 (name, name, dependencies) : graph

593651

594652

595653

596−-- CHECK UNIQUE MAINS

654+-- CHECK UNIQUE ROOTS

597655

598656

599−checkUniqueMains :: Map.Map ModuleName.Raw Status -> NE.List MainStatus -> Maybe Exit.BuildProjectProblem

600−checkUniqueMains insides smains =

657+checkUniqueRoots :: Map.Map ModuleName.Raw Status -> NE.List RootStatus -> Maybe Exit.BuildProjectProblem

658+checkUniqueRoots insides sroots =

601659 let

602660 outsidesDict =

603− Map.fromListWith OneOrMore.more (Maybe.mapMaybe mainStatusToNamePathPair (NE.toList smains))

661+ Map.fromListWith OneOrMore.more (Maybe.mapMaybe rootStatusToNamePathPair (NE.toList sroots))

604662 in

605663 case Map.traverseWithKey checkOutside outsidesDict of

606664 Left problem ->

@@ -612,30 +670,30 @@ checkUniqueMains insides smains =

612670 Left problem -> Just problem

613671

614672

615−mainStatusToNamePathPair :: MainStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)

616−mainStatusToNamePathPair smain =

617− case smain of

618− SInside _ -> Nothing

619− SOutsideOk (Details.Local path _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)

620− SOutsideErr _ -> Nothing

673+rootStatusToNamePathPair :: RootStatus -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore FilePath)

674+rootStatusToNamePathPair sroot =

675+ case sroot of

676+ SInside _ -> Nothing

677+ SOutsideOk (Details.Local path _ _ _ _ _) _ modul -> Just (Src.getName modul, OneOrMore.one path)

678+ SOutsideErr _ -> Nothing

621679

622680

623681checkOutside :: ModuleName.Raw -> OneOrMore.OneOrMore FilePath -> Either Exit.BuildProjectProblem FilePath

624682checkOutside name paths =

625683 case OneOrMore.destruct NE.List paths of

626684 NE.List p [] -> Right p

627− NE.List p1 (p2:_) -> Left (Exit.BP_MainNameDuplicate name p1 p2)

685+ NE.List p1 (p2:_) -> Left (Exit.BP_RootNameDuplicate name p1 p2)

628686

629687

630688checkInside :: ModuleName.Raw -> FilePath -> Status -> Either Exit.BuildProjectProblem ()

631689checkInside name p1 status =

632690 case status of

633− SCached (Details.Local p2 _ _ _) -> Left (Exit.BP_MainNameDuplicate name p1 p2)

634− SChanged (Details.Local p2 _ _ _) _ _ _ -> Left (Exit.BP_MainNameDuplicate name p1 p2)

635− SBadImport _ -> Right ()

636− SBadSyntax _ _ _ _ -> Right ()

637− SForeign _ -> Right ()

638− SKernel -> Right ()

691+ SCached (Details.Local p2 _ _ _ _ _) -> Left (Exit.BP_RootNameDuplicate name p1 p2)

692+ SChanged (Details.Local p2 _ _ _ _ _) _ _ _ -> Left (Exit.BP_RootNameDuplicate name p1 p2)

693+ SBadImport _ -> Right ()

694+ SBadSyntax _ _ _ _ -> Right ()

695+ SForeign _ -> Right ()

696+ SKernel -> Right ()

639697

640698

641699

@@ -643,31 +701,47 @@ checkInside name p1 status =

643701

644702

645703compile :: Env -> DocsNeed -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO Result

646−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

647708 case Compile.compile pkg ifaces modul of

648709 Right (Compile.Artifacts canonical annotations objects) ->

649− do let name = Src.getName modul

650− let iface = I.fromModule pkg canonical annotations

651− let docs = makeDocs docsNeed canonical

652− File.writeBinary (Stuff.elmo root name) objects

653− maybeOldi <- File.readBinary (Stuff.elmi root name)

654− case maybeOldi of

655− Just oldi | oldi == iface ->

656− do -- iface should be fully forced by equality check

657− Reporting.report key Reporting.BDone

658− return (RSame local iface objects docs)

659−

660− _ ->

661− do -- iface may be lazy still

662− -- TODO try adding forkIO here

663− File.writeBinary (Stuff.elmi root name) iface

664− Reporting.report key Reporting.BDone

665− return (RNew local iface objects docs)

710+ case makeDocs docsNeed canonical of

711+ Left err ->

712+ return $ RProblem $

713+ Error.Module (Src.getName modul) path time source (Error.BadDocs err)

714+

715+ Right docs ->

716+ do let name = Src.getName modul

717+ let iface = I.fromModule pkg canonical annotations

718+ let elmi = Stuff.elmi root name

719+ File.writeBinary (Stuff.elmo root name) objects

720+ maybeOldi <- File.readBinary elmi

721+ case maybeOldi of

722+ Just oldi | oldi == iface ->

723+ do -- iface should be fully forced by equality check

724+ Reporting.report key Reporting.BDone

725+ let local = Details.Local path time deps main lastChange buildID

726+ return (RSame local iface objects docs)

727+

728+ _ ->

729+ do -- iface may be lazy still

730+ File.writeBinary elmi iface

731+ Reporting.report key Reporting.BDone

732+ let local = Details.Local path time deps main buildID buildID

733+ return (RNew local iface objects docs)

666734

667735 Left err ->

668− do Reporting.report key Reporting.BDone

669− return $ RProblem $

670− Error.Module (Src.getName modul) path time source err

736+ return $ RProblem $

737+ Error.Module (Src.getName modul) path time source err

738+

739+

740+projectTypeToPkg :: Parse.ProjectType -> Pkg.Name

741+projectTypeToPkg projectType =

742+ case projectType of

743+ Parse.Package pkg -> pkg

744+ Parse.Application -> Pkg.dummyName

671745

672746

673747

@@ -675,9 +749,9 @@ compile (Env key root pkg _ _ _) docsNeed local@(Details.Local path time _ _) so

675749

676750

677751writeDetails :: FilePath -> Details.Details -> Map.Map ModuleName.Raw Result -> IO ()

678−writeDetails root (Details.Details time outline locals foreigns extras) results =

752+writeDetails root (Details.Details time outline buildID locals foreigns extras) results =

679753 File.writeBinary (Stuff.details root) $

680− Details.Details time outline (Map.foldrWithKey addNewLocal locals results) foreigns extras

754+ Details.Details time outline buildID (Map.foldrWithKey addNewLocal locals results) foreigns extras

681755

682756

683757addNewLocal :: ModuleName.Raw -> Result -> Map.Map ModuleName.Raw Details.Local -> Map.Map ModuleName.Raw Details.Local

@@ -685,7 +759,7 @@ addNewLocal name result locals =

685759 case result of

686760 RNew local _ _ _ -> Map.insert name local locals

687761 RSame local _ _ _ -> Map.insert name local locals

688− RCached _ _ -> locals

762+ RCached _ _ _ -> locals

689763 RNotFound _ -> locals

690764 RProblem _ -> locals

691765 RBlocked -> locals

@@ -697,8 +771,8 @@ addNewLocal name result locals =

697771-- FINALIZE EXPOSED

698772

699773

700−finalizeExposed :: DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)

701−finalizeExposed docsGoal exposed results =

774+finalizeExposed :: FilePath -> DocsGoal docs -> NE.List ModuleName.Raw -> Map.Map ModuleName.Raw Result -> IO (Either Exit.BuildProblem docs)

775+finalizeExposed root docsGoal exposed results =

702776 case foldr (addImportProblems results) [] (NE.toList exposed) of

703777 p:ps ->

704778 return $ Left $ Exit.BuildProjectProblem (Exit.BP_MissingExposed (NE.List p ps))

@@ -706,7 +780,7 @@ finalizeExposed docsGoal exposed results =

706780 [] ->

707781 case Map.foldr addErrors [] results of

708782 [] -> Right <$> finalizeDocs docsGoal results

709− e:es -> return $ Left $ Exit.BuildModuleProblems e es

783+ e:es -> return $ Left $ Exit.BuildBadModules root e es

710784

711785

712786addErrors :: Result -> [Error.Module] -> [Error.Module]

@@ -714,7 +788,7 @@ addErrors result errors =

714788 case result of

715789 RNew _ _ _ _ -> errors

716790 RSame _ _ _ _ -> errors

717− RCached _ _ -> errors

791+ RCached _ _ _ -> errors

718792 RNotFound _ -> errors

719793 RProblem e -> e:errors

720794 RBlocked -> errors

@@ -727,7 +801,7 @@ addImportProblems results name problems =

727801 case results ! name of

728802 RNew _ _ _ _ -> problems

729803 RSame _ _ _ _ -> problems

730− RCached _ _ -> problems

804+ RCached _ _ _ -> problems

731805 RNotFound p -> (name, p) : problems

732806 RProblem _ -> problems

733807 RBlocked -> problems

@@ -757,14 +831,14 @@ toDocsNeed goal =

757831 KeepDocs -> DocsNeed True

758832

759833

760−makeDocs :: DocsNeed -> Can.Module -> Maybe Docs.Module

834+makeDocs :: DocsNeed -> Can.Module -> Either EDocs.Error (Maybe Docs.Module)

761835makeDocs (DocsNeed isNeeded) modul =

762836 if isNeeded then

763837 case Docs.fromModule modul of

764− Right docs -> Just docs

765− Left _ -> Nothing

838+ Right docs -> Right (Just docs)

839+ Left err -> Left err

766840 else

767− Nothing

841+ Right Nothing

768842

769843

770844finalizeDocs :: DocsGoal docs -> Map.Map ModuleName.Raw Result -> IO docs

@@ -785,7 +859,7 @@ toDocs result =

785859 case result of

786860 RNew _ _ _ d -> d

787861 RSame _ _ _ d -> d

788− RCached _ _ -> Nothing

862+ RCached _ _ _ -> Nothing

789863 RNotFound _ -> Nothing

790864 RProblem _ -> Nothing

791865 RBlocked -> Nothing

@@ -794,6 +868,94 @@ toDocs result =

794868

795869

796870

871+--------------------------------------------------------------------------------

872+------ NOW FOR SOME REPL STUFF -------------------------------------------------

873+--------------------------------------------------------------------------------

874+

875+

876+-- FROM REPL

877+

878+

879+data ReplArtifacts =

880+ ReplArtifacts

881+ { _repl_home :: ModuleName.Canonical

882+ , _repl_modules :: [Module]

883+ , _repl_localizer :: L.Localizer

884+ , _repl_annotations :: Map.Map Name.Name Can.Annotation

885+ }

886+

887+

888+fromRepl :: FilePath -> Details.Details -> B.ByteString -> IO (Either Exit.Repl ReplArtifacts)

889+fromRepl root details source =

890+ do env@(Env _ _ projectType _ _ _ _) <- makeEnv Reporting.ignorer root details

891+ case Parse.fromByteString projectType source of

892+ Left syntaxError ->

893+ return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError

894+

895+ Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->

896+ do dmvar <- Details.loadInterfaces root details

897+

898+ let deps = map Src.getImportName imports

899+ mvar <- newMVar Map.empty

900+ crawlDeps env mvar deps ()

901+

902+ statuses <- traverse readMVar =<< readMVar mvar

903+ midpoint <- checkMidpoint dmvar statuses

904+

905+ case midpoint of

906+ Left problem ->

907+ return $ Left $ Exit.ReplProjectProblem problem

908+

909+ Right foreigns ->

910+ do rmvar <- newEmptyMVar

911+ resultMVars <- forkWithKey (checkModule env foreigns rmvar) statuses

912+ putMVar rmvar resultMVars

913+ results <- traverse readMVar resultMVars

914+ writeDetails root details results

915+ depsStatus <- checkDeps root resultMVars deps 0

916+ finalizeReplArtifacts env source modul depsStatus resultMVars results

917+

918+

919+finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)

920+finalizeReplArtifacts env@(Env _ root projectType _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) depsStatus resultMVars results =

921+ let

922+ pkg =

923+ projectTypeToPkg projectType

924+

925+ compileInput ifaces =

926+ case Compile.compile pkg ifaces modul of

927+ Right (Compile.Artifacts canonical annotations objects) ->

928+ let

929+ h = Can._name canonical

930+ m = Fresh (Src.getName modul) (I.fromModule pkg canonical annotations) objects

931+ ms = Map.foldrWithKey addInside [] results

932+ in

933+ return $ Right $ ReplArtifacts h (m:ms) (L.fromModule modul) annotations

934+

935+ Left errors ->

936+ return $ Left $ Exit.ReplBadInput source errors

937+ in

938+ case depsStatus of

939+ DepsChange ifaces ->

940+ compileInput ifaces

941+

942+ DepsSame same cached ->

943+ do maybeLoaded <- loadInterfaces root same cached

944+ case maybeLoaded of

945+ Just ifaces -> compileInput ifaces

946+ Nothing -> return $ Left $ Exit.ReplBadCache

947+

948+ DepsBlock ->

949+ case Map.foldr addErrors [] results of

950+ [] -> return $ Left $ Exit.ReplBlocked

951+ e:es -> return $ Left $ Exit.ReplBadLocalDeps root e es

952+

953+ DepsNotFound problems ->

954+ return $ Left $ Exit.ReplBadInput source $ Error.BadImports $

955+ toImportErrors env resultMVars imports problems

956+

957+

958+

797959--------------------------------------------------------------------------------

798960--------------------------------------------------------------------------------

799961------ AFTER THIS, EVERYTHING IS ABOUT HANDLING MODULES GIVEN BY FILEPATH ------

@@ -802,25 +964,25 @@ toDocs result =

802964

803965

804966

805−-- FIND MAIN

967+-- FIND ROOT

806968

807969

808−data MainLocation

970+data RootLocation

809971 = LInside ModuleName.Raw

810972 | LOutside FilePath

811973

812974

813−findMains :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List MainLocation))

814−findMains env paths =

815− do mvars <- traverse (fork . findLocation env) paths

816− elocs <- traverse readMVar mvars

817− return $ checkLocations =<< sequence elocs

975+findRoots :: Env -> NE.List FilePath -> IO (Either Exit.BuildProjectProblem (NE.List RootLocation))

976+findRoots env paths =

977+ do mvars <- traverse (fork . getRootInfo env) paths

978+ einfos <- traverse readMVar mvars

979+ return $ checkRoots =<< sequence einfos

818980

819981

820−checkLocations :: NE.List Location -> Either Exit.BuildProjectProblem (NE.List MainLocation)

821−checkLocations locations =

982+checkRoots :: NE.List RootInfo -> Either Exit.BuildProjectProblem (NE.List RootLocation)

983+checkRoots infos =

822984 let

823− toOneOrMore loc@(Location absolute _ _) =

985+ toOneOrMore loc@(RootInfo absolute _ _) =

824986 (absolute, OneOrMore.one loc)

825987

826988 fromOneOrMore loc locs =

@@ -828,71 +990,83 @@ checkLocations locations =

828990 [] -> Right ()

829991 loc2:_ -> Left (Exit.BP_MainPathDuplicate (_relative loc) (_relative loc2))

830992 in

831− fmap (\_ -> fmap _location locations) $

993+ fmap (\_ -> fmap _location infos) $

832994 traverse (OneOrMore.destruct fromOneOrMore) $

833− Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList locations)

995+ Map.fromListWith OneOrMore.more $ map toOneOrMore (NE.toList infos)

834996

835997

836998

837−-- LOCATIONS

999+-- ROOT INFO

8381000

8391001

840−data Location =

841− Location

1002+data RootInfo =

1003+ RootInfo

8421004 { _absolute :: FilePath

8431005 , _relative :: FilePath

844− , _location :: MainLocation

1006+ , _location :: RootLocation

8451007 }

8461008

8471009

848−findLocation :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem Location)

849−findLocation env path =

1010+getRootInfo :: Env -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)

1011+getRootInfo env path =

8501012 do exists <- File.exists path

8511013 if exists

852− then isInsideSrcDirs env path <$> Dir.canonicalizePath path

1014+ then getRootInfoHelp env path =<< Dir.canonicalizePath path

8531015 else return (Left (Exit.BP_PathUnknown path))

8541016

8551017

856−isInsideSrcDirs :: Env -> FilePath -> FilePath -> Either Exit.BuildProjectProblem Location

857−isInsideSrcDirs (Env _ root _ srcDirs _ _) path absolutePath =

1018+getRootInfoHelp :: Env -> FilePath -> FilePath -> IO (Either Exit.BuildProjectProblem RootInfo)

1019+getRootInfoHelp (Env _ _ _ srcDirs _ _ _) path absolutePath =

8581020 let

8591021 (dirs, file) = FP.splitFileName absolutePath

860− (final, ext) = break (=='.') file

1022+ (final, ext) = FP.splitExtension file

8611023 in

8621024 if ext /= ".elm"

863− then Left (Exit.BP_WithBadExtension path)

1025+ then

1026+ return $ Left $ Exit.BP_WithBadExtension path

8641027 else

8651028 let

866− roots = FP.splitDirectories root

867− segments = FP.splitDirectories dirs ++ [final]

1029+ absoluteSegments = FP.splitDirectories dirs ++ [final]

8681030 in

869− case dropPrefix roots segments of

870− Nothing ->

871− Right (Location absolutePath path (LOutside path))

872−

873− Just relativeSegments ->

874− let

875− (exits, maybes) =

876− Either.partitionEithers (map (isInsideSrcDirsHelp relativeSegments) srcDirs)

877− in

878− -- TODO make sure this is all correct

879− case (exits, Maybe.catMaybes maybes) of

880− (_, [(_,name)]) -> Right (Location absolutePath path (LInside name))

881− ([], []) -> Right (Location absolutePath path (LOutside path))

882− (_, (s1,_):(s2,_):_) -> Left (Exit.BP_WithAmbiguousSrcDir s1 s2)

883− (exit:_, _) -> Left exit

884−

885−

886−isInsideSrcDirsHelp :: [String] -> FilePath -> Either Exit.BuildProjectProblem (Maybe (FilePath, ModuleName.Raw))

887−isInsideSrcDirsHelp segments srcDir =

1031+ case Maybe.mapMaybe (isInsideSrcDirByPath absoluteSegments) srcDirs of

1032+ [] ->

1033+ return $ Right $ RootInfo absolutePath path (LOutside path)

1034+

1035+ [(_, Right names)] ->

1036+ do let name = Name.fromChars (List.intercalate "." names)

1037+ matchingDirs <- filterM (isInsideSrcDirByName names) srcDirs

1038+ case matchingDirs of

1039+ d1:d2:_ ->

1040+ do let p1 = addRelative d1 (FP.joinPath names <.> "elm")

1041+ let p2 = addRelative d2 (FP.joinPath names <.> "elm")

1042+ return $ Left $ Exit.BP_RootNameDuplicate name p1 p2

1043+

1044+ _ ->

1045+ return $ Right $ RootInfo absolutePath path (LInside name)

1046+

1047+ [(s, Left names)] ->

1048+ return $ Left $ Exit.BP_RootNameInvalid path s names

1049+

1050+ (s1,_):(s2,_):_ ->

1051+ return $ Left $ Exit.BP_WithAmbiguousSrcDir path s1 s2

1052+

1053+

1054+

1055+isInsideSrcDirByName :: [String] -> AbsoluteSrcDir -> IO Bool

1056+isInsideSrcDirByName names srcDir =

1057+ File.exists (addRelative srcDir (FP.joinPath names <.> "elm"))

1058+

1059+

1060+isInsideSrcDirByPath :: [String] -> AbsoluteSrcDir -> Maybe (FilePath, Either [String] [String])

1061+isInsideSrcDirByPath segments (AbsoluteSrcDir srcDir) =

8881062 case dropPrefix (FP.splitDirectories srcDir) segments of

8891063 Nothing ->

890− Right Nothing

1064+ Nothing

8911065

8921066 Just names ->

8931067 if all isGoodName names

894− then Right (Just (srcDir, Name.fromChars (List.intercalate "." names)))

895− else Left (error "Exit.MakeWithInvalidModuleName" srcDir segments)

1068+ then Just (srcDir, Right names)

1069+ else Just (srcDir, Left names)

8961070

8971071

8981072isGoodName :: [Char] -> Bool

@@ -905,6 +1079,8 @@ isGoodName name =

9051079 Char.isUpper char && all (\c -> Char.isAlphaNum c || c == '_') chars

9061080

9071081

1082+-- INVARIANT: Dir.canonicalizePath has been run on both inputs

1083+--

9081084dropPrefix :: [FilePath] -> [FilePath] -> Maybe [FilePath]

9091085dropPrefix roots paths =

9101086 case roots of

@@ -913,23 +1089,23 @@ dropPrefix roots paths =

9131089

9141090 r:rs ->

9151091 case paths of

916− [] -> Nothing

1092+ [] -> Nothing

9171093 p:ps -> if r == p then dropPrefix rs ps else Nothing

9181094

9191095

9201096

921−-- CRAWL MAINS

1097+-- CRAWL ROOTS

9221098

9231099

924−data MainStatus

1100+data RootStatus

9251101 = SInside ModuleName.Raw

9261102 | SOutsideOk Details.Local B.ByteString Src.Module

9271103 | SOutsideErr Error.Module

9281104

9291105

930−crawlMain :: Env -> MVar StatusDict -> MainLocation -> IO MainStatus

931−crawlMain env@(Env _ _ pkg _ _ _) mvar given =

932− case given of

1106+crawlRoot :: Env -> MVar StatusDict -> RootLocation -> IO RootStatus

1107+crawlRoot env@(Env _ _ projectType _ buildID _ _) mvar root =

1108+ case root of

9331109 LInside name ->

9341110 do statusMVar <- newEmptyMVar

9351111 statusDict <- takeMVar mvar

@@ -940,10 +1116,10 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =

9401116 LOutside path ->

9411117 do time <- File.getTime path

9421118 source <- File.readUtf8 path

943− case Parse.fromByteString pkg source of

1119+ case Parse.fromByteString projectType source of

9441120 Right modul@(Src.Module _ _ _ imports values _ _ _ _) ->

9451121 do let deps = map Src.getImportName imports

946− let local = Details.Local path time deps (any isMain values)

1122+ let local = Details.Local path time deps (any isMain values) buildID buildID

9471123 crawlDeps env mvar deps (SOutsideOk local source modul)

9481124

9491125 Left syntaxError ->

@@ -952,40 +1128,36 @@ crawlMain env@(Env _ _ pkg _ _ _) mvar given =

9521128

9531129

9541130

955−-- CHECK MAINS

1131+-- CHECK ROOTS

9561132

9571133

958−data MainResult

1134+data RootResult

9591135 = RInside ModuleName.Raw

9601136 | ROutsideOk ModuleName.Raw I.Interface Opt.LocalGraph

9611137 | ROutsideErr Error.Module

9621138 | ROutsideBlocked

9631139

9641140

965−checkMain :: Env -> ResultDict -> MainStatus -> IO MainResult

966−checkMain env@(Env _ root _ _ _ _) results pendingMain =

967− case pendingMain of

1141+checkRoot :: Env -> ResultDict -> RootStatus -> IO RootResult

1142+checkRoot env@(Env _ root _ _ _ _ _) results rootStatus =

1143+ case rootStatus of

9681144 SInside name ->

9691145 return (RInside name)

9701146

9711147 SOutsideErr err ->

9721148 return (ROutsideErr err)

9731149

974− SOutsideOk local@(Details.Local path time deps _) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->

975− do depsStatus <- checkDeps root results deps

1150+ SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _) ->

1151+ do depsStatus <- checkDeps root results deps lastCompile

9761152 case depsStatus of

9771153 DepsChange ifaces ->

978− return $ compileOutside env local source ifaces modul

1154+ compileOutside env local source ifaces modul

9791155

9801156 DepsSame same cached ->

981− do maybeLoaded <- checkCachedInterfaces root cached

1157+ do maybeLoaded <- loadInterfaces root same cached

9821158 case maybeLoaded of

983− Nothing ->

984− return ROutsideBlocked

985−

986− Just loaded ->

987− do let ifaces = Map.union loaded (Map.fromList same)

988− return $ compileOutside env local source ifaces modul

1159+ Nothing -> return ROutsideBlocked

1160+ Just ifaces -> compileOutside env local source ifaces modul

9891161

9901162 DepsBlock ->

9911163 return ROutsideBlocked

@@ -995,53 +1167,54 @@ checkMain env@(Env _ root _ _ _ _) results pendingMain =

9951167 Error.BadImports (toImportErrors env results imports problems)

9961168

9971169

998−compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> MainResult

999−compileOutside (Env _ _ pkg _ _ _) (Details.Local path time _ _) source ifaces modul =

1170+compileOutside :: Env -> Details.Local -> B.ByteString -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> IO RootResult

1171+compileOutside (Env key _ projectType _ _ _ _) (Details.Local path time _ _ _ _) source ifaces modul =

10001172 let

1173+ pkg = projectTypeToPkg projectType

10011174 name = Src.getName modul

10021175 in

10031176 case Compile.compile pkg ifaces modul of

10041177 Right (Compile.Artifacts canonical annotations objects) ->

1005− ROutsideOk name (I.fromModule pkg canonical annotations) objects

1178+ do Reporting.report key Reporting.BDone

1179+ return $ ROutsideOk name (I.fromModule pkg canonical annotations) objects

10061180

10071181 Left errors ->

1008− ROutsideErr $

1009− Error.Module name path time source errors

1182+ return $ ROutsideErr $ Error.Module name path time source errors

10101183

10111184

10121185

10131186-- TO ARTIFACTS

10141187

10151188

1016−data Main

1189+data Root

10171190 = Inside ModuleName.Raw

10181191 | Outside ModuleName.Raw I.Interface Opt.LocalGraph

10191192

10201193

1021−toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either Exit.BuildProblem Artifacts

1022−toArtifacts (Env _ _ pkg _ _ _) foreigns results mainResults =

1023− case gatherProblemsOrMains results mainResults of

1194+toArtifacts :: Env -> Dependencies -> Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either Exit.BuildProblem Artifacts

1195+toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults =

1196+ case gatherProblemsOrMains results rootResults of

10241197 Left (NE.List e es) ->

1025− Left (Exit.BuildModuleProblems e es)

1198+ Left (Exit.BuildBadModules root e es)

10261199

1027− Right mains ->

1028− Right $ Artifacts pkg foreigns mains $

1029− Map.foldrWithKey addInside (foldr addOutside [] mainResults) results

1200+ Right roots ->

1201+ Right $ Artifacts (projectTypeToPkg projectType) foreigns roots $

1202+ Map.foldrWithKey addInside (foldr addOutside [] rootResults) results

10301203

10311204

1032−gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List MainResult -> Either (NE.List Error.Module) (NE.List Main)

1033−gatherProblemsOrMains results (NE.List mainResult mainResults) =

1205+gatherProblemsOrMains :: Map.Map ModuleName.Raw Result -> NE.List RootResult -> Either (NE.List Error.Module) (NE.List Root)

1206+gatherProblemsOrMains results (NE.List rootResult rootResults) =

10341207 let

1035− sortMain result (es, mains) =

1208+ addResult result (es, roots) =

10361209 case result of

1037− RInside n -> ( es, Inside n : mains)

1038− ROutsideOk n i o -> ( es, Outside n i o : mains)

1039− ROutsideErr e -> (e:es, mains)

1040− ROutsideBlocked -> ( es, mains)

1210+ RInside n -> ( es, Inside n : roots)

1211+ ROutsideOk n i o -> ( es, Outside n i o : roots)

1212+ ROutsideErr e -> (e:es, roots)

1213+ ROutsideBlocked -> ( es, roots)

10411214

10421215 errors = Map.foldr addErrors [] results

10431216 in

1044− case (mainResult, foldr sortMain (errors, []) mainResults) of

1217+ case (rootResult, foldr addResult (errors, []) rootResults) of

10451218 (RInside n , ( [], ms)) -> Right (NE.List (Inside n) ms)

10461219 (RInside _ , (e:es, _ )) -> Left (NE.List e es)

10471220 (ROutsideOk n i o, ( [], ms)) -> Right (NE.List (Outside n i o) ms)

@@ -1056,7 +1229,7 @@ addInside name result modules =

10561229 case result of

10571230 RNew _ iface objs _ -> Fresh name iface objs : modules

10581231 RSame _ iface objs _ -> Fresh name iface objs : modules

1059− RCached main mvar -> Cached name main mvar : modules

1232+ RCached main _ mvar -> Cached name main mvar : modules

10601233 RNotFound _ -> error (badInside name)

10611234 RProblem _ -> error (badInside name)

10621235 RBlocked -> error (badInside name)

@@ -1069,9 +1242,9 @@ badInside name =

10691242 "Error from `" ++ Name.toChars name ++ "` should have been reported already."

10701243

10711244

1072−addOutside :: MainResult -> [Module] -> [Module]

1073−addOutside main modules =

1074− case main of

1245+addOutside :: RootResult -> [Module] -> [Module]

1246+addOutside root modules =

1247+ case root of

10751248 RInside _ -> modules

10761249 ROutsideOk name iface objs -> Fresh name iface objs : modules

10771250 ROutsideErr _ -> modules

builder/src/Deps/Diff.hs+6−4

@@ -18,7 +18,7 @@ import qualified Data.List as List

1818import qualified Data.Map as Map

1919import qualified Data.Name as Name

2020import qualified Data.Set as Set

21−import qualified Data.Utf8 as Utf8

21+import qualified System.Directory as Dir

2222import System.FilePath ((</>))

2323

2424import qualified Deps.Website as Website

@@ -357,7 +357,8 @@ changeMagnitude (Changes added changed removed) =

357357

358358getDocs :: Stuff.PackageCache -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.DocsProblem Docs.Documentation)

359359getDocs cache manager name version =

360− do let path = Stuff.package cache name version </> "docs.json"

360+ do let home = Stuff.package cache name version

361+ let path = home </> "docs.json"

361362 exists <- File.exists path

362363 if exists

363364 then

@@ -374,8 +375,9 @@ getDocs cache manager name version =

374375 Http.get manager url [] Exit.DP_Http $ \body ->

375376 case D.fromByteString Docs.decoder body of

376377 Right docs ->

377− do File.writeUtf8 path body

378+ do Dir.createDirectoryIfMissing True home

379+ File.writeUtf8 path body

378380 return $ Right docs

379381

380382 Left _ ->

381− return $ Left Exit.DP_Data

383+ return $ Left $ Exit.DP_Data url body

builder/src/Deps/Registry.hs+6−7

@@ -54,11 +54,7 @@ data KnownVersions =

5454

5555read :: Stuff.PackageCache -> IO (Maybe Registry)

5656read cache =

57− do let path = Stuff.registry cache

58− exists <- File.exists path

59− if exists

60− then File.readBinary path

61− else return Nothing

57+ File.readBinary (Stuff.registry cache)

6258

6359

6460

@@ -193,11 +189,14 @@ getVersions' name (Registry _ versions) =

193189

194190post :: Http.Manager -> String -> D.Decoder x a -> (a -> IO b) -> IO (Either Exit.RegistryProblem b)

195191post manager path decoder callback =

196− Http.post manager (Website.route path []) [] Exit.RP_Http $

192+ let

193+ url = Website.route path []

194+ in

195+ Http.post manager url [] Exit.RP_Http $

197196 \body ->

198197 case D.fromByteString decoder body of

199198 Right a -> Right <$> callback a

200− Left _ -> return $ Left Exit.RP_Data

199+ Left _ -> return $ Left $ Exit.RP_Data url body

201200

202201

203202

builder/src/Deps/Solver.hs+31−29

@@ -94,6 +94,7 @@ data Details =

9494

9595verify :: Stuff.PackageCache -> Connection -> Registry.Registry -> Map.Map Pkg.Name C.Constraint -> IO (Result (Map.Map Pkg.Name Details))

9696verify cache connection registry constraints =

97+ Stuff.withRegistryLock cache $

9798 case try constraints of

9899 Solver solver ->

99100 solver (State cache connection registry Map.empty)

@@ -130,6 +131,7 @@ data AppSolution =

130131

131132addToApp :: Stuff.PackageCache -> Connection -> Registry.Registry -> Pkg.Name -> Outline.AppOutline -> IO (Result AppSolution)

132133addToApp cache connection registry pkg outline@(Outline.AppOutline _ _ direct indirect testDirect testIndirect) =

134+ Stuff.withRegistryLock cache $

133135 let

134136 allIndirects = Map.union indirect testIndirect

135137 allDirects = Map.union direct testDirect

@@ -311,10 +313,11 @@ getConstraints pkg vsn =

311313 back state

312314

313315 Online manager ->

314− do result <- Http.get manager (Website.metadata pkg vsn "elm.json") [] id (return . Right)

316+ do let url = Website.metadata pkg vsn "elm.json"

317+ result <- Http.get manager url [] id (return . Right)

315318 case result of

316319 Left httpProblem ->

317− err (Exit.SolverBadHttp httpProblem)

320+ err (Exit.SolverBadHttp pkg vsn httpProblem)

318321

319322 Right body ->

320323 case D.fromByteString constraintsDecoder body of

@@ -324,11 +327,9 @@ getConstraints pkg vsn =

324327 ok (toNewState cs) cs back

325328

326329 Left _ ->

327− err (Exit.SolverBadHttpData pkg vsn)

330+ err (Exit.SolverBadHttpData pkg vsn url)

328331

329332

330−-- TODO write constraintsDecoder to be a bit faster

331−--

332333constraintsDecoder :: D.Decoder () Constraints

333334constraintsDecoder =

334335 do outline <- D.mapError (const ()) Outline.decoder

@@ -350,30 +351,31 @@ data Env =

350351

351352initEnv :: IO (Either Exit.RegistryProblem Env)

352353initEnv =

353− do mvar <- newEmptyMVar

354− _ <- forkIO $ putMVar mvar =<< Http.getManager

355− cache <- Stuff.getPackageCache

356− maybeRegistry <- Registry.read cache

357− manager <- readMVar mvar

358−

359− case maybeRegistry of

360− Nothing ->

361− do eitherRegistry <- Registry.fetch manager cache

362− case eitherRegistry of

363− Right latestRegistry ->

364− return $ Right $ Env cache manager (Online manager) latestRegistry

365−

366− Left problem ->

367− return $ Left $ problem

368−

369− Just cachedRegistry ->

370− do eitherRegistry <- Registry.update manager cache cachedRegistry

371− case eitherRegistry of

372− Right latestRegistry ->

373− return $ Right $ Env cache manager (Online manager) latestRegistry

374−

375− Left _ ->

376− return $ Right $ Env cache manager Offline cachedRegistry

354+ do mvar <- newEmptyMVar

355+ _ <- forkIO $ putMVar mvar =<< Http.getManager

356+ cache <- Stuff.getPackageCache

357+ Stuff.withRegistryLock cache $

358+ do maybeRegistry <- Registry.read cache

359+ manager <- readMVar mvar

360+

361+ case maybeRegistry of

362+ Nothing ->

363+ do eitherRegistry <- Registry.fetch manager cache

364+ case eitherRegistry of

365+ Right latestRegistry ->

366+ return $ Right $ Env cache manager (Online manager) latestRegistry

367+

368+ Left problem ->

369+ return $ Left $ problem

370+

371+ Just cachedRegistry ->

372+ do eitherRegistry <- Registry.update manager cache cachedRegistry

373+ case eitherRegistry of

374+ Right latestRegistry ->

375+ return $ Right $ Env cache manager (Online manager) latestRegistry

376+

377+ Left _ ->

378+ return $ Right $ Env cache manager Offline cachedRegistry

377379

378380

379381

builder/src/Elm/Details.hs+108−70

@@ -2,6 +2,7 @@

22{-# LANGUAGE BangPatterns, OverloadedStrings #-}

33module Elm.Details

44 ( Details(..)

5+ , BuildID

56 , ValidOutline(..)

67 , Local(..)

78 , Foreign(..)

@@ -15,22 +16,26 @@ module Elm.Details

1516

1617import Control.Concurrent (forkIO)

1718import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)

18−import Control.Monad (liftM, liftM2, liftM4)

19+import Control.Monad (liftM, liftM2, liftM3)

1920import Data.Binary (Binary, get, put, getWord8, putWord8)

21+import qualified Data.Either as Either

2022import qualified Data.Map as Map

2123import qualified Data.Map.Utils as Map

2224import qualified Data.Map.Merge.Strict as Map

25+import qualified Data.Maybe as Maybe

2326import qualified Data.Name as Name

2427import qualified Data.NonEmptyList as NE

2528import qualified Data.OneOrMore as OneOrMore

2629import qualified Data.Set as Set

2730import qualified Data.Utf8 as Utf8

31+import Data.Word (Word64)

2832import qualified System.Directory as Dir

2933import System.FilePath ((</>), (<.>))

3034

3135import qualified AST.Canonical as Can

3236import qualified AST.Source as Src

3337import qualified AST.Optimized as Opt

38+import qualified BackgroundWriter as BW

3439import qualified Compile

3540import qualified Deps.Registry as Registry

3641import qualified Deps.Solver as Solver

@@ -63,23 +68,42 @@ data Details =

6368 Details

6469 { _outlineTime :: File.Time

6570 , _outline :: ValidOutline

71+ , _buildID :: BuildID

6672 , _locals :: Map.Map ModuleName.Raw Local

6773 , _foreigns :: Map.Map ModuleName.Raw Foreign

6874 , _extras :: Extras

6975 }

7076

7177

72−data ValidOutline

73− = ValidApp (NE.List FilePath)

74− | ValidPkg Pkg.Name [ModuleName.Raw]

78+type BuildID = Word64

7579

7680

81+data ValidOutline

82+ = ValidApp (NE.List Outline.SrcDir)

83+ | ValidPkg Pkg.Name [ModuleName.Raw] (Map.Map Pkg.Name V.Version {- for docs in reactor -})

84+

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+--

7799data Local =

78100 Local

79101 { _path :: FilePath

80102 , _time :: File.Time

81103 , _deps :: [ModuleName.Raw]

82104 , _main :: Bool

105+ , _lastChange :: BuildID

106+ , _lastCompile :: BuildID

83107 }

84108

85109

@@ -101,14 +125,14 @@ type Interfaces =

101125

102126

103127loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))

104−loadObjects root (Details _ _ _ _ extras) =

128+loadObjects root (Details _ _ _ _ _ extras) =

105129 case extras of

106130 ArtifactsFresh _ o -> newMVar (Just o)

107131 ArtifactsCached -> fork (File.readBinary (Stuff.objects root))

108132

109133

110134loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))

111−loadInterfaces root (Details _ _ _ _ extras) =

135+loadInterfaces root (Details _ _ _ _ _ extras) =

112136 case extras of

113137 ArtifactsFresh i _ -> newMVar (Just i)

114138 ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))

@@ -118,11 +142,11 @@ loadInterfaces root (Details _ _ _ _ extras) =

118142-- VERIFY INSTALL -- used by Install

119143

120144

121−verifyInstall :: FilePath -> Solver.Env -> Outline.Outline -> IO (Either Exit.Details ())

122−verifyInstall root (Solver.Env cache manager connection registry) outline =

145+verifyInstall :: BW.Scope -> FilePath -> Solver.Env -> Outline.Outline -> IO (Either Exit.Details ())

146+verifyInstall scope root (Solver.Env cache manager connection registry) outline =

123147 do time <- File.getTime (root </> "elm.json")

124148 let key = Reporting.ignorer

125− let env = Env key root cache manager connection registry

149+ let env = Env key scope root cache manager connection registry

126150 case outline of

127151 Outline.Pkg pkg -> Task.run (verifyPkg env time pkg >> return ())

128152 Outline.App app -> Task.run (verifyApp env time app >> return ())

@@ -132,28 +156,28 @@ verifyInstall root (Solver.Env cache manager connection registry) outline =

132156-- LOAD -- used by Make, Repl, Reactor

133157

134158

135−load :: Reporting.Style -> FilePath -> IO (Either Exit.Details Details)

136−load style root =

159+load :: Reporting.Style -> BW.Scope -> FilePath -> IO (Either Exit.Details Details)

160+load style scope root =

137161 do newTime <- File.getTime (root </> "elm.json")

138162 maybeDetails <- File.readBinary (Stuff.details root)

139163 case maybeDetails of

140164 Nothing ->

141− generate style root newTime

165+ generate style scope root newTime

142166

143− Just details@(Details oldTime _ _ _ _) ->

167+ Just details@(Details oldTime _ buildID _ _ _) ->

144168 if oldTime == newTime

145− then return (Right details)

146− else generate style root newTime

169+ then return (Right details { _buildID = buildID + 1 })

170+ else generate style scope root newTime

147171

148172

149173

150174-- GENERATE

151175

152176

153−generate :: Reporting.Style -> FilePath -> File.Time -> IO (Either Exit.Details Details)

154−generate style root time =

177+generate :: Reporting.Style -> BW.Scope -> FilePath -> File.Time -> IO (Either Exit.Details Details)

178+generate style scope root time =

155179 Reporting.trackDetails style $ \key ->

156− do result <- initEnv key root

180+ do result <- initEnv key scope root

157181 case result of

158182 Left exit ->

159183 return (Left exit)

@@ -171,6 +195,7 @@ generate style root time =

171195data Env =

172196 Env

173197 { _key :: Reporting.DKey

198+ , _scope :: BW.Scope

174199 , _root :: FilePath

175200 , _cache :: Stuff.PackageCache

176201 , _manager :: Http.Manager

@@ -179,8 +204,8 @@ data Env =

179204 }

180205

181206

182−initEnv :: Reporting.DKey -> FilePath -> IO (Either Exit.Details (Env, Outline.Outline))

183−initEnv key root =

207+initEnv :: Reporting.DKey -> BW.Scope -> FilePath -> IO (Either Exit.Details (Env, Outline.Outline))

208+initEnv key scope root =

184209 do mvar <- fork Solver.initEnv

185210 eitherOutline <- Outline.read root

186211 case eitherOutline of

@@ -194,7 +219,7 @@ initEnv key root =

194219 return $ Left $ Exit.DetailsCannotGetRegistry problem

195220

196221 Right (Solver.Env cache manager connection registry) ->

197− return $ Right (Env key root cache manager connection registry, outline)

222+ return $ Right (Env key scope root cache manager connection registry, outline)

198223

199224

200225

@@ -210,7 +235,8 @@ verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm)

210235 then

211236 do solution <- verifyConstraints env =<< union noDups direct testDirect

212237 let exposedList = Outline.flattenExposed exposed

213− verifyDependencies env time (ValidPkg pkg exposedList) solution direct

238+ let exactDeps = Map.map (\(Solver.Details v _) -> v) solution -- for pkg docs in reactor

239+ verifyDependencies env time (ValidPkg pkg exposedList exactDeps) solution direct

214240 else

215241 Task.throw $ Exit.DetailsBadElmInPkg elm

216242

@@ -240,7 +266,7 @@ checkAppDeps (Outline.AppOutline _ _ direct indirect testDirect testIndirect) =

240266

241267

242268verifyConstraints :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)

243−verifyConstraints (Env _ _ cache _ connection registry) constraints =

269+verifyConstraints (Env _ _ _ cache _ connection registry) constraints =

244270 do result <- Task.io $ Solver.verify cache connection registry constraints

245271 case result of

246272 Solver.Ok details -> return details

@@ -286,27 +312,30 @@ fork work =

286312

287313

288314verifyDependencies :: Env -> File.Time -> ValidOutline -> Map.Map Pkg.Name Solver.Details -> Map.Map Pkg.Name a -> Task Details

289−verifyDependencies env@(Env key root _ _ _ _) time outline solution directDeps =

315+verifyDependencies env@(Env key scope root cache _ _ _) time outline solution directDeps =

290316 Task.eio id $

291317 do Reporting.report key (Reporting.DStart (Map.size solution))

292318 mvar <- newEmptyMVar

293− mvars <- Map.traverseWithKey (\k v -> fork (verifyDep env mvar solution k v)) solution

319+ mvars <- Stuff.withRegistryLock cache $

320+ Map.traverseWithKey (\k v -> fork (verifyDep env mvar solution k v)) solution

294321 putMVar mvar mvars

295322 deps <- traverse readMVar mvars

296323 case sequence deps of

297− Left problem ->

298− error "TODO verifyDependencies" problem

324+ Left _ ->

325+ do home <- Stuff.getElmHome

326+ return $ Left $ Exit.DetailsBadDeps home $

327+ Maybe.catMaybes $ Either.lefts $ Map.elems deps

299328

300329 Right artifacts ->

301330 let

302331 objs = Map.foldr addObjects Opt.empty artifacts

303332 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts

304− foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty artifacts

305− details = Details time outline Map.empty foreigns (ArtifactsFresh ifaces objs)

333+ foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty $ Map.intersection artifacts directDeps

334+ details = Details time outline 0 Map.empty foreigns (ArtifactsFresh ifaces objs)

306335 in

307− do File.writeBinary (Stuff.objects root) objs

308− File.writeBinary (Stuff.interfaces root) ifaces

309− File.writeBinary (Stuff.details root) details

336+ do BW.writeBinary scope (Stuff.objects root) objs

337+ BW.writeBinary scope (Stuff.interfaces root) ifaces

338+ BW.writeBinary scope (Stuff.details root) details

310339 return (Right details)

311340

312341

@@ -346,44 +375,36 @@ data Artifacts =

346375

347376

348377type Dep =

349− Either Problem Artifacts

350−

351−

352−data Problem

353− = BadDownload Exit.PackageProblem

354− | BadBuild

355− | BadDependency

378+ Either (Maybe Exit.DetailsBadDep) Artifacts

356379

357380

358381verifyDep :: Env -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Map.Map Pkg.Name Solver.Details -> Pkg.Name -> Solver.Details -> IO Dep

359−verifyDep (Env key _ cache manager _ _) depsMVar solution pkg details@(Solver.Details vsn directDeps) =

360− let

361− fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps

362− in

363− do exists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn </> "src")

382+verifyDep (Env key _ _ cache manager _ _) depsMVar solution pkg details@(Solver.Details vsn directDeps) =

383+ do let fingerprint = Map.intersectionWith (\(Solver.Details v _) _ -> v) solution directDeps

384+ exists <- Dir.doesDirectoryExist (Stuff.package cache pkg vsn </> "src")

364385 if exists

365386 then

366387 do Reporting.report key Reporting.DCached

367388 maybeCache <- File.readBinary (Stuff.package cache pkg vsn </> "artifacts.dat")

368389 case maybeCache of

369390 Nothing ->

370− build key cache depsMVar pkg details (Set.singleton fingerprint)

391+ build key cache depsMVar pkg details fingerprint Set.empty

371392

372393 Just (ArtifactCache fingerprints artifacts) ->

373394 if Set.member fingerprint fingerprints

374395 then Reporting.report key Reporting.DBuilt >> return (Right artifacts)

375− else build key cache depsMVar pkg details (Set.insert fingerprint fingerprints)

396+ else build key cache depsMVar pkg details fingerprint fingerprints

376397 else

377398 do Reporting.report key Reporting.DRequested

378399 result <- downloadPackage cache manager pkg vsn

379400 case result of

380− Left p ->

401+ Left problem ->

381402 do Reporting.report key (Reporting.DFailed pkg vsn)

382− return (Left (BadDownload p))

403+ return $ Left $ Just $ Exit.BD_BadDownload pkg vsn problem

383404

384405 Right () ->

385406 do Reporting.report key (Reporting.DReceived pkg vsn)

386− build key cache depsMVar pkg details (Set.singleton fingerprint)

407+ build key cache depsMVar pkg details fingerprint Set.empty

387408

388409

389410

@@ -405,17 +426,17 @@ type Fingerprint =

405426-- BUILD

406427

407428

408−build :: Reporting.DKey -> Stuff.PackageCache -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Solver.Details -> Set.Set Fingerprint -> IO Dep

409−build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

429+build :: Reporting.DKey -> Stuff.PackageCache -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Solver.Details -> Fingerprint -> Set.Set Fingerprint -> IO Dep

430+build key cache depsMVar pkg (Solver.Details vsn _) f fs =

410431 do eitherOutline <- Outline.read (Stuff.package cache pkg vsn)

411432 case eitherOutline of

412433 Left _ ->

413434 do Reporting.report key Reporting.DBroken

414− return (Left BadBuild)

435+ return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f

415436

416437 Right (Outline.App _) ->

417438 do Reporting.report key Reporting.DBroken

418− return (Left BadBuild)

439+ return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f

419440

420441 Right (Outline.Pkg (Outline.PkgOutline _ _ _ _ exposed deps _ _)) ->

421442 do allDeps <- readMVar depsMVar

@@ -423,7 +444,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

423444 case sequence directDeps of

424445 Left _ ->

425446 do Reporting.report key Reporting.DBroken

426− return (Left BadDependency)

447+ return $ Left $ Nothing

427448

428449 Right directArtifacts ->

429450 do let src = Stuff.package cache pkg vsn </> "src"

@@ -438,7 +459,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

438459 case sequence maybeStatuses of

439460 Nothing ->

440461 do Reporting.report key Reporting.DBroken

441− return (Left BadBuild)

462+ return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f

442463

443464 Just statuses ->

444465 do rmvar <- newEmptyMVar

@@ -448,7 +469,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

448469 case sequence maybeResults of

449470 Nothing ->

450471 do Reporting.report key Reporting.DBroken

451− return (Left BadBuild)

472+ return $ Left $ Just $ Exit.BD_BadBuild pkg vsn f

452473

453474 Just results ->

454475 let

@@ -456,6 +477,7 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

456477 ifaces = gatherInterfaces exposedDict results

457478 objects = gatherObjects results

458479 artifacts = Artifacts ifaces objects

480+ fingerprints = Set.insert f fs

459481 in

460482 do writeDocs cache pkg vsn docsStatus results

461483 File.writeBinary path (ArtifactCache fingerprints artifacts)

@@ -573,7 +595,7 @@ crawlModule foreignDeps mvar pkg src docsStatus name =

573595crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)

574596crawlFile foreignDeps mvar pkg src docsStatus expectedName path =

575597 do bytes <- File.readUtf8 path

576− case Parse.fromByteString pkg bytes of

598+ case Parse.fromByteString (Parse.Package pkg) bytes of

577599 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->

578600 do deps <- crawlImports foreignDeps mvar pkg src imports

579601 return (Just (SLocal docsStatus deps modul))

@@ -725,24 +747,27 @@ toDocs result =

725747

726748downloadPackage :: Stuff.PackageCache -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either Exit.PackageProblem ())

727749downloadPackage cache manager pkg vsn =

750+ let

751+ url = Website.metadata pkg vsn "endpoint.json"

752+ in

728753 do eitherByteString <-

729− Http.get manager (Website.metadata pkg vsn "endpoint.json") [] id (return . Right)

754+ Http.get manager url [] id (return . Right)

730755

731756 case eitherByteString of

732757 Left err ->

733− return (Left (Exit.PP_BadEndpointRequest err))

758+ return $ Left $ Exit.PP_BadEndpointRequest err

734759

735760 Right byteString ->

736761 case D.fromByteString endpointDecoder byteString of

737762 Left _ ->

738− return (Left Exit.PP_BadEndpointContent)

763+ return $ Left $ Exit.PP_BadEndpointContent url

739764

740765 Right (endpoint, expectedHash) ->

741− Http.getArchive manager endpoint Exit.PP_BadArchiveRequest Exit.PP_BadArchiveContent $

766+ Http.getArchive manager endpoint Exit.PP_BadArchiveRequest (Exit.PP_BadArchiveContent endpoint) $

742767 \(sha, archive) ->

743768 if expectedHash == Http.shaToChars sha

744769 then Right <$> File.writePackage (Stuff.package cache pkg vsn) archive

745− else return $ Left $ Exit.PP_BadArchiveHash expectedHash (Http.shaToChars sha)

770+ else return $ Left $ Exit.PP_BadArchiveHash endpoint expectedHash (Http.shaToChars sha)

746771

747772

748773endpointDecoder :: D.Decoder e (String, String)

@@ -757,27 +782,40 @@ endpointDecoder =

757782

758783

759784instance Binary Details where

760− get = do { a <- get; b <- get; c <- get; d <- get; return (Details a b c d ArtifactsCached) }

761− put (Details a b c d _) = put a >> put b >> put c >> put d

785+ put (Details a b c d e _) = put a >> put b >> put c >> put d >> put e

786+ get =

787+ do a <- get

788+ b <- get

789+ c <- get

790+ d <- get

791+ e <- get

792+ return (Details a b c d e ArtifactsCached)

762793

763794

764795instance Binary ValidOutline where

765796 put outline =

766797 case outline of

767− ValidApp a -> putWord8 0 >> put a

768− ValidPkg a b -> putWord8 1 >> put a >> put b

798+ ValidApp a -> putWord8 0 >> put a

799+ ValidPkg a b c -> putWord8 1 >> put a >> put b >> put c

769800

770801 get =

771802 do n <- getWord8

772803 case n of

773804 0 -> liftM ValidApp get

774− 1 -> liftM2 ValidPkg get get

775− _ -> error "binary encoding of ValidOutline was corrupted"

805+ 1 -> liftM3 ValidPkg get get get

806+ _ -> fail "binary encoding of ValidOutline was corrupted"

776807

777808

778809instance Binary Local where

779− get = liftM4 Local get get get get

780− 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)

781819

782820

783821instance Binary Foreign where

builder/src/Elm/Outline.hs+109−15

@@ -5,6 +5,7 @@ module Elm.Outline

55 , AppOutline(..)

66 , PkgOutline(..)

77 , Exposed(..)

8+ , SrcDir(..)

89 , read

910 , write

1011 , encode

@@ -16,11 +17,14 @@ module Elm.Outline

1617

1718

1819import Prelude hiding (read)

19−import Control.Monad (filterM)

20+import Control.Monad (filterM, liftM)

21+import Data.Binary (Binary, get, put, getWord8, putWord8)

2022import qualified Data.Map as Map

2123import qualified Data.NonEmptyList as NE

24+import qualified Data.OneOrMore as OneOrMore

2225import Foreign.Ptr (minusPtr)

2326import qualified System.Directory as Dir

27+import qualified System.FilePath as FP

2428import System.FilePath ((</>))

2529

2630import qualified Elm.Constraint as Con

@@ -49,7 +53,7 @@ data Outline

4953data AppOutline =

5054 AppOutline

5155 { _app_elm_version :: V.Version

52− , _app_source_dirs :: NE.List FilePath

56+ , _app_source_dirs :: NE.List SrcDir

5357 , _app_deps_direct :: Map.Map Pkg.Name V.Version

5458 , _app_deps_indirect :: Map.Map Pkg.Name V.Version

5559 , _app_test_direct :: Map.Map Pkg.Name V.Version

@@ -75,6 +79,11 @@ data Exposed

7579 | ExposedDict [(Json.String, [ModuleName.Raw])]

7680

7781

82+data SrcDir

83+ = AbsoluteSrcDir FilePath

84+ | RelativeSrcDir FilePath

85+

86+

7887

7988-- DEFAULTS

8089

@@ -117,7 +126,7 @@ encode outline =

117126 App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->

118127 E.object

119128 [ "type" ==> E.chars "application"

120− , "source-directories" ==> E.list E.chars (NE.toList srcDirs)

129+ , "source-directories" ==> E.list encodeSrcDir (NE.toList srcDirs)

121130 , "elm-version" ==> V.encode elm

122131 , "dependencies" ==>

123132 E.object

@@ -165,6 +174,13 @@ encodeDeps encodeValue deps =

165174 E.dict Pkg.toJsonString encodeValue deps

166175

167176

177+encodeSrcDir :: SrcDir -> E.Value

178+encodeSrcDir srcDir =

179+ case srcDir of

180+ AbsoluteSrcDir dir -> E.chars dir

181+ RelativeSrcDir dir -> E.chars dir

182+

183+

168184

169185-- PARSE AND VERIFY

170186

@@ -178,19 +194,72 @@ read root =

178194

179195 Right outline ->

180196 case outline of

181− Pkg _ ->

182− return $ Right outline

197+ Pkg (PkgOutline pkg _ _ _ _ deps _ _) ->

198+ return $

199+ if Map.notMember Pkg.core deps && pkg /= Pkg.core

200+ then Left Exit.OutlineNoPkgCore

201+ else Right outline

202+

203+ App (AppOutline _ srcDirs direct indirect _ _)

204+ | Map.notMember Pkg.core direct ->

205+ return $ Left Exit.OutlineNoAppCore

206+

207+ | Map.notMember Pkg.json direct && Map.notMember Pkg.json indirect ->

208+ return $ Left Exit.OutlineNoAppJson

209+

210+ | otherwise ->

211+ do badDirs <- filterM (isSrcDirMissing root) (NE.toList srcDirs)

212+ case map toGiven badDirs of

213+ d:ds ->

214+ return $ Left (Exit.OutlineHasMissingSrcDirs d ds)

215+

216+ [] ->

217+ do maybeDups <- detectDuplicates root (NE.toList srcDirs)

218+ case maybeDups of

219+ Nothing ->

220+ return $ Right outline

221+

222+ Just (canonicalDir, (dir1,dir2)) ->

223+ return $ Left (Exit.OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2)

224+

225+

226+isSrcDirMissing :: FilePath -> SrcDir -> IO Bool

227+isSrcDirMissing root srcDir =

228+ not <$> Dir.doesDirectoryExist (toAbsolute root srcDir)

229+

230+

231+toGiven :: SrcDir -> FilePath

232+toGiven srcDir =

233+ case srcDir of

234+ AbsoluteSrcDir dir -> dir

235+ RelativeSrcDir dir -> dir

183236

184− App (AppOutline _ srcDirs _ _ _ _) ->

185− do badDirs <- filterM (isBadSrcDir root) (NE.toList srcDirs)

186− case badDirs of

187− [] -> return $ Right outline

188− d:ds -> return $ Left (Exit.OutlineHasBadSrcDirs d ds)

189237

238+toAbsolute :: FilePath -> SrcDir -> FilePath

239+toAbsolute root srcDir =

240+ case srcDir of

241+ AbsoluteSrcDir dir -> dir

242+ RelativeSrcDir dir -> root </> dir

190243

191−isBadSrcDir :: FilePath -> FilePath -> IO Bool

192−isBadSrcDir root dir =

193− not <$> Dir.doesDirectoryExist (root </> dir)

244+

245+detectDuplicates :: FilePath -> [SrcDir] -> IO (Maybe (FilePath, (FilePath, FilePath)))

246+detectDuplicates root srcDirs =

247+ do pairs <- traverse (toPair root) srcDirs

248+ return $ Map.lookupMin $ Map.mapMaybe isDup $

249+ Map.fromListWith OneOrMore.more pairs

250+

251+

252+toPair :: FilePath -> SrcDir -> IO (FilePath, OneOrMore.OneOrMore FilePath)

253+toPair root srcDir =

254+ do key <- Dir.canonicalizePath (toAbsolute root srcDir)

255+ return (key, OneOrMore.one (toGiven srcDir))

256+

257+

258+isDup :: OneOrMore.OneOrMore FilePath -> Maybe (FilePath, FilePath)

259+isDup paths =

260+ case paths of

261+ OneOrMore.One _ -> Nothing

262+ OneOrMore.More a b -> Just (OneOrMore.getFirstTwo a b)

194263

195264

196265

@@ -268,9 +337,16 @@ depsDecoder valueDecoder =

268337 D.dict (Pkg.keyDecoder Exit.OP_BadDependencyName) valueDecoder

269338

270339

271−dirsDecoder :: Decoder (NE.List FilePath)

340+dirsDecoder :: Decoder (NE.List SrcDir)

272341dirsDecoder =

273− 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

274350

275351

276352

@@ -311,3 +387,21 @@ boundParser bound tooLong =

311387 if len < bound

312388 then cok (Json.fromPtr pos end) (P.State src end end indent row newCol)

313389 else cerr row newCol (\_ _ -> tooLong)

390+

391+

392+

393+-- BINARY

394+

395+

396+instance Binary SrcDir where

397+ put outline =

398+ case outline of

399+ AbsoluteSrcDir a -> putWord8 0 >> put a

400+ RelativeSrcDir a -> putWord8 1 >> put a

401+

402+ get =

403+ do n <- getWord8

404+ case n of

405+ 0 -> liftM AbsoluteSrcDir get

406+ 1 -> liftM RelativeSrcDir get

407+ _ -> fail "binary encoding of SrcDir was corrupted"

builder/src/File.hs+28−5

@@ -1,6 +1,7 @@

11module File

22 ( Time

33 , getTime

4+ , zeroTime

45 , writeBinary

56 , readBinary

67 , writeUtf8

@@ -23,6 +24,7 @@ import qualified Data.ByteString.Builder as B

2324import qualified Data.ByteString.Lazy as LBS

2425import qualified Data.Fixed as Fixed

2526import qualified Data.List as List

27+import qualified Data.Time.Clock as Time

2628import qualified Data.Time.Clock.POSIX as Time

2729import qualified Foreign.ForeignPtr as FPtr

2830import GHC.IO.Exception (IOException, IOErrorType(InvalidArgument))

@@ -44,11 +46,15 @@ newtype Time = Time Fixed.Pico

4446getTime :: FilePath -> IO Time

4547getTime path =

4648 fmap

47− (Time . realToFrac . Time.utcTimeToPOSIXSeconds)

48−-- TODO (Time . Time.nominalDiffTimeToSeconds . Time.utcTimeToPOSIXSeconds)

49+ (Time . Time.nominalDiffTimeToSeconds . Time.utcTimeToPOSIXSeconds)

4950 (Dir.getModificationTime path)

5051

5152

53+zeroTime :: Time

54+zeroTime =

55+ Time 0

56+

57+

5258instance Binary.Binary Time where

5359 put (Time time) = Binary.put time

5460 get = Time <$> Binary.get

@@ -72,8 +78,21 @@ readBinary path =

7278 then

7379 do result <- Binary.decodeFileOrFail path

7480 case result of

75− Right a -> return (Just a)

76− Left e -> return Nothing

81+ Right a ->

82+ return (Just a)

83+

84+ Left (offset, message) ->

85+ do IO.hPutStrLn IO.stderr $ unlines $

86+ [ "+-------------------------------------------------------------------------------"

87+ , "| Corrupt File: " ++ path

88+ , "| Byte Offset: " ++ show offset

89+ , "| Message: " ++ message

90+ , "|"

91+ , "| Please report this to https://github.com/elm/compiler/issues"

92+ , "| Trying to continue anyway."

93+ , "+-------------------------------------------------------------------------------"

94+ ]

95+ return Nothing

7796 else

7897 return Nothing

7998

@@ -171,7 +190,11 @@ writeEntry destination root entry =

171190 let

172191 path = drop root (Zip.eRelativePath entry)

173192 in

174− if path == "LICENSE" || List.isPrefixOf "src/" path then

193+ if List.isPrefixOf "src/" path

194+ || path == "LICENSE"

195+ || path == "README.md"

196+ || path == "elm.json"

197+ then

175198 if not (null path) && last path == '/'

176199 then Dir.createDirectoryIfMissing True (destination </> path)

177200 else LBS.writeFile (destination </> path) (Zip.fromEntry entry)

builder/src/Generate.hsnew file+211

@@ -0,0 +1,211 @@

1+{-# LANGUAGE BangPatterns #-}

2+module Generate

3+ ( debug

4+ , dev

5+ , prod

6+ , repl

7+ )

8+ where

9+

10+

11+import Prelude hiding (cycle, print)

12+import Control.Concurrent (MVar, forkIO, newEmptyMVar, newMVar, putMVar, readMVar)

13+import Control.Monad (liftM2)

14+import qualified Data.ByteString.Builder as B

15+import Data.Map ((!))

16+import qualified Data.Map as Map

17+import qualified Data.Maybe as Maybe

18+import qualified Data.Name as N

19+import qualified Data.NonEmptyList as NE

20+

21+import qualified AST.Optimized as Opt

22+import qualified Build

23+import qualified Elm.Compiler.Type.Extract as Extract

24+import qualified Elm.Details as Details

25+import qualified Elm.Interface as I

26+import qualified Elm.ModuleName as ModuleName

27+import qualified Elm.Package as Pkg

28+import qualified File

29+import qualified Generate.JavaScript as JS

30+import qualified Generate.Mode as Mode

31+import qualified Nitpick.Debug as Nitpick

32+import qualified Reporting.Exit as Exit

33+import qualified Reporting.Task as Task

34+import qualified Stuff

35+

36+

37+-- NOTE: This is used by Make, Repl, and Reactor right now. But it may be

38+-- desireable to have Repl and Reactor to keep foreign objects in memory

39+-- to make things a bit faster?

40+

41+

42+

43+-- GENERATORS

44+

45+

46+type Task a =

47+ Task.Task Exit.Generate a

48+

49+

50+debug :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder

51+debug root details (Build.Artifacts pkg ifaces roots modules) =

52+ do loading <- loadObjects root details modules

53+ types <- loadTypes root ifaces modules

54+ objects <- finalizeObjects loading

55+ let mode = Mode.Dev (Just types)

56+ let graph = objectsToGlobalGraph objects

57+ let mains = gatherMains pkg objects roots

58+ return $ JS.generate mode graph mains

59+

60+

61+dev :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder

62+dev root details (Build.Artifacts pkg _ roots modules) =

63+ do objects <- finalizeObjects =<< loadObjects root details modules

64+ let mode = Mode.Dev Nothing

65+ let graph = objectsToGlobalGraph objects

66+ let mains = gatherMains pkg objects roots

67+ return $ JS.generate mode graph mains

68+

69+

70+prod :: FilePath -> Details.Details -> Build.Artifacts -> Task B.Builder

71+prod root details (Build.Artifacts pkg _ roots modules) =

72+ do objects <- finalizeObjects =<< loadObjects root details modules

73+ checkForDebugUses objects

74+ let graph = objectsToGlobalGraph objects

75+ let mode = Mode.Prod (Mode.shortenFieldNames graph)

76+ let mains = gatherMains pkg objects roots

77+ return $ JS.generate mode graph mains

78+

79+

80+repl :: FilePath -> Details.Details -> Bool -> Build.ReplArtifacts -> N.Name -> Task B.Builder

81+repl root details ansi (Build.ReplArtifacts home modules localizer annotations) name =

82+ do objects <- finalizeObjects =<< loadObjects root details modules

83+ let graph = objectsToGlobalGraph objects

84+ return $ JS.generateForRepl ansi localizer graph home name (annotations ! name)

85+

86+

87+

88+-- CHECK FOR DEBUG

89+

90+

91+checkForDebugUses :: Objects -> Task ()

92+checkForDebugUses (Objects _ locals) =

93+ case Map.keys (Map.filter Nitpick.hasDebugUses locals) of

94+ [] -> return ()

95+ m:ms -> Task.throw (Exit.GenerateCannotOptimizeDebugValues m ms)

96+

97+

98+

99+-- GATHER MAINS

100+

101+

102+gatherMains :: Pkg.Name -> Objects -> NE.List Build.Root -> Map.Map ModuleName.Canonical Opt.Main

103+gatherMains pkg (Objects _ locals) roots =

104+ Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList roots)

105+

106+

107+lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Root -> Maybe (ModuleName.Canonical, Opt.Main)

108+lookupMain pkg locals root =

109+ let

110+ toPair name (Opt.LocalGraph maybeMain _ _) =

111+ (,) (ModuleName.Canonical pkg name) <$> maybeMain

112+ in

113+ case root of

114+ Build.Inside name -> toPair name =<< Map.lookup name locals

115+ Build.Outside name _ g -> toPair name g

116+

117+

118+

119+-- LOADING OBJECTS

120+

121+

122+data LoadingObjects =

123+ LoadingObjects

124+ { _foreign_mvar :: MVar (Maybe Opt.GlobalGraph)

125+ , _local_mvars :: Map.Map ModuleName.Raw (MVar (Maybe Opt.LocalGraph))

126+ }

127+

128+

129+loadObjects :: FilePath -> Details.Details -> [Build.Module] -> Task LoadingObjects

130+loadObjects root details modules =

131+ Task.io $

132+ do mvar <- Details.loadObjects root details

133+ mvars <- traverse (loadObject root) modules

134+ return $ LoadingObjects mvar (Map.fromList mvars)

135+

136+

137+loadObject :: FilePath -> Build.Module -> IO (ModuleName.Raw, MVar (Maybe Opt.LocalGraph))

138+loadObject root modul =

139+ case modul of

140+ Build.Fresh name _ graph ->

141+ do mvar <- newMVar (Just graph)

142+ return (name, mvar)

143+

144+ Build.Cached name _ _ ->

145+ do mvar <- newEmptyMVar

146+ _ <- forkIO $ putMVar mvar =<< File.readBinary (Stuff.elmo root name)

147+ return (name, mvar)

148+

149+

150+

151+-- FINALIZE OBJECTS

152+

153+

154+data Objects =

155+ Objects

156+ { _foreign :: Opt.GlobalGraph

157+ , _locals :: Map.Map ModuleName.Raw Opt.LocalGraph

158+ }

159+

160+

161+finalizeObjects :: LoadingObjects -> Task Objects

162+finalizeObjects (LoadingObjects mvar mvars) =

163+ Task.eio id $

164+ do result <- readMVar mvar

165+ results <- traverse readMVar mvars

166+ case liftM2 Objects result (sequence results) of

167+ Just loaded -> return (Right loaded)

168+ Nothing -> return (Left Exit.GenerateCannotLoadArtifacts)

169+

170+

171+objectsToGlobalGraph :: Objects -> Opt.GlobalGraph

172+objectsToGlobalGraph (Objects globals locals) =

173+ foldr Opt.addLocalGraph globals locals

174+

175+

176+

177+-- LOAD TYPES

178+

179+

180+loadTypes :: FilePath -> Map.Map ModuleName.Canonical I.DependencyInterface -> [Build.Module] -> Task Extract.Types

181+loadTypes root ifaces modules =

182+ Task.eio id $

183+ do mvars <- traverse (loadTypesHelp root) modules

184+ let !foreigns = Extract.mergeMany (Map.elems (Map.mapWithKey Extract.fromDependencyInterface ifaces))

185+ results <- traverse readMVar mvars

186+ case sequence results of

187+ Just ts -> return (Right (Extract.merge foreigns (Extract.mergeMany ts)))

188+ Nothing -> return (Left Exit.GenerateCannotLoadArtifacts)

189+

190+

191+loadTypesHelp :: FilePath -> Build.Module -> IO (MVar (Maybe Extract.Types))

192+loadTypesHelp root modul =

193+ case modul of

194+ Build.Fresh name iface _ ->

195+ newMVar (Just (Extract.fromInterface name iface))

196+

197+ Build.Cached name _ ciMVar ->

198+ do cachedInterface <- readMVar ciMVar

199+ case cachedInterface of

200+ Build.Unneeded ->

201+ do mvar <- newEmptyMVar

202+ _ <- forkIO $

203+ do maybeIface <- File.readBinary (Stuff.elmi root name)

204+ putMVar mvar (Extract.fromInterface name <$> maybeIface)

205+ return mvar

206+

207+ Build.Loaded iface ->

208+ newMVar (Just (Extract.fromInterface name iface))

209+

210+ Build.Corrupted ->

211+ newMVar Nothing

builder/src/Http.hs+1−1

@@ -241,4 +241,4 @@ jsonPart name filePath value =

241241

242242stringPart :: String -> String -> Multi.Part

243243stringPart name string =

244− Multi.partBS (String.fromString name) (BS.pack string)

244+ Multi.partBS (String.fromString name) (BS.pack string)

builder/src/Reporting.hs+15−12

@@ -33,7 +33,7 @@ import qualified Data.ByteString.Builder as B

3333import qualified Data.NonEmptyList as NE

3434import qualified System.Exit as Exit

3535import qualified System.Info as Info

36−import System.IO (hFlush, hPutStr, stderr, stdout)

36+import System.IO (hFlush, hPutStr, hPutStrLn, stderr, stdout)

3737

3838import qualified Elm.ModuleName as ModuleName

3939import qualified Elm.Package as Pkg

@@ -364,10 +364,10 @@ toFinalMessage done result =

364364

365365 Left problem ->

366366 case problem of

367− Exit.BuildModuleProblems _ [] ->

367+ Exit.BuildBadModules _ _ [] ->

368368 "Detected problems in 1 module."

369369

370− Exit.BuildModuleProblems _ (_:ps) ->

370+ Exit.BuildBadModules _ _ (_:ps) ->

371371 "Detected problems in " ++ show (2 + length ps) ++ " modules."

372372

373373 Exit.BuildProjectProblem _ ->

@@ -446,20 +446,23 @@ reportExceptionsNicely e =

446446

447447

448448putException :: SomeException -> IO ()

449−putException e =

449+putException e = do

450+ hPutStrLn stderr ""

450451 Help.toStderr $ D.stack $

451− [ D.reflow $

452− "Oh no! I ran into something that bypassed the normal error reporting process!\

452+ [ D.dullyellow "-- ERROR -----------------------------------------------------------------------"

453+ , D.reflow $

454+ "I ran into something that bypassed the normal error reporting process!\

453455 \ I extracted whatever information I could from the internal error:"

454456 , D.vcat $ map (\line -> D.red ">" <> " " <> D.fromChars line) (lines (show e))

455457 , D.reflow $

456− "These errors are usually pretty confusing, so start by asking around on Slack\

457− \ or Discourse to see if anyone can get you unstuck quickly."

458− , "------------------------------------------------------------"

458+ "These errors are usually pretty confusing, so start by asking around on one of\

459+ \ forums listed at https://elm-lang.org/community to see if anyone can get you\

460+ \ unstuck quickly."

461+ , D.dullyellow "-- REQUEST ---------------------------------------------------------------------"

459462 , D.reflow $

460− "From there, if you are feeling up to it, please try to get your code down to the\

461− \ smallest version that still triggers this message. Ideally in a single Main.elm\

462− \ and elm.json file."

463+ "If you are feeling up to it, please try to get your code down to the smallest\

464+ \ version that still triggers this message. Ideally in a single Main.elm and\

465+ \ elm.json file."

463466 , D.reflow $

464467 "From there open a NEW issue at https://github.com/elm/compiler/issues with\

465468 \ your reduced example pasted in directly. (Not a link to a repo or gist!) Do not\

builder/src/Reporting/Exit.hs+1395−269

@@ -1,36 +1,26 @@

11{-# LANGUAGE OverloadedStrings #-}

22module Reporting.Exit

3− ( Init(..)

4− , initToReport

5− --

6− , Diff(..)

7− , diffToReport

8− --

9− , Bump(..)

10− , bumpToReport

3+ ( Init(..), initToReport

4+ , Diff(..), diffToReport

5+ , Make(..), makeToReport

6+ , Bump(..), bumpToReport

7+ , Repl(..), replToReport

8+ , Publish(..), publishToReport

9+ , Install(..), installToReport

10+ , Reactor(..), reactorToReport

1111 , newPackageOverview

1212 --

13− , Publish(..)

14− , publishToReport

15− --

16− , Install(..)

17− , installToReport

18− --

1913 , Solver(..)

20− --

2114 , Outline(..)

2215 , OutlineProblem(..)

23− --

2416 , Details(..)

25− , RegistryProblem(..)

17+ , DetailsBadDep(..)

2618 , PackageProblem(..)

27− --

28− , Make(..)

19+ , RegistryProblem(..)

2920 , BuildProblem(..)

3021 , BuildProjectProblem(..)

31− , makeToReport

32− --

3322 , DocsProblem(..)

23+ , Generate(..)

3424 --

3525 , toString

3626 , toStderr

@@ -39,26 +29,56 @@ module Reporting.Exit

3929 where

4030

4131

32+import qualified Data.ByteString as BS

33+import qualified Data.ByteString.UTF8 as BS_UTF8

4234import qualified Data.List as List

35+import qualified Data.Map as Map

36+import qualified Data.Name as N

4337import qualified Data.NonEmptyList as NE

44−import qualified Data.Utf8 as Utf8

38+import qualified Network.HTTP.Client as HTTP

39+import qualified Network.HTTP.Types.Header as HTTP

40+import qualified Network.HTTP.Types.Status as HTTP

41+import qualified System.FilePath as FP

42+import System.FilePath ((</>), (<.>))

4543

4644import qualified Elm.Constraint as C

4745import qualified Elm.Magnitude as M

4846import qualified Elm.ModuleName as ModuleName

4947import qualified Elm.Package as Pkg

5048import qualified Elm.Version as V

49+import qualified File

5150import qualified Http

5251import qualified Json.Decode as Decode

5352import qualified Json.Encode as Encode

5453import qualified Json.String as Json

5554import Parse.Primitives (Row, Col)

55+import qualified Reporting.Annotation as A

5656import Reporting.Doc ((<>))

5757import qualified Reporting.Doc as D

5858import qualified Reporting.Error.Import as Import

5959import qualified Reporting.Error.Json as Json

6060import qualified Reporting.Exit.Help as Help

6161import qualified Reporting.Error as Error

62+import qualified Reporting.Render.Code as Code

63+

64+

65+

66+-- RENDERERS

67+

68+

69+toString :: Help.Report -> String

70+toString report =

71+ Help.toString (Help.reportToDoc report)

72+

73+

74+toStderr :: Help.Report -> IO ()

75+toStderr report =

76+ Help.toStderr (Help.reportToDoc report)

77+

78+

79+toJson :: Help.Report -> Encode.Value

80+toJson report =

81+ Help.reportToJson report

6282

6383

6484

@@ -89,13 +109,18 @@ initToReport exit =

89109

90110 InitNoOfflineSolution pkgs ->

91111 Help.report "NO OFFLINE SOLUTION" Nothing

92− (error "TODO InitNoOfflineSolution" pkgs)

93− (error "TODO InitNoOfflineSolution" pkgs)

94− -- note about Russia IP addresses?

95− -- ask if they are on a plane or train

112+ "I tried to create an elm.json with the following direct dependencies:"

113+ [ D.indent 4 $ D.vcat $

114+ map (D.dullyellow . D.fromChars . Pkg.toChars) pkgs

115+ , D.reflow $

116+ "I could not find compatible versions though, but that may be because I could not\

117+ \ connect to https://package.elm-lang.org to get the latest list of packages. Are\

118+ \ you able to connect to the internet? Please ask around one of the community\

119+ \ forums at https://elm-lang.org/community for help!"

120+ ]

96121

97122 InitSolverProblem solver ->

98− error "TODO InitSolverProblem" solver

123+ toSolverReport solver

99124

100125 InitAlreadyExists ->

101126 Help.report "EXISTING PROJECT" Nothing

@@ -106,8 +131,9 @@ initToReport exit =

106131 ]

107132 ]

108133

109− InitRegistryProblem _ ->

110− error "TODO InitRegistryProblem"

134+ InitRegistryProblem problem ->

135+ toRegistryProblemReport "PROBLEM LOADING PACKAGE LIST" problem $

136+ "I need the list of published packages before I can start initializing projects"

111137

112138

113139

@@ -122,8 +148,8 @@ data Diff

122148 | DiffUnpublished

123149 | DiffUnknownPackage Pkg.Name [Pkg.Name]

124150 | DiffUnknownVersion Pkg.Name V.Version [V.Version]

125− | DiffDocsProblem DocsProblem

126− | DiffBadRegistry RegistryProblem

151+ | DiffDocsProblem V.Version DocsProblem

152+ | DiffMustHaveLatestRegistry RegistryProblem

127153 | DiffBadDetails Details

128154 | DiffBadBuild BuildProblem

129155

@@ -136,16 +162,27 @@ diffToReport diff =

136162 "I cannot find an elm.json so I am not sure what you want me to diff.\

137163 \ Normally you run `elm diff` from within a project!"

138164 [ D.reflow $ "If you are just curious to see a diff, try running this command:"

139− , D.indent 4 $ D.green $ "elm diff elm/html 5.1.1 6.0.0"

165+ , D.indent 4 $ D.green $ "elm diff elm/http 1.0.0 2.0.0"

140166 ]

141167

168+ DiffBadOutline outline ->

169+ toOutlineReport outline

170+

142171 DiffApplication ->

143− Help.report "CANNOT DIFF APPLICATIONS" Nothing

144− "It looks like you are running `elm diff` on an application, but it\

145− \ only makes sense for packages that have been published. That way\

146− \ there is a fixed API to diff against."

172+ Help.report "CANNOT DIFF APPLICATIONS" (Just "elm.json")

173+ "Your elm.json says this project is an application, but `elm diff` only works\

174+ \ with packages. That way there are previously published versions of the API to\

175+ \ diff against!"

147176 [ D.reflow $ "If you are just curious to see a diff, try running this command:"

148− , D.indent 4 $ D.green $ "elm diff elm/html 5.1.1 6.0.0"

177+ , D.indent 4 $ D.dullyellow $ "elm diff elm/json 1.0.0 1.1.2"

178+ ]

179+

180+ DiffNoExposed ->

181+ Help.report "NO EXPOSED MODULES" (Just "elm.json")

182+ "Your elm.json has no \"exposed-modules\" which means there is no public API at\

183+ \ all right now! What am I supposed to diff?"

184+ [ D.reflow $

185+ "Try adding some modules back to the \"exposed-modules\" field."

149186 ]

150187

151188 DiffUnpublished ->

@@ -181,11 +218,19 @@ diffToReport diff =

181218 , "Want one of those instead?"

182219 ]

183220

184− DiffDocsProblem problem ->

185− error "TODO DiffDocsProblem" problem

221+ DiffDocsProblem version problem ->

222+ toDocsProblemReport problem $

223+ "I need the docs for " ++ V.toChars version ++ " to compute this diff"

186224

187− DiffBadRegistry problem ->

188− error "TODO DiffBadRegistry" problem

225+ DiffMustHaveLatestRegistry problem ->

226+ toRegistryProblemReport "PROBLEM UPDATING PACKAGE LIST" problem $

227+ "I need the latest list of published packages before I do this diff"

228+

229+ DiffBadDetails details ->

230+ toDetailsReport details

231+

232+ DiffBadBuild buildProblem ->

233+ toBuildProblemReport buildProblem

189234

190235

191236

@@ -199,11 +244,26 @@ data Bump

199244 | BumpUnexpectedVersion V.Version [V.Version]

200245 | BumpMustHaveLatestRegistry RegistryProblem

201246 | BumpCannotFindDocs Pkg.Name V.Version DocsProblem

247+ | BumpBadDetails Details

248+ | BumpNoExposed

249+ | BumpBadBuild BuildProblem

202250

203251

204252bumpToReport :: Bump -> Help.Report

205253bumpToReport bump =

206254 case bump of

255+ BumpNoOutline ->

256+ Help.report "BUMP WHAT?" Nothing

257+ "I cannot find an elm.json so I am not sure what you want me to bump."

258+ [ D.reflow $

259+ "Elm packages always have an elm.json that says current the version number. If\

260+ \ you run this command from a directory with an elm.json file, I will try to bump\

261+ \ the version in there based on the API changes."

262+ ]

263+

264+ BumpBadOutline outline ->

265+ toOutlineReport outline

266+

207267 BumpApplication ->

208268 Help.report "CANNOT BUMP APPLICATIONS" (Just "elm.json")

209269 "Your elm.json says this is an application. That means it cannot be published\

@@ -227,10 +287,30 @@ bumpToReport bump =

227287 ]

228288

229289 BumpMustHaveLatestRegistry problem ->

230− error "TODO BumpMustHaveLatestRegistry" problem

290+ toRegistryProblemReport "PROBLEM UPDATING PACKAGE LIST" problem $

291+ "I need the latest list of published packages before I can bump any versions"

292+

293+ BumpCannotFindDocs _ version problem ->

294+ toDocsProblemReport problem $

295+ "I need the docs for " ++ V.toChars version ++ " to compute the next version number"

231296

232− BumpCannotFindDocs name version problem ->

233− error "TODO BumpCannotFindDocs" name version problem

297+ BumpBadDetails details ->

298+ toDetailsReport details

299+

300+ BumpNoExposed ->

301+ Help.docReport "NO EXPOSED MODULES" (Just "elm.json")

302+ ( D.fillSep $

303+ [ "To", "bump", "a", "package,", "the"

304+ , D.dullyellow "\"exposed-modules\"", "field", "of", "your"

305+ , "elm.json", "must", "list", "at", "least", "one", "module."

306+ ]

307+ )

308+ [ D.reflow $

309+ "Try adding some modules back to the \"exposed-modules\" field."

310+ ]

311+

312+ BumpBadBuild problem ->

313+ toBuildProblemReport problem

234314

235315

236316

@@ -264,6 +344,7 @@ newPackageOverview =

264344data Publish

265345 = PublishNoOutline

266346 | PublishBadOutline Outline

347+ | PublishBadDetails Details

267348 | PublishMustHaveLatestRegistry RegistryProblem

268349 | PublishApplication

269350 | PublishNotInitialVersion V.Version

@@ -275,27 +356,43 @@ data Publish

275356 | PublishNoReadme

276357 | PublishShortReadme

277358 | PublishNoLicense

278− | PublishCannotGetTag Http.Error

359+ | PublishBuildProblem BuildProblem

360+ | PublishMissingTag V.Version

361+ | PublishCannotGetTag V.Version Http.Error

362+ | PublishCannotGetTagData V.Version String BS.ByteString

279363 | PublishCannotGetZip Http.Error

280− | PublishCannotDecodeZip

281− | PublishCannotGetDocs DocsProblem

364+ | PublishCannotDecodeZip String

365+ | PublishCannotGetDocs V.Version V.Version DocsProblem

282366 | PublishCannotRegister Http.Error

283− | PublishMissingTag V.Version

284367 | PublishNoGit

285368 | PublishLocalChanges V.Version

369+ --

370+ | PublishZipBadDetails Details

371+ | PublishZipApplication

372+ | PublishZipNoExposed

373+ | PublishZipBuildProblem BuildProblem

286374

287375

288376publishToReport :: Publish -> Help.Report

289377publishToReport publish =

290378 case publish of

291379 PublishNoOutline ->

292− error "TODO PublishNoOutline"

380+ Help.report "PUBLISH WHAT?" Nothing

381+ "I cannot find an elm.json so I am not sure what you want me to publish."

382+ [ D.reflow $

383+ "Elm packages always have an elm.json that states the version number,\

384+ \ dependencies, exposed modules, etc."

385+ ]

293386

294− PublishBadOutline problem ->

295− error "TODO PublishBadOutline" problem

387+ PublishBadOutline outline ->

388+ toOutlineReport outline

389+

390+ PublishBadDetails problem ->

391+ toDetailsReport problem

296392

297393 PublishMustHaveLatestRegistry problem ->

298− error "TODO PublishMustHaveLatestRegistry" problem

394+ toRegistryProblemReport "PROBLEM UPDATING PACKAGE LIST" problem $

395+ "I need the latest list of published packages to make sure this is safe to publish"

299396

300397 PublishApplication ->

301398 Help.report "UNPUBLISHABLE" Nothing "I cannot publish applications, only packages!" []

@@ -400,7 +497,8 @@ publishToReport publish =

400497 ]

401498 )

402499 [ D.reflow $

403− "What is the point of a package that has no modules?!"

500+ "Which modules do you want users of the package to have access to? Add their\

501+ \ names to the \"exposed-modules\" list."

404502 ]

405503

406504 PublishNoReadme ->

@@ -426,20 +524,8 @@ publishToReport publish =

426524 \ named LICENSE. Add that file and you will be all set!"

427525 ]

428526

429− PublishCannotGetTag httpError ->

430− error "TODO PublishCannotGetTag" httpError

431−

432− PublishCannotGetZip httpError ->

433− error "TODO PublishCannotGetZip" httpError

434−

435− PublishCannotDecodeZip ->

436− error "TODO PublishCannotDecodeZip"

437−

438− PublishCannotGetDocs docsProblem ->

439− error "TODO PublishCannotGetDocs" docsProblem

440−

441− PublishCannotRegister httpError ->

442− error "TODO PublishCannotRegister" httpError

527+ PublishBuildProblem buildProblem ->

528+ toBuildProblemReport buildProblem

443529

444530 PublishMissingTag version ->

445531 let vsn = V.toChars version in

@@ -460,6 +546,70 @@ publishToReport publish =

460546 , "The -m flag is for a helpful message. Try to make it more informative!"

461547 ]

462548

549+ PublishCannotGetTag version httpError ->

550+ case httpError of

551+ Http.BadHttp _ (HTTP.StatusCodeException response _)

552+ | HTTP.statusCode (HTTP.responseStatus response) == 404 ->

553+ let vsn = V.toChars version in

554+ Help.report "NO TAG ON GITHUB" Nothing

555+ ("You have version " ++ vsn ++ " tagged locally, but not on GitHub.")

556+ [ D.reflow

557+ "Run the following command to make this tag available on GitHub:"

558+ , D.indent 4 $ D.dullyellow $ D.fromChars $

559+ "git push origin " ++ vsn

560+ , D.reflow

561+ "This will make it possible to find your code online based on the version number."

562+ ]

563+

564+ _ ->

565+ toHttpErrorReport "PROBLEM VERIFYING TAG" httpError

566+ "I need to check that the version tag is registered on GitHub"

567+

568+ PublishCannotGetTagData version url body ->

569+ Help.report "PROBLEM VERIFYING TAG" Nothing

570+ ("I need to check that version " ++ V.toChars version ++ " is tagged on GitHub, so I fetched:")

571+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

572+ , D.reflow $

573+ "I got the data back, but it was not what I was expecting. The response\

574+ \ body contains " ++ show (BS.length body) ++ " bytes. Here is the "

575+ ++ if BS.length body <= 76 then "whole thing:" else "beginning:"

576+ , D.indent 4 $ D.dullyellow $ D.fromChars $

577+ if BS.length body <= 76

578+ then BS_UTF8.toString body

579+ else take 73 (BS_UTF8.toString body) ++ "..."

580+ , D.reflow $

581+ "Does this error keep showing up? Maybe there is something weird with your\

582+ \ internet connection. We have gotten reports that schools, businesses,\

583+ \ airports, etc. sometimes intercept requests and add things to the body\

584+ \ or change its contents entirely. Could that be the problem?"

585+ ]

586+

587+ PublishCannotGetZip httpError ->

588+ toHttpErrorReport "PROBLEM DOWNLOADING CODE" httpError $

589+ "I need to check that folks can download and build the source code when they\

590+ \ install this package"

591+

592+ PublishCannotDecodeZip url ->

593+ Help.report "PROBLEM DOWNLOADING CODE" Nothing

594+ "I need to check that folks can download and build the source code when they\

595+ \ install this package, so I downloaded the code from:"

596+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

597+ , D.reflow $

598+ "I was unable to unzip the archive though. Maybe there is something weird with\

599+ \ your internet connection. We have gotten reports that schools, businesses,\

600+ \ airports, etc. sometimes intercept requests and add things to the body or\

601+ \ change its contents entirely. Could that be the problem?"

602+ ]

603+

604+ PublishCannotGetDocs old new docsProblem ->

605+ toDocsProblemReport docsProblem $

606+ "I need the docs for " ++ V.toChars old ++ " to verify that "

607+ ++ V.toChars new ++ " really does come next"

608+

609+ PublishCannotRegister httpError ->

610+ toHttpErrorReport "PROBLEM PUBLISHING PACKAGE" httpError $

611+ "I need to send information about your package to the package website"

612+

463613 PublishNoGit ->

464614 Help.report "NO GIT" Nothing

465615 "I searched your PATH environment variable for `git` and could not\

@@ -489,6 +639,18 @@ publishToReport publish =

489639 ++ vsn ++ "` and publish your code from there."

490640 ]

491641

642+ PublishZipBadDetails _ ->

643+ badZipReport

644+

645+ PublishZipApplication ->

646+ badZipReport

647+

648+ PublishZipNoExposed ->

649+ badZipReport

650+

651+ PublishZipBuildProblem _ ->

652+ badZipReport

653+

492654

493655toBadReadmeReport :: String -> String -> Help.Report

494656toBadReadmeReport title summary =

@@ -504,12 +666,24 @@ toBadReadmeReport title summary =

504666 \ most common usage scenario. Show people what they can expect if\

505667 \ they learn more!"

506668 , D.toSimpleNote $

507− "By publishing your package, you are inviting people to invest time\

508− \ in understanding your work. Spending an hour to communicate your\

509− \ knowledge more clearly can save the community days or weeks of time\

510− \ in aggregate, and saving time in aggregate is the whole point of\

511− \ publishing packages! People really appreciate it, and it makes the\

512− \ whole ecosystem feel nicer!"

669+ "By publishing your package, you are inviting people to invest time in\

670+ \ understanding your work. Spending an hour on your README to communicate your\

671+ \ knowledge more clearly can save the community days or weeks of time in\

672+ \ aggregate, and saving time in aggregate is the whole point of publishing\

673+ \ packages! People really appreciate it, and it makes the whole ecosystem feel\

674+ \ nicer!"

675+ ]

676+

677+

678+badZipReport :: Help.Report

679+badZipReport =

680+ Help.report "PROBLEM VERIFYING PACKAGE" Nothing

681+ "Before publishing packages, I download the code from GitHub and try to build it\

682+ \ from scratch. That way I can be more confident that it will work for other\

683+ \ people too. But I am not able to build it!"

684+ [ D.reflow $

685+ "I was just able to build your local copy though. Is there some way the version\

686+ \ on GitHub could be different?"

513687 ]

514688

515689

@@ -519,35 +693,80 @@ toBadReadmeReport title summary =

519693

520694data DocsProblem

521695 = DP_Http Http.Error

522− | DP_Data

696+ | DP_Data String BS.ByteString

523697 | DP_Cache

524698

525699

700+toDocsProblemReport :: DocsProblem -> String -> Help.Report

701+toDocsProblemReport problem context =

702+ case problem of

703+ DP_Http httpError ->

704+ toHttpErrorReport "PROBLEM LOADING DOCS" httpError context

705+

706+ DP_Data url body ->

707+ Help.report "PROBLEM LOADING DOCS" Nothing (context ++ ", so I fetched:")

708+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

709+ , D.reflow $

710+ "I got the data back, but it was not what I was expecting. The response\

711+ \ body contains " ++ show (BS.length body) ++ " bytes. Here is the "

712+ ++ if BS.length body <= 76 then "whole thing:" else "beginning:"

713+ , D.indent 4 $ D.dullyellow $ D.fromChars $

714+ if BS.length body <= 76

715+ then BS_UTF8.toString body

716+ else take 73 (BS_UTF8.toString body) ++ "..."

717+ , D.reflow $

718+ "Does this error keep showing up? Maybe there is something weird with your\

719+ \ internet connection. We have gotten reports that schools, businesses,\

720+ \ airports, etc. sometimes intercept requests and add things to the body\

721+ \ or change its contents entirely. Could that be the problem?"

722+ ]

723+

724+ DP_Cache ->

725+ Help.report "PROBLEM LOADING DOCS" Nothing (context ++ ", but the local copy seems to be corrupted.")

726+ [ D.reflow $

727+ "I deleted the cached version, so the next run should download a fresh copy of\

728+ \ the docs. Hopefully that will get you unstuck, but it will not resolve the root\

729+ \ problem if, for example, a 3rd party editor plugin is modifing cached files\

730+ \ for some reason."

731+ ]

732+

733+

526734

527735-- INSTALL

528736

529737

530738data Install

531− = InstallNoProject

739+ = InstallNoOutline

740+ | InstallBadOutline Outline

741+ | InstallBadRegistry RegistryProblem

532742 | InstallNoArgs FilePath

533− | InstallNoOnlineSolution

534− | InstallNoOfflineSolution

743+ | InstallNoOnlineAppSolution Pkg.Name

744+ | InstallNoOfflineAppSolution Pkg.Name

745+ | InstallNoOnlinePkgSolution Pkg.Name

746+ | InstallNoOfflinePkgSolution Pkg.Name

535747 | InstallHadSolverTrouble Solver

536− | InstallUnknownPackageOnline [Pkg.Name]

537− | InstallUnknownPackageOffline [Pkg.Name]

538− | InstallHasBadDetails Details

748+ | InstallUnknownPackageOnline Pkg.Name [Pkg.Name]

749+ | InstallUnknownPackageOffline Pkg.Name [Pkg.Name]

750+ | InstallBadDetails Details

539751

540752

541753installToReport :: Install -> Help.Report

542754installToReport exit =

543755 case exit of

544− InstallNoProject ->

756+ InstallNoOutline ->

545757 Help.report "NEW PROJECT?" Nothing

546758 "Are you trying to start a new project? Try this command instead:"

547759 [ D.indent 4 $ D.green "elm init"

548760 , D.reflow "It will help you get started!"

549761 ]

550762

763+ InstallBadOutline outline ->

764+ toOutlineReport outline

765+

766+ InstallBadRegistry problem ->

767+ toRegistryProblemReport "PROBLEM LOADING PACKAGE LIST" problem $

768+ "I need the list of published packages to figure out how to install things"

769+

551770 InstallNoArgs elmHome ->

552771 Help.report "INSTALL WHAT?" Nothing

553772 "I am expecting commands like:"

@@ -571,50 +790,109 @@ installToReport exit =

571790 ]

572791 ]

573792

574− InstallNoOnlineSolution ->

575− Help.report "UNSOLVABLE DEPENDENCIES" (Just "elm.json") -- TODO recommend using solver in `elm reactor`

576− "This usually happens if you try to modify dependency constraints by\

577− \ hand. I recommend deleting any dependency you added recently (or all\

578− \ of them if things are bad) and then adding them again with:"

579− [ D.indent 4 $ D.green "elm install"

793+ InstallNoOnlineAppSolution pkg ->

794+ Help.report "CANNOT FIND COMPATIBLE VERSION" (Just "elm.json")

795+ (

796+ "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\

797+ \ with your existing dependencies."

798+ )

799+ [ D.reflow $

800+ "I checked all the published versions. When that failed, I tried to find any\

801+ \ compatible combination of these packages, even if it meant changing all your\

802+ \ existing dependencies! That did not work either!"

580803 , D.reflow $

581− "And do not be afaid to ask for help on Slack if you get stuck!"

804+ "This is most likely to happen when a package is not upgraded yet. Maybe a new\

805+ \ version of Elm came out recently? Maybe a common package was changed recently?\

806+ \ Maybe a better package came along, so there was no need to upgrade this one?\

807+ \ Try asking around https://elm-lang.org/community to learn what might be going on\

808+ \ with this package."

809+ , D.toSimpleNote $

810+ "Whatever the case, please be kind to the relevant package authors! Having\

811+ \ friendly interactions with users is great motivation, and conversely, getting\

812+ \ berated by strangers on the internet sucks your soul dry. Furthermore, package\

813+ \ authors are humans with families, friends, jobs, vacations, responsibilities,\

814+ \ goals, etc. They face obstacles outside of their technical work you will never\

815+ \ know about, so please assume the best and try to be patient and supportive!"

582816 ]

583817

584− InstallNoOfflineSolution ->

585− error "TODO InstallNoOfflineSolution"

818+ InstallNoOfflineAppSolution pkg ->

819+ Help.report "CANNOT FIND COMPATIBLE VERSION LOCALLY" (Just "elm.json")

820+ (

821+ "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\

822+ \ with your existing dependencies."

823+ )

824+ [ D.reflow $

825+ "I was not able to connect to https://package.elm-lang.org/ though, so I was only\

826+ \ able to look through packages that you have downloaded in the past."

827+ , D.reflow $

828+ "Try again later when you have internet!"

829+ ]

586830

587− InstallHadSolverTrouble solver ->

588− error "TODO InstallHadSolverTrouble" solver

831+ InstallNoOnlinePkgSolution pkg ->

832+ Help.report "CANNOT FIND COMPATIBLE VERSION" (Just "elm.json")

833+ (

834+ "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\

835+ \ with your existing constraints."

836+ )

837+ [ D.reflow $

838+ "With applications, I try to broaden the constraints to see if anything works,\

839+ \ but messing with package constraints is much more delicate business. E.g. making\

840+ \ your constraints stricter may make it harder for applications to find compatible\

841+ \ dependencies. So fixing something here may break it for a lot of other people!"

842+ , D.reflow $

843+ "So I recommend making an application with the same dependencies as your package.\

844+ \ See if there is a solution at all. From there it may be easier to figure out\

845+ \ how to proceed in a way that will disrupt your users as little as possible. And\

846+ \ the solution may be to help other package authors to get their packages updated,\

847+ \ or to drop a dependency entirely."

848+ ]

589849

590− InstallUnknownPackageOnline suggestions ->

591− error "TODO InstallUnknownPackageOnline" suggestions

850+ InstallNoOfflinePkgSolution pkg ->

851+ Help.report "CANNOT FIND COMPATIBLE VERSION LOCALLY" (Just "elm.json")

852+ (

853+ "I cannot find a version of " ++ Pkg.toChars pkg ++ " that is compatible\

854+ \ with your existing constraints."

855+ )

856+ [ D.reflow $

857+ "I was not able to connect to https://package.elm-lang.org/ though, so I was only\

858+ \ able to look through packages that you have downloaded in the past."

859+ , D.reflow $

860+ "Try again later when you have internet!"

861+ ]

592862

593− InstallUnknownPackageOffline suggestions ->

594− error "TODO InstallUnknownPackageOffline" suggestions

863+ InstallHadSolverTrouble solver ->

864+ toSolverReport solver

595865

596− InstallHasBadDetails _ ->

597− error "TODO InstallHasBadDetails"

866+ InstallUnknownPackageOnline pkg suggestions ->

867+ Help.docReport "UNKNOWN PACKAGE" Nothing

868+ (

869+ D.fillSep

870+ ["I","cannot","find","a","package","named",D.red (D.fromPackage pkg) <> "."]

871+ )

872+ [ D.reflow $

873+ "I looked through https://package.elm-lang.org for packages with similar names\

874+ \ and found these:"

875+ , D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromPackage suggestions

876+ , D.reflow $ "Maybe you want one of these instead?"

877+ ]

598878

879+ InstallUnknownPackageOffline pkg suggestions ->

880+ Help.docReport "UNKNOWN PACKAGE" Nothing

881+ (

882+ D.fillSep

883+ ["I","cannot","find","a","package","named",D.red (D.fromPackage pkg) <> "."]

884+ )

885+ [ D.reflow $

886+ "I could not connect to https://package.elm-lang.org though, so new packages may\

887+ \ have been published since I last updated my local cache of package names."

888+ , D.reflow $

889+ "Looking through the locally cached names, the closest ones are:"

890+ , D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromPackage suggestions

891+ , D.reflow $ "Maybe you want one of these instead?"

892+ ]

599893

600−{- TODO detect if library has no 0.19.0 version. Maybe do this on website though?

601− Help.report "OLD DEPENDENCIES" (Just "elm.json")

602− ( "The following packages do not work with Elm " ++ V.toChars V.compiler ++ " right now:"

603− )

604− [ D.indent 4 $ D.vcat $ map (D.red . D.fromUtf8 . Pkg.toString) badPackages

605− , D.reflow $

606− "This may be because it is not upgraded yet. It may be because a\

607− \ better solution came along, so there was no need to upgrade it.\

608− \ Etc. Try asking around on Slack to learn more about the topic."

609− , D.toSimpleNote

610− "Whatever the case, please be kind to the relevant package authors! Having\

611− \ friendly interactions with users is great motivation, and conversely, getting\

612− \ berated by strangers on the internet sucks your soul dry. Furthermore, package\

613− \ authors are humans with families, friends, jobs, vacations, responsibilities,\

614− \ goals, etc. They face obstacles outside of their technical work you will never\

615− \ know about, so please assume the best and try to be patient and supportive!"

616− ]

617−-}

894+ InstallBadDetails details ->

895+ toDetailsReport details

618896

619897

620898

@@ -623,8 +901,44 @@ installToReport exit =

623901

624902data Solver

625903 = SolverBadCacheData Pkg.Name V.Version

626− | SolverBadHttpData Pkg.Name V.Version

627− | SolverBadHttp Http.Error

904+ | SolverBadHttpData Pkg.Name V.Version String

905+ | SolverBadHttp Pkg.Name V.Version Http.Error

906+

907+

908+toSolverReport :: Solver -> Help.Report

909+toSolverReport problem =

910+ case problem of

911+ SolverBadCacheData pkg vsn ->

912+ Help.report "PROBLEM SOLVING PACKAGE CONSTRAINTS" Nothing

913+ (

914+ "I need the elm.json of " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn ++ " to\

915+ \ help me search for a set of compatible packages. I had it cached locally, but\

916+ \ it looks like the file was corrupted!"

917+ )

918+ [ D.reflow $

919+ "I deleted the cached version, so the next run should download a fresh copy.\

920+ \ Hopefully that will get you unstuck, but it will not resolve the root\

921+ \ problem if a 3rd party tool is modifing cached files for some reason."

922+ ]

923+

924+ SolverBadHttpData pkg vsn url ->

925+ Help.report "PROBLEM SOLVING PACKAGE CONSTRAINTS" Nothing

926+ (

927+ "I need the elm.json of " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn ++ " to\

928+ \ help me search for a set of compatible packages, but I ran into corrupted\

929+ \ information from:"

930+ )

931+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

932+ , D.reflow $

933+ "Is something weird with your internet connection. We have gotten reports that\

934+ \ schools, businesses, airports, etc. sometimes intercept requests and add things\

935+ \ to the body or change its contents entirely. Could that be the problem?"

936+ ]

937+

938+ SolverBadHttp pkg vsn httpError ->

939+ toHttpErrorReport "PROBLEM SOLVING PACKAGE CONSTRAINTS" httpError $

940+ "I need the elm.json of " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn

941+ ++ " to help me search for a set of compatible packages"

628942

629943

630944

@@ -633,7 +947,11 @@ data Solver

633947

634948data Outline

635949 = OutlineHasBadStructure (Decode.Error OutlineProblem)

636− | OutlineHasBadSrcDirs FilePath [FilePath]

950+ | OutlineHasMissingSrcDirs FilePath [FilePath]

951+ | OutlineHasDuplicateSrcDirs FilePath FilePath FilePath

952+ | OutlineNoPkgCore

953+ | OutlineNoAppCore

954+ | OutlineNoAppJson

637955

638956

639957data OutlineProblem

@@ -649,97 +967,344 @@ data OutlineProblem

649967 | OP_NoSrcDirs

650968

651969

970+toOutlineReport :: Outline -> Help.Report

971+toOutlineReport problem =

972+ case problem of

973+ OutlineHasBadStructure decodeError ->

974+ Json.toReport "elm.json" (Json.FailureToReport toOutlineProblemReport) decodeError $

975+ Json.ExplicitReason "I ran into a problem with your elm.json file."

976+

977+ OutlineHasMissingSrcDirs dir dirs ->

978+ case dirs of

979+ [] ->

980+ Help.report "MISSING SOURCE DIRECTORY" (Just "elm.json")

981+ "I need a valid elm.json file, but the \"source-directories\" field lists the following directory:"

982+ [ D.indent 4 $ D.red $ D.fromChars dir

983+ , D.reflow $

984+ "I cannot find it though. Is it missing? Is there a typo?"

985+ ]

652986

653−-- DETAILS

654−

655−

656−data Details

657− = DetailsCorrupt

658− | DetailsNoSolution

659− | DetailsNoOfflineSolution

660− | DetailsSolverProblem Solver

661− | DetailsBadElmInPkg C.Constraint

662− | DetailsBadElmInAppOutline V.Version

663− | DetailsHandEditedDependencies

664− | DetailsBadOutline Outline

665− | DetailsCannotGetRegistry RegistryProblem

666− | DetailsCannotBuildPackage Pkg.Name V.Version PackageProblem

667−

987+ _:_ ->

988+ Help.report "MISSING SOURCE DIRECTORIES" (Just "elm.json")

989+ "I need a valid elm.json file, but the \"source-directories\" field lists the following directories:"

990+ [ D.indent 4 $ D.vcat $

991+ map (D.red . D.fromChars) (dir:dirs)

992+ , D.reflow $

993+ "I cannot find them though. Are they missing? Are there typos?"

994+ ]

668995

669−data RegistryProblem

670− = RP_Http Http.Error

671− | RP_Data

996+ OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2 ->

997+ if dir1 == dir2 then

998+ Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")

999+ "I need a valid elm.json file, but the \"source-directories\" field lists the same directory twice:"

1000+ [ D.indent 4 $ D.vcat $

1001+ map (D.red . D.fromChars) [dir1,dir2]

1002+ , D.reflow $

1003+ "Remove one of the entries!"

1004+ ]

1005+ else

1006+ Help.report "REDUNDANT SOURCE DIRECTORIES" (Just "elm.json")

1007+ "I need a valid elm.json file, but the \"source-directories\" field has some redundant directories:"

1008+ [ D.indent 4 $ D.vcat $

1009+ map (D.red . D.fromChars) [dir1,dir2]

1010+ , D.reflow $

1011+ "These are two different ways of refering to the same directory:"

1012+ , D.indent 4 $ D.dullyellow $ D.fromChars canonicalDir

1013+ , D.reflow $

1014+ "Remove one of the redundant entries from your \"source-directories\" field."

1015+ ]

1016+

1017+ OutlineNoPkgCore ->

1018+ Help.report "MISSING DEPENDENCY" (Just "elm.json")

1019+ "I need to see an \"elm/core\" dependency your elm.json file. The default imports\

1020+ \ of `List` and `Maybe` do not work without it."

1021+ [ D.reflow $

1022+ "If you modified your elm.json by hand, try to change it back! And if you are\

1023+ \ having trouble getting back to a working elm.json, it may be easier to find a\

1024+ \ working package and start fresh with their elm.json file."

1025+ ]

6721026

1027+ OutlineNoAppCore ->

1028+ Help.report "MISSING DEPENDENCY" (Just "elm.json")

1029+ "I need to see an \"elm/core\" dependency your elm.json file. The default imports\

1030+ \ of `List` and `Maybe` do not work without it."

1031+ [ D.reflow $

1032+ "If you modified your elm.json by hand, try to change it back! And if you are\

1033+ \ having trouble getting back to a working elm.json, it may be easier to delete it\

1034+ \ and use `elm init` to start fresh."

1035+ ]

6731036

674−data PackageProblem

675− = PP_BadEndpointRequest Http.Error

676− | PP_BadEndpointContent

677− | PP_BadArchiveRequest Http.Error

678− | PP_BadArchiveContent

679− | PP_BadArchiveHash String String

1037+ OutlineNoAppJson ->

1038+ Help.report "MISSING DEPENDENCY" (Just "elm.json")

1039+ "I need to see an \"elm/json\" dependency your elm.json file. It helps me handle\

1040+ \ flags and ports."

1041+ [ D.reflow $

1042+ "If you modified your elm.json by hand, try to change it back! And if you are\

1043+ \ having trouble getting back to a working elm.json, it may be easier to delete it\

1044+ \ and use `elm init` to start fresh."

1045+ ]

6801046

6811047

1048+toOutlineProblemReport :: FilePath -> Code.Source -> Json.Context -> A.Region -> OutlineProblem -> Help.Report

1049+toOutlineProblemReport path source _ region problem =

1050+ let

1051+ toHighlight row col =

1052+ Just $ A.Region (A.Position row col) (A.Position row col)

6821053

683−-- MAKE

1054+ toSnippet title highlight pair =

1055+ Help.jsonReport title (Just path) $

1056+ Code.toSnippet source region highlight pair

1057+ in

1058+ case problem of

1059+ OP_BadType ->

1060+ toSnippet "UNEXPECTED TYPE" Nothing

1061+ ( D.reflow $

1062+ "I got stuck while reading your elm.json file. I cannot handle a \"type\" like this:"

1063+ , D.fillSep

1064+ ["Try","changing","the","\"type\"","to"

1065+ ,D.green "\"application\"","or",D.green "\"package\"","instead."

1066+ ]

1067+ )

6841068

1069+ OP_BadPkgName row col ->

1070+ toSnippet "INVALID PACKAGE NAME" (toHighlight row col)

1071+ ( D.reflow $

1072+ "I got stuck while reading your elm.json file. I ran into trouble with the package name:"

1073+ , D.stack

1074+ [ D.fillSep

1075+ ["Package","names","are","always","written","as"

1076+ ,D.green "\"author/project\""

1077+ ,"so","I","am","expecting","to","see","something","like:"

1078+ ]

1079+ , D.dullyellow $ D.indent 4 $ D.vcat $

1080+ [ "\"mdgriffith/elm-ui\""

1081+ , "\"w0rm/elm-physics\""

1082+ , "\"Microsoft/elm-json-tree-view\""

1083+ , "\"FordLabs/elm-star-rating\""

1084+ , "\"1602/json-schema\""

1085+ ]

1086+ , D.reflow

1087+ "The author name should match your GitHub name exactly, and the project name\

1088+ \ needs to follow these rules:"

1089+ , D.indent 4 $ D.vcat $

1090+ [ "+--------------------------------------+-----------+-----------+"

1091+ , "| RULE | BAD | GOOD |"

1092+ , "+--------------------------------------+-----------+-----------+"

1093+ , "| only lower case, digits, and hyphens | elm-HTTP | elm-http |"

1094+ , "| no leading digits | 3D | elm-3d |"

1095+ , "| no non-ASCII characters | elm-bjørn | elm-bear |"

1096+ , "| no underscores | elm_ui | elm-ui |"

1097+ , "| no double hyphens | elm--hash | elm-hash |"

1098+ , "| no starting or ending hyphen | -elm-tar- | elm-tar |"

1099+ , "+--------------------------------------+-----------+-----------+"

1100+ ]

1101+ , D.toSimpleNote $

1102+ "These rules only apply to the project name, so you should never need\

1103+ \ to change your GitHub name!"

1104+ ]

1105+ )

6851106

686−data Make

687− = MakeNeedsOutline

688− | MakeCannotOptimizeAndDebug

689− | MakeBlockedByDetailsProblem Details

690− | MakeAppNeedsFileNames

691− | MakePkgNeedsExposing

692− | MakeMultipleFilesIntoHtml

693− | MakeNonMainFilesIntoJavaScript ModuleName.Raw [ModuleName.Raw]

694− | MakeCannotOptimizeDebugValues ModuleName.Raw [ModuleName.Raw]

695− | MakeCannotBuild BuildProblem

696− | MakeCannotLoadArtifacts

1107+ OP_BadVersion row col ->

1108+ toSnippet "PROBLEM WITH VERSION" (toHighlight row col)

1109+ ( D.reflow $

1110+ "I got stuck while reading your elm.json file. I was expecting a version number here:"

1111+ , D.fillSep

1112+ ["I","need","something","like",D.green "\"1.0.0\"","or",D.green "\"2.0.4\""

1113+ ,"that","explicitly","states","all","three","numbers!"

1114+ ]

1115+ )

6971116

1117+ OP_BadConstraint constraintError ->

1118+ case constraintError of

1119+ C.BadFormat row col ->

1120+ toSnippet "PROBLEM WITH CONSTRAINT" (toHighlight row col)

1121+ ( D.reflow $

1122+ "I got stuck while reading your elm.json file. I do not understand this version constraint:"

1123+ , D.stack

1124+ [ D.fillSep

1125+ ["I","need","something","like",D.green "\"1.0.0 <= v < 2.0.0\""

1126+ ,"that","explicitly","lists","the","lower","and","upper","bounds."

1127+ ]

1128+ , D.toSimpleNote $

1129+ "The spaces in there are required! Taking them out will confuse me. Adding\

1130+ \ extra spaces confuses me too. I recommend starting with a valid example\

1131+ \ and just changing the version numbers."

1132+ ]

1133+ )

1134+

1135+ C.InvalidRange before after ->

1136+ if before == after then

1137+ toSnippet "PROBLEM WITH CONSTRAINT" Nothing

1138+ ( D.reflow $

1139+ "I got stuck while reading your elm.json file. I ran into an invalid version constraint:"

1140+ , D.fillSep

1141+ ["Elm","checks","that","all","package","APIs","follow","semantic","versioning,"

1142+ ,"so","it","is","best","to","use","wide","constraints.","I","recommend"

1143+ ,D.green $ "\"" <> D.fromVersion before <> " <= v < " <> D.fromVersion (V.bumpMajor after) <> "\""

1144+ ,"since","it","is","guaranteed","that","breaking","API","changes","cannot"

1145+ ,"happen","in","any","of","the","versions","in","that","range."

1146+ ]

1147+ )

1148+

1149+ else

1150+ toSnippet "PROBLEM WITH CONSTRAINT" Nothing

1151+ ( D.reflow $

1152+ "I got stuck while reading your elm.json file. I ran into an invalid version constraint:"

1153+ , D.fillSep

1154+ ["Maybe","you","want","something","like"

1155+ ,D.green $ "\"" <> D.fromVersion before <> " <= v < " <> D.fromVersion (V.bumpMajor before) <> "\""

1156+ ,"instead?","Elm","checks","that","all","package","APIs","follow","semantic"

1157+ ,"versioning,","so","it","is","guaranteed","that","breaking","API","changes"

1158+ ,"cannot","happen","in","any","of","the","versions","in","that","range."

1159+ ]

1160+ )

6981161

699−data BuildProblem

700− = BuildModuleProblems Error.Module [Error.Module]

701− | BuildProjectProblem BuildProjectProblem

1162+ OP_BadModuleName row col ->

1163+ toSnippet "PROBLEM WITH MODULE NAME" (toHighlight row col)

1164+ ( D.reflow $

1165+ "I got stuck while reading your elm.json file. I was expecting a module name here:"

1166+ , D.fillSep

1167+ ["I","need","something","like",D.green "\"Html.Events\""

1168+ ,"or",D.green "\"Browser.Navigation\""

1169+ ,"where","each","segment","starts","with","a","capital"

1170+ ,"letter","and","the","segments","are","separated","by","dots."

1171+ ]

1172+ )

7021173

1174+ OP_BadModuleHeaderTooLong ->

1175+ toSnippet "HEADER TOO LONG" Nothing

1176+ ( D.reflow $

1177+ "I got stuck while reading your elm.json file. This section header is too long:"

1178+ , D.stack

1179+ [ D.fillSep

1180+ ["I","need","it","to","be"

1181+ ,D.green "under",D.green "20",D.green "bytes"

1182+ ,"so","it","renders","nicely","on","the","package","website!"

1183+ ]

1184+ , D.toSimpleNote

1185+ "I count the length in bytes, so using non-ASCII characters costs extra.\

1186+ \ Please report your case at https://github.com/elm/compiler/issues if this seems\

1187+ \ overly restrictive for your needs."

1188+ ]

1189+ )

7031190

704−data BuildProjectProblem

705− = BP_PathUnknown FilePath

706− | BP_WithBadExtension FilePath

707− | BP_WithAmbiguousSrcDir FilePath FilePath

708− | BP_MainPathDuplicate FilePath FilePath

709− | BP_MainNameDuplicate ModuleName.Raw FilePath FilePath

710− | BP_CannotLoadDependencies

711− | BP_Cycle ModuleName.Raw [ModuleName.Raw]

712− | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))

1191+ OP_BadDependencyName row col ->

1192+ toSnippet "PROBLEM WITH DEPENDENCY NAME" (toHighlight row col)

1193+ ( D.reflow $

1194+ "I got stuck while reading your elm.json file. There is something wrong with this dependency name:"

1195+ , D.stack

1196+ [ D.fillSep

1197+ ["Package","names","always","include","the","name","of","the","author,"

1198+ ,"so","I","am","expecting","to","see","dependencies","like"

1199+ ,D.dullyellow "\"mdgriffith/elm-ui\"","and"

1200+ ,D.dullyellow "\"Microsoft/elm-json-tree-view\"" <> "."

1201+ ]

1202+ , D.fillSep $

1203+ ["I","generally","recommend","finding","the","package","you","want","on"

1204+ ,"the","package","website,","and","installing","it","with","the"

1205+ ,D.green "elm install","command!"

1206+ ]

1207+ ]

1208+ )

7131209

1210+ OP_BadLicense _ suggestions ->

1211+ toSnippet "UNKNOWN LICENSE" Nothing

1212+ ( D.reflow $

1213+ "I got stuck while reading your elm.json file. I do not know about this type of license:"

1214+ ,

1215+ D.stack

1216+ [ D.fillSep

1217+ ["Elm","packages","generally","use"

1218+ ,D.green "\"BSD-3-Clause\"","or",D.green "\"MIT\"" <> ","

1219+ ,"but","I","accept","any","OSI","approved","SPDX","license."

1220+ ,"Here","some","that","seem","close","to","what","you","wrote:"

1221+ ]

1222+ , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromChars . Json.toChars) suggestions

1223+ , D.reflow $

1224+ "Check out https://spdx.org/licenses/ for the full list of options."

1225+ ]

1226+ )

7141227

1228+ OP_BadSummaryTooLong ->

1229+ toSnippet "SUMMARY TOO LONG" Nothing

1230+ ( D.reflow $

1231+ "I got stuck while reading your elm.json file. Your \"summary\" is too long:"

1232+ , D.stack

1233+ [ D.fillSep

1234+ ["I","need","it","to","be"

1235+ ,D.green "under",D.green "80",D.green "bytes"

1236+ ,"so","it","renders","nicely","on","the","package","website!"

1237+ ]

1238+ , D.toSimpleNote

1239+ "I count the length in bytes, so using non-ASCII characters costs extra.\

1240+ \ Please report your case at https://github.com/elm/compiler/issues if this seems\

1241+ \ overly restrictive for your needs."

1242+ ]

1243+ )

7151244

716−-- RENDERERS

1245+ OP_NoSrcDirs ->

1246+ toSnippet "NO SOURCE DIRECTORIES" Nothing

1247+ ( D.reflow $

1248+ "I got stuck while reading your elm.json file. You do not have any \"source-directories\" listed here:"

1249+ , D.fillSep

1250+ ["I","need","something","like",D.green "[\"src\"]"

1251+ ,"so","I","know","where","to","look","for","your","modules!"

1252+ ]

1253+ )

7171254

7181255

719−toString :: Help.Report -> String

720−toString report =

721− Help.toString (Help.reportToDoc report)

7221256

1257+-- DETAILS

7231258

724−toStderr :: Help.Report -> IO ()

725−toStderr report =

726− Help.toStderr (Help.reportToDoc report)

7271259

1260+data Details

1261+ = DetailsNoSolution

1262+ | DetailsNoOfflineSolution

1263+ | DetailsSolverProblem Solver

1264+ | DetailsBadElmInPkg C.Constraint

1265+ | DetailsBadElmInAppOutline V.Version

1266+ | DetailsHandEditedDependencies

1267+ | DetailsBadOutline Outline

1268+ | DetailsCannotGetRegistry RegistryProblem

1269+ | DetailsBadDeps FilePath [DetailsBadDep]

7281270

729−toJson :: Help.Report -> Encode.Value

730−toJson report =

731− Help.reportToJson report

7321271

1272+data DetailsBadDep

1273+ = BD_BadDownload Pkg.Name V.Version PackageProblem

1274+ | BD_BadBuild Pkg.Name V.Version (Map.Map Pkg.Name V.Version)

7331275

7341276

735−-- DETAILS TO REPORT

1277+toDetailsReport :: Details -> Help.Report

1278+toDetailsReport details =

1279+ case details of

1280+ DetailsNoSolution ->

1281+ Help.report "INCOMPATIBLE DEPENDENCIES" (Just "elm.json")

1282+ "The dependencies in your elm.json are not compatible."

1283+ [ D.fillSep

1284+ ["Did","you","change","them","by","hand?","Try","to","change","it","back!"

1285+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."

1286+ ]

1287+ , D.reflow $

1288+ "Please ask for help on the community forums if you try those paths and are still\

1289+ \ having problems!"

1290+ ]

7361291

1292+ DetailsNoOfflineSolution ->

1293+ Help.report "TROUBLE VERIFYING DEPENDENCIES" (Just "elm.json")

1294+ "I could not connect to https://package.elm-lang.org to get the latest list of\

1295+ \ packages, and I was unable to verify your dependencies with the information I\

1296+ \ have cached locally."

1297+ [ D.reflow $

1298+ "Are you able to connect to the internet? These dependencies may work once you\

1299+ \ get access to the registry!"

1300+ , D.toFancyNote

1301+ ["If","you","changed","your","dependencies","by","hand,","try","to","change","them","back!"

1302+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."

1303+ ]

1304+ ]

7371305

738−detailsToReport :: Details -> Help.Report

739−detailsToReport details =

740− case details of

741− DetailsCorrupt ->

742− error "TODO DetailsCorrupt"

1306+ DetailsSolverProblem solver ->

1307+ toSolverReport solver

7431308

7441309 DetailsBadElmInPkg constraint ->

7451310 Help.report "ELM VERSION MISMATCH" (Just "elm.json")

@@ -765,32 +1330,278 @@ detailsToReport details =

7651330 ]

7661331

7671332 DetailsHandEditedDependencies ->

768− error "TODO DetailsHandEditedDependencies"

1333+ Help.report "ERROR IN DEPENDENCIES" (Just "elm.json")

1334+ "It looks like the dependencies elm.json in were edited by hand (or by a 3rd\

1335+ \ party tool) leaving them in an invalid state."

1336+ [ D.fillSep

1337+ ["Try","to","change","them","back","to","what","they","were","before!"

1338+ ,"It","is","much","more","reliable","to","add","dependencies","with",D.green "elm install" <> "."

1339+ ]

1340+ , D.reflow $

1341+ "Please ask for help on the community forums if you try those paths and are still\

1342+ \ having problems!"

1343+ ]

7691344

770− DetailsBadOutline outlineProblem ->

771− toOutlineReport outlineProblem

1345+ DetailsBadOutline outline ->

1346+ toOutlineReport outline

7721347

7731348 DetailsCannotGetRegistry problem ->

774− error "TODO DetailsCannotGetRegistry" problem

1349+ toRegistryProblemReport "PROBLEM LOADING PACKAGE LIST" problem $

1350+ "I need the list of published packages to verify your dependencies"

1351+

1352+ DetailsBadDeps cacheDir deps ->

1353+ case List.sortOn toBadDepRank deps of

1354+ [] ->

1355+ Help.report "PROBLEM BUILDING DEPENDENCIES" Nothing

1356+ "I am not sure what is going wrong though."

1357+ [ D.reflow $

1358+ "I would try deleting the " ++ cacheDir ++ " and elm-stuff/ directories, then\

1359+ \ trying to build again. That will work if some cached files got corrupted\

1360+ \ somehow."

1361+ , D.reflow $

1362+ "If that does not work, go to https://elm-lang.org/community and ask for\

1363+ \ help. This is a weird case!"

1364+ ]

7751365

776− DetailsCannotBuildPackage name version problem ->

777− error "TODO DetailsCannotBuildPackage" name version problem

1366+ d:_ ->

1367+ case d of

1368+ BD_BadDownload pkg vsn packageProblem ->

1369+ toPackageProblemReport pkg vsn packageProblem

7781370

779− DetailsNoSolution ->

780− error "TODO DetailsNoSolution"

1371+ BD_BadBuild pkg vsn fingerprint ->

1372+ Help.report "PROBLEM BUILDING DEPENDENCIES" Nothing

1373+ "I ran into a compilation error when trying to build the following package:"

1374+ [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg ++ " " ++ V.toChars vsn

1375+ , D.reflow $

1376+ "This probably means it has package constraints that are too wide. It may be\

1377+ \ possible to tweak your elm.json to avoid the root problem as a stopgap. Head\

1378+ \ over to https://elm-lang.org/community to get help figuring out how to take\

1379+ \ this path!"

1380+ , D.toSimpleNote $

1381+ "To help with the root problem, please report this to the package author along\

1382+ \ with the following information:"

1383+ , D.indent 4 $ D.vcat $

1384+ map (\(p,v) -> D.fromChars $ Pkg.toChars p ++ " " ++ V.toChars v) $

1385+ Map.toList fingerprint

1386+ , D.reflow $

1387+ "If you want to help out even more, try building the package locally. That should\

1388+ \ give you much more specific information about why this package is failing to\

1389+ \ build, which will in turn make it easier for the package author to fix it!"

1390+ ]

7811391

782− DetailsNoOfflineSolution ->

783− error "TODO DetailsNoOfflineSolution"

7841392

785− DetailsSolverProblem _ ->

786− error "TODO DetailsSolverProblem"

1393+toBadDepRank :: DetailsBadDep -> Int -- lower is better

1394+toBadDepRank badDep =

1395+ case badDep of

1396+ BD_BadDownload _ _ _ -> 0

1397+ BD_BadBuild _ _ _ -> 1

1398+

1399+

1400+

1401+-- PACKAGE PROBLEM

1402+

1403+

1404+data PackageProblem

1405+ = PP_BadEndpointRequest Http.Error

1406+ | PP_BadEndpointContent String

1407+ | PP_BadArchiveRequest Http.Error

1408+ | PP_BadArchiveContent String

1409+ | PP_BadArchiveHash String String String

1410+

1411+

1412+toPackageProblemReport :: Pkg.Name -> V.Version -> PackageProblem -> Help.Report

1413+toPackageProblemReport pkg vsn problem =

1414+ let

1415+ thePackage =

1416+ Pkg.toChars pkg ++ " " ++ V.toChars vsn

1417+ in

1418+ case problem of

1419+ PP_BadEndpointRequest httpError ->

1420+ toHttpErrorReport "PROBLEM DOWNLOADING PACKAGE" httpError $

1421+ "I need to find the latest download link for " ++ thePackage

1422+

1423+ PP_BadEndpointContent url ->

1424+ Help.report "PROBLEM DOWNLOADING PACKAGE" Nothing

1425+ (

1426+ "I need to find the latest download link for " ++ thePackage ++ ", but I ran into corrupted information from:"

1427+ )

1428+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

1429+ , D.reflow $

1430+ "Is something weird with your internet connection. We have gotten reports that\

1431+ \ schools, businesses, airports, etc. sometimes intercept requests and add things\

1432+ \ to the body or change its contents entirely. Could that be the problem?"

1433+ ]

1434+

1435+ PP_BadArchiveRequest httpError ->

1436+ toHttpErrorReport "PROBLEM DOWNLOADING PACKAGE" httpError $

1437+ "I was trying to download the source code for " ++ thePackage

1438+

1439+ PP_BadArchiveContent url ->

1440+ Help.report "PROBLEM DOWNLOADING PACKAGE" Nothing

1441+ (

1442+ "I downloaded the source code for " ++ thePackage ++ " from:"

1443+ )

1444+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

1445+ , D.reflow $

1446+ "But I was unable to unzip the data. Maybe there is something weird with\

1447+ \ your internet connection. We have gotten reports that schools, businesses,\

1448+ \ airports, etc. sometimes intercept requests and add things to the body or\

1449+ \ change its contents entirely. Could that be the problem?"

1450+ ]

1451+

1452+ PP_BadArchiveHash url expectedHash actualHash ->

1453+ Help.report "CORRUPT PACKAGE DATA" Nothing

1454+ (

1455+ "I downloaded the source code for " ++ thePackage ++ " from:"

1456+ )

1457+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

1458+ , D.reflow "But it looks like the hash of the archive has changed since publication:"

1459+ , D.vcat $ map D.fromChars $

1460+ [ " Expected: " ++ expectedHash

1461+ , " Actual: " ++ actualHash

1462+ ]

1463+ , D.reflow $

1464+ "This usually means that the package author moved the version\

1465+ \ tag, so report it to them and see if that is the issue. Folks\

1466+ \ on Elm slack can probably help as well."

1467+ ]

1468+

1469+

1470+

1471+-- REGISTRY PROBLEM

1472+

1473+

1474+data RegistryProblem

1475+ = RP_Http Http.Error

1476+ | RP_Data String BS.ByteString

1477+

1478+

1479+toRegistryProblemReport :: String -> RegistryProblem -> String -> Help.Report

1480+toRegistryProblemReport title problem context =

1481+ case problem of

1482+ RP_Http err ->

1483+ toHttpErrorReport title err context

7871484

1485+ RP_Data url body ->

1486+ Help.report title Nothing (context ++ ", so I fetched:")

1487+ [ D.indent 4 $ D.dullyellow $ D.fromChars url

1488+ , D.reflow $

1489+ "I got the data back, but it was not what I was expecting. The response\

1490+ \ body contains " ++ show (BS.length body) ++ " bytes. Here is the "

1491+ ++ if BS.length body <= 76 then "whole thing:" else "beginning:"

1492+ , D.indent 4 $ D.dullyellow $ D.fromChars $

1493+ if BS.length body <= 76

1494+ then BS_UTF8.toString body

1495+ else take 73 (BS_UTF8.toString body) ++ "..."

1496+ , D.reflow $

1497+ "Does this error keep showing up? Maybe there is something weird with your\

1498+ \ internet connection. We have gotten reports that schools, businesses,\

1499+ \ airports, etc. sometimes intercept requests and add things to the body\

1500+ \ or change its contents entirely. Could that be the problem?"

1501+ ]

1502+

1503+

1504+toHttpErrorReport :: String -> Http.Error -> String -> Help.Report

1505+toHttpErrorReport title err context =

1506+ let

1507+ toHttpReport intro url details =

1508+ Help.report title Nothing intro $

1509+ D.indent 4 (D.dullyellow (D.fromChars url)) : details

1510+ in

1511+ case err of

1512+ Http.BadUrl url reason ->

1513+ toHttpReport (context ++ ", so I wanted to fetch:") url

1514+ [ D.reflow $ "But my HTTP library is saying this is not a valid URL. It is saying:"

1515+ , D.indent 4 $ D.fromChars reason

1516+ , D.reflow $

1517+ "This may indicate that there is some problem in the compiler, so please open an\

1518+ \ issue at https://github.com/elm/compiler/issues listing your operating system, Elm\

1519+ \ version, the command you ran, the terminal output, and any additional information\

1520+ \ that might help others reproduce the error."

1521+ ]

1522+

1523+ Http.BadHttp url httpExceptionContent ->

1524+ case httpExceptionContent of

1525+ HTTP.StatusCodeException response body ->

1526+ let

1527+ (HTTP.Status code message) = HTTP.responseStatus response

1528+ in

1529+ toHttpReport (context ++ ", so I tried to fetch:") url

1530+ [ D.fillSep $

1531+ ["But","it","came","back","as",D.red (D.fromInt code)]

1532+ ++ map D.fromChars (words (BS_UTF8.toString message))

1533+ , D.indent 4 $ D.reflow $ BS_UTF8.toString body

1534+ , D.reflow $

1535+ "This may mean some online endpoint changed in an unexpected way, so if does not\

1536+ \ seem like something on your side is causing this (e.g. firewall) please report\

1537+ \ this to https://github.com/elm/compiler/issues with your operating system, Elm\

1538+ \ version, the command you ran, the terminal output, and any additional information\

1539+ \ that can help others reproduce the error!"

1540+ ]

1541+

1542+ HTTP.TooManyRedirects responses ->

1543+ toHttpReport (context ++ ", so I tried to fetch:") url

1544+ [ D.reflow $ "But I gave up after following these " ++ show (length responses) ++ " redirects:"

1545+ , D.indent 4 $ D.vcat $ map toRedirectDoc responses

1546+ , D.reflow $

1547+ "Is it possible that your internet connection intercepts certain requests? That\

1548+ \ sometimes causes problems for folks in schools, businesses, airports, hotels,\

1549+ \ and certain countries. Try asking for help locally or in a community forum!"

1550+ ]

1551+

1552+ otherException ->

1553+ toHttpReport (context ++ ", so I tried to fetch:") url

1554+ [ D.reflow $ "But my HTTP library is giving me the following error message:"

1555+ , D.indent 4 $ D.fromChars (show otherException)

1556+ , D.reflow $

1557+ "Are you somewhere with a slow internet connection? Or no internet?\

1558+ \ Does the link I am trying to fetch work in your browser? Maybe the\

1559+ \ site is down? Does your internet connection have a firewall that\

1560+ \ blocks certain domains? It is usually something like that!"

1561+ ]

1562+

1563+ Http.BadMystery url someException ->

1564+ toHttpReport (context ++ ", so I tried to fetch:") url

1565+ [ D.reflow $ "But I ran into something weird! I was able to extract this error message:"

1566+ , D.indent 4 $ D.fromChars (show someException)

1567+ , D.reflow $

1568+ "Is it possible that your internet connection intercepts certain requests? That\

1569+ \ sometimes causes problems for folks in schools, businesses, airports, hotels,\

1570+ \ and certain countries. Try asking for help locally or in a community forum!"

1571+ ]

1572+

1573+

1574+toRedirectDoc :: HTTP.Response body -> D.Doc

1575+toRedirectDoc response =

1576+ let

1577+ (HTTP.Status code message) = HTTP.responseStatus response

1578+ in

1579+ case List.lookup HTTP.hLocation (HTTP.responseHeaders response) of

1580+ Just loc -> D.red (D.fromInt code) <> " - " <> D.fromChars (BS_UTF8.toString loc)

1581+ Nothing -> D.red (D.fromInt code) <> " - " <> D.fromChars (BS_UTF8.toString message)

1582+

1583+

1584+

1585+-- MAKE

1586+

1587+

1588+data Make

1589+ = MakeNoOutline

1590+ | MakeCannotOptimizeAndDebug

1591+ | MakeBadDetails Details

1592+ | MakeAppNeedsFileNames

1593+ | MakePkgNeedsExposing

1594+ | MakeMultipleFilesIntoHtml

1595+ | MakeNoMain

1596+ | MakeNonMainFilesIntoJavaScript ModuleName.Raw [ModuleName.Raw]

1597+ | MakeCannotBuild BuildProblem

1598+ | MakeBadGenerate Generate

7881599

7891600

7901601makeToReport :: Make -> Help.Report

7911602makeToReport make =

7921603 case make of

793− MakeNeedsOutline ->

1604+ MakeNoOutline ->

7941605 Help.report "NO elm.json FILE" Nothing

7951606 "It looks like you are starting a new Elm project. Very exciting! Try running:"

7961607 [ D.indent 4 $ D.green $ "elm init"

@@ -811,27 +1622,344 @@ makeToReport make =

8111622 \ at once though! Pick just one of those flags and it should work!"

8121623 ]

8131624

814− MakeBlockedByDetailsProblem detailsProblem ->

815− detailsToReport detailsProblem

1625+ MakeBadDetails detailsProblem ->

1626+ toDetailsReport detailsProblem

8161627

8171628 MakeAppNeedsFileNames ->

8181629 Help.report "NO INPUT" Nothing

819− "What should I make though? I need a specific file like this:"

820− [ D.indent 4 $ D.green "elm make src/Main.elm"

821− , D.reflow

822− "However many files you give, I will create one JS file out of them."

1630+ "What should I make though? I need specific files like:"

1631+ [ D.vcat

1632+ [ D.indent 4 $ D.green "elm make src/Main.elm"

1633+ , D.indent 4 $ D.green "elm make src/This.elm src/That.elm"

1634+ ]

1635+ , D.reflow $

1636+ "I recommend reading through https://guide.elm-lang.org for guidance on what to\

1637+ \ actually put in those files!"

8231638 ]

8241639

8251640 MakePkgNeedsExposing ->

826− error "TODO MakePkgNeedsExposing"

1641+ Help.report "NO INPUT" Nothing

1642+ "What should I make though? I need specific files like:"

1643+ [ D.vcat

1644+ [ D.indent 4 $ D.green "elm make src/Main.elm"

1645+ , D.indent 4 $ D.green "elm make src/This.elm src/That.elm"

1646+ ]

1647+ , D.reflow $

1648+ "You can also entries to the \"exposed-modules\" list in your elm.json file, and\

1649+ \ I will try to compile the relevant files."

1650+ ]

8271651

8281652 MakeMultipleFilesIntoHtml ->

829− error "TODO MakeMultipleFilesIntoHtml"

1653+ Help.report "TOO MANY FILES" Nothing

1654+ (

1655+ "When producing an HTML file, I can only handle one file."

1656+ )

1657+ [ D.fillSep

1658+ ["Switch","to",D.dullyellow "--output=/dev/null","if","you","just","want"

1659+ ,"to","get","compile","errors.","This","skips","the","code","gen","phase,"

1660+ ,"so","it","can","be","a","bit","faster","than","other","options","sometimes."

1661+ ]

1662+ , D.fillSep

1663+ ["Switch","to",D.dullyellow "--output=elm.js","if","you","want","multiple"

1664+ ,"`main`","values","available","in","a","single","JavaScript","file.","Then"

1665+ ,"you","can","make","your","own","customized","HTML","file","that","embeds"

1666+ ,"multiple","Elm","nodes.","The","generated","JavaScript","also","shares"

1667+ ,"dependencies","between","modules,","so","it","should","be","smaller","than"

1668+ ,"compiling","each","module","separately."

1669+ ]

1670+ ]

1671+

1672+ MakeNoMain ->

1673+ Help.report "NO MAIN" Nothing

1674+ (

1675+ "When producing an HTML file, I require that the given file has a `main` value.\

1676+ \ That way I have something to show on screen!"

1677+ )

1678+ [ D.reflow $

1679+ "Try adding a `main` value to your file? Or if you just want to verify that this\

1680+ \ module compiles, switch to --output=/dev/null to skip the code gen phase\

1681+ \ altogether."

1682+ , D.toSimpleNote $

1683+ "Adding a `main` value can be as brief as adding something like this:"

1684+ , D.vcat

1685+ [ D.fillSep [D.cyan "import","Html"]

1686+ , ""

1687+ , D.fillSep [D.green "main","="]

1688+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]

1689+ ]

1690+ , D.reflow $

1691+ "From there I can create an HTML file that says \"Hello!\" on screen. I recommend\

1692+ \ looking through https://guide.elm-lang.org for more guidance on how to fill in\

1693+ \ the `main` value."

1694+ ]

1695+

1696+ MakeNonMainFilesIntoJavaScript m ms ->

1697+ case ms of

1698+ [] ->

1699+ Help.report "NO MAIN" Nothing

1700+ (

1701+ "When producing a JS file, I require that the given file has a `main` value. That\

1702+ \ way Elm." ++ ModuleName.toChars m ++ ".init() is definitely defined in the\

1703+ \ resulting file!"

1704+ )

1705+ [ D.reflow $

1706+ "Try adding a `main` value to your file? Or if you just want to verify that this\

1707+ \ module compiles, switch to --output=/dev/null to skip the code gen phase\

1708+ \ altogether."

1709+ , D.toSimpleNote $

1710+ "Adding a `main` value can be as brief as adding something like this:"

1711+ , D.vcat

1712+ [ D.fillSep [D.cyan "import","Html"]

1713+ , ""

1714+ , D.fillSep [D.green "main","="]

1715+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]

1716+ ]

1717+ , D.reflow $

1718+ "Or use https://package.elm-lang.org/packages/elm/core/latest/Platform#worker to\

1719+ \ make a `main` with no user interface."

1720+ ]

1721+

1722+ _:_ ->

1723+ Help.report "NO MAIN" Nothing

1724+ (

1725+ "When producing a JS file, I require that given files all have `main` values.\

1726+ \ That way functions like Elm." ++ ModuleName.toChars m ++ ".init() are\

1727+ \ definitely defined in the resulting file. I am missing `main` values in:"

1728+ )

1729+ [ D.indent 4 $ D.red $ D.vcat $ map D.fromName (m:ms)

1730+ , D.reflow $

1731+ "Try adding a `main` value to them? Or if you just want to verify that these\

1732+ \ modules compile, switch to --output=/dev/null to skip the code gen phase\

1733+ \ altogether."

1734+ , D.toSimpleNote $

1735+ "Adding a `main` value can be as brief as adding something like this:"

1736+ , D.vcat

1737+ [ D.fillSep [D.cyan "import","Html"]

1738+ , ""

1739+ , D.fillSep [D.green "main","="]

1740+ , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]

1741+ ]

1742+ , D.reflow $

1743+ "Or use https://package.elm-lang.org/packages/elm/core/latest/Platform#worker to\

1744+ \ make a `main` with no user interface."

1745+ ]

1746+

1747+ MakeCannotBuild buildProblem ->

1748+ toBuildProblemReport buildProblem

1749+

1750+ MakeBadGenerate generateProblem ->

1751+ toGenerateReport generateProblem

1752+

1753+

1754+

1755+-- BUILD PROBLEM

1756+

1757+

1758+data BuildProblem

1759+ = BuildBadModules FilePath Error.Module [Error.Module]

1760+ | BuildProjectProblem BuildProjectProblem

1761+

1762+

1763+data BuildProjectProblem

1764+ = BP_PathUnknown FilePath

1765+ | BP_WithBadExtension FilePath

1766+ | BP_WithAmbiguousSrcDir FilePath FilePath FilePath

1767+ | BP_MainPathDuplicate FilePath FilePath

1768+ | BP_RootNameDuplicate ModuleName.Raw FilePath FilePath

1769+ | BP_RootNameInvalid FilePath FilePath [String]

1770+ | BP_CannotLoadDependencies

1771+ | BP_Cycle ModuleName.Raw [ModuleName.Raw]

1772+ | BP_MissingExposed (NE.List (ModuleName.Raw, Import.Problem))

1773+

1774+

1775+toBuildProblemReport :: BuildProblem -> Help.Report

1776+toBuildProblemReport problem =

1777+ case problem of

1778+ BuildBadModules root e es ->

1779+ Help.compilerReport root e es

1780+

1781+ BuildProjectProblem projectProblem ->

1782+ toProjectProblemReport projectProblem

1783+

1784+

1785+toProjectProblemReport :: BuildProjectProblem -> Help.Report

1786+toProjectProblemReport projectProblem =

1787+ case projectProblem of

1788+ BP_PathUnknown path ->

1789+ Help.report "FILE NOT FOUND" Nothing

1790+ "I cannot find this file:"

1791+ [ D.indent 4 $ D.red $ D.fromChars path

1792+ , D.reflow $ "Is there a typo?"

1793+ , D.toSimpleNote $

1794+ "If you are just getting started, try working through the examples in the\

1795+ \ official guide https://guide.elm-lang.org to get an idea of the kinds of things\

1796+ \ that typically go in a src/Main.elm file."

1797+ ]

1798+

1799+ BP_WithBadExtension path ->

1800+ Help.report "UNEXPECTED FILE EXTENSION" Nothing

1801+ "I can only compile Elm files (with a .elm extension) but you want me to compile:"

1802+ [ D.indent 4 $ D.red $ D.fromChars path

1803+ , D.reflow $ "Is there a typo? Can the file extension be changed?"

1804+ ]

1805+

1806+ BP_WithAmbiguousSrcDir path srcDir1 srcDir2 ->

1807+ Help.report "CONFUSING FILE" Nothing

1808+ "I am getting confused when I try to compile this file:"

1809+ [ D.indent 4 $ D.red $ D.fromChars path

1810+ , D.reflow $

1811+ "I always check if files appear in any of the \"source-directories\" listed in\

1812+ \ your elm.json to see if there might be some cached information about them. That\

1813+ \ can help me compile faster! But in this case, it looks like this file may be in\

1814+ \ either of these directories:"

1815+ , D.indent 4 $ D.red $ D.vcat $ map D.fromChars [srcDir1,srcDir2]

1816+ , D.reflow $

1817+ "Try to make it so no source directory contains another source directory!"

1818+ ]

1819+

1820+ BP_MainPathDuplicate path1 path2 ->

1821+ Help.report "CONFUSING FILES" Nothing

1822+ "You are telling me to compile these two files:"

1823+ [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ path1, path2 ]

1824+ , D.reflow $

1825+ if path1 == path2 then

1826+ "Why are you telling me twice? Is something weird going on with a script?\

1827+ \ I figured I would let you know about it just in case something is wrong.\

1828+ \ Only list it once and you should be all set!"

1829+ else

1830+ "But seem to be the same file though... It makes me think something tricky is\

1831+ \ going on with symlinks in your project, so I figured I would let you know\

1832+ \ about it just in case. Remove one of these files from your command to get\

1833+ \ unstuck!"

1834+ ]

1835+

1836+ BP_RootNameDuplicate name outsidePath otherPath ->

1837+ Help.report "MODULE NAME CLASH" Nothing

1838+ "These two files are causing a module name clash:"

1839+ [ D.indent 4 $ D.red $ D.vcat $ map D.fromChars [ outsidePath, otherPath ]

1840+ , D.reflow $

1841+ "They both say `module " ++ ModuleName.toChars name ++ " exposing (..)` up\

1842+ \ at the top, but they cannot have the same name!"

1843+ , D.reflow $

1844+ "Try changing to a different module name in one of them!"

1845+ ]

1846+

1847+ BP_RootNameInvalid givenPath srcDir _ ->

1848+ Help.report "UNEXPECTED FILE NAME" Nothing

1849+ "I am having trouble with this file name:"

1850+ [ D.indent 4 $ D.red $ D.fromChars givenPath

1851+ , D.reflow $

1852+ "I found it in your " ++ FP.addTrailingPathSeparator srcDir ++ " directory\

1853+ \ which is good, but I expect all of the files in there to use the following\

1854+ \ module naming convention:"

1855+ , toModuleNameConventionTable srcDir [ "Main", "HomePage", "Http.Helpers" ]

1856+ , D.reflow $

1857+ "Notice that the names always start with capital letters! Can you make your file\

1858+ \ use this naming convention?"

1859+ , D.toSimpleNote $

1860+ "Having a strict naming convention like this makes it a lot easier to find\

1861+ \ things in large projects. If you see a module imported, you know where to look\

1862+ \ for the corresponding file every time!"

1863+ ]

1864+

1865+ BP_CannotLoadDependencies ->

1866+ corruptCacheReport

1867+

1868+ BP_Cycle name names ->

1869+ Help.report "IMPORT CYCLE" Nothing

1870+ "Your module imports form a cycle:"

1871+ [ D.cycle 4 name names

1872+ , D.reflow $

1873+ "Learn more about why this is disallowed and how to break cycles here:"

1874+ ++ D.makeLink "import-cycles"

1875+ ]

1876+

1877+ BP_MissingExposed (NE.List (name, problem) _) ->

1878+ case problem of

1879+ Import.NotFound ->

1880+ Help.report "MISSING MODULE" (Just "elm.json")

1881+ "The \"exposed-modules\" of your elm.json lists the following module:"

1882+ [ D.indent 4 $ D.red $ D.fromName name

1883+ , D.reflow $

1884+ "But I cannot find it in your src/ directory. Is there a typo? Was it renamed?"

1885+ ]

1886+

1887+ Import.Ambiguous _ _ pkg _ ->

1888+ Help.report "AMBIGUOUS MODULE NAME" (Just "elm.json")

1889+ "The \"exposed-modules\" of your elm.json lists the following module:"

1890+ [ D.indent 4 $ D.red $ D.fromName name

1891+ , D.reflow $

1892+ "But a module from " ++ Pkg.toChars pkg ++ " already uses that name. Try\

1893+ \ choosing a different name for your local file."

1894+ ]

1895+

1896+ Import.AmbiguousLocal path1 path2 paths ->

1897+ Help.report "AMBIGUOUS MODULE NAME" (Just "elm.json")

1898+ "The \"exposed-modules\" of your elm.json lists the following module:"

1899+ [ D.indent 4 $ D.red $ D.fromName name

1900+ , D.reflow $

1901+ "But I found multiple files with that name:"

1902+ , D.dullyellow $ D.indent 4 $ D.vcat $

1903+ map D.fromChars (path1:path2:paths)

1904+ , D.reflow $

1905+ "Change the module names to be distinct!"

1906+ ]

1907+

1908+ Import.AmbiguousForeign _ _ _ ->

1909+ Help.report "MISSING MODULE" (Just "elm.json")

1910+ "The \"exposed-modules\" of your elm.json lists the following module:"

1911+ [ D.indent 4 $ D.red $ D.fromName name

1912+ , D.reflow $

1913+ "But I cannot find it in your src/ directory. Is there a typo? Was it renamed?"

1914+ , D.toSimpleNote $

1915+ "It is not possible to \"re-export\" modules from other packages. You can only\

1916+ \ expose modules that you define in your own code."

1917+ ]

1918+

1919+

1920+toModuleNameConventionTable :: FilePath -> [String] -> D.Doc

1921+toModuleNameConventionTable srcDir names =

1922+ let

1923+ toPair name =

1924+ ( name

1925+ , srcDir </> map (\c -> if c == '.' then FP.pathSeparator else c) name <.> "elm"

1926+ )

1927+

1928+ namePairs = map toPair names

1929+ nameWidth = maximum (11 : map (length . fst) namePairs)

1930+ pathWidth = maximum ( 9 : map (length . snd) namePairs)

1931+

1932+ padded width str =

1933+ str ++ replicate (width - length str) ' '

1934+

1935+ toRow (name, path) =

1936+ D.fromChars $

1937+ "| " ++ padded nameWidth name ++ " | " ++ padded pathWidth path ++ " |"

1938+

1939+ bar =

1940+ D.fromChars $

1941+ "+-" ++ replicate nameWidth '-' ++ "-+-" ++ replicate pathWidth '-' ++ "-+"

1942+ in

1943+ D.indent 4 $ D.vcat $

1944+ [ bar, toRow ("Module Name", "File Path"), bar ] ++ map toRow namePairs ++ [ bar ]

1945+

1946+

1947+

1948+-- GENERATE

1949+

1950+

1951+data Generate

1952+ = GenerateCannotLoadArtifacts

1953+ | GenerateCannotOptimizeDebugValues ModuleName.Raw [ModuleName.Raw]

8301954

831− MakeNonMainFilesIntoJavaScript _ _ ->

832− error "TODO MakeNonMainFilesIntoJavaScript"

8331955

834− MakeCannotOptimizeDebugValues m ms ->

1956+toGenerateReport :: Generate -> Help.Report

1957+toGenerateReport problem =

1958+ case problem of

1959+ GenerateCannotLoadArtifacts ->

1960+ corruptCacheReport

1961+

1962+ GenerateCannotOptimizeDebugValues m ms ->

8351963 Help.report "DEBUG REMNANTS" Nothing

8361964 "There are uses of the `Debug` module in the following modules:"

8371965 [ D.indent 4 $ D.red $ D.vcat $ map (D.fromChars . ModuleName.toChars) (m:ms)

@@ -840,7 +1968,7 @@ makeToReport make =

8401968 "The issue is that --optimize strips out info needed by `Debug` functions.\

8411969 \ Here are two examples:"

8421970 , D.indent 4 $ D.reflow $

843− "(1) It shortens record field names. This makes the generated JavaScript is\

1971+ "(1) It shortens record field names. This makes the generated JavaScript\

8441972 \ smaller, but `Debug.toString` cannot know the real field names anymore."

8451973 , D.indent 4 $ D.reflow $

8461974 "(2) Values like `type Height = Height Float` are unboxed. This reduces\

@@ -853,91 +1981,89 @@ makeToReport make =

8531981 \ exists!"

8541982 ]

8551983

856− MakeCannotBuild buildProblem ->

857− case buildProblem of

858− BuildProjectProblem bp ->

859− case bp of

860− BP_PathUnknown _ ->

861− error "TODO BP_PathUnknown"

8621984

863− BP_WithBadExtension _ ->

864− error "TODO BP_WithBadExtension"

8651985

866− BP_WithAmbiguousSrcDir _ _ ->

867− error "TODO BP_WithAmbiguousSrcDir"

1986+-- CORRUPT CACHE

8681987

869− BP_MainPathDuplicate _ _ ->

870− error "TODO BP_MainPathDuplicate"

8711988

872− BP_MainNameDuplicate _ _ _ ->

873− error "TODO BP_MainNameDuplicate"

1989+corruptCacheReport :: Help.Report

1990+corruptCacheReport =

1991+ Help.report "CORRUPT CACHE" Nothing

1992+ "It looks like some of the information cached in elm-stuff/ has been corrupted."

1993+ [ D.reflow $

1994+ "Try deleting your elm-stuff/ directory to get unstuck."

1995+ , D.toSimpleNote $

1996+ "This almost certainly means that a 3rd party tool (or editor plugin) is\

1997+ \ causing problems your the elm-stuff/ directory. Try disabling 3rd party tools\

1998+ \ one by one until you figure out which it is!"

1999+ ]

8742000

875− BP_CannotLoadDependencies ->

876− error "TODO BP_CannotLoadDependencies"

8772001

878− BP_Cycle name names ->

879− Help.report "IMPORT CYCLE" Nothing

880− "Your module imports form a cycle:"

881− [ D.cycle 4 name names

882− , D.reflow $

883− "Learn more about why this is disallowed and how to break cycles here:"

884− ++ D.makeLink "import-cycles"

885− ]

8862002

887− BP_MissingExposed _ ->

888− error "TODO BP_MissingExposed"

2003+-- REACTOR

8892004

890− BuildModuleProblems p ps ->

891− Help.compilerReport p ps

8922005

893− MakeCannotLoadArtifacts ->

894− error "TODO MakeCannotLoadArtifacts"

2006+data Reactor

2007+ = ReactorNoOutline

2008+ | ReactorBadDetails Details

2009+ | ReactorBadBuild BuildProblem

2010+ | ReactorBadGenerate Generate

8952011

8962012

2013+reactorToReport :: Reactor -> Help.Report

2014+reactorToReport problem =

2015+ case problem of

2016+ ReactorNoOutline ->

2017+ Help.report "NEW PROJECT?" Nothing

2018+ "Are you trying to start a new project? Try this command in the terminal:"

2019+ [ D.indent 4 $ D.green "elm init"

2020+ , D.reflow "It will help you get started!"

2021+ ]

8972022

898−-- OUTLINE

2023+ ReactorBadDetails details ->

2024+ toDetailsReport details

8992025

2026+ ReactorBadBuild buildProblem ->

2027+ toBuildProblemReport buildProblem

9002028

901−toOutlineReport :: Outline -> Help.Report

902−toOutlineReport problem =

903− case problem of

904− OutlineHasBadSrcDirs dir dirs ->

905− error "TODO OutlineHasBadSrcDirs" dir dirs

2029+ ReactorBadGenerate generate ->

2030+ toGenerateReport generate

9062031

907− OutlineHasBadStructure decodeError ->

908− error "TODO OutlineHasBadStructure" decodeError toOutlineProblemReport

9092032

9102033

911−toOutlineProblemReport :: OutlineProblem -> Help.Report

912−toOutlineProblemReport problem =

913− case problem of

914− OP_BadType ->

915− error "TODO OP_BadType"

2034+-- REPL

9162035

917− OP_BadPkgName row col ->

918− error "TODO OP_BadPkgName" row col

9192036

920− OP_BadVersion row col ->

921− error "TODO OP_BadVersion" row col

2037+data Repl

2038+ = ReplBadDetails Details

2039+ | ReplBadInput BS.ByteString Error.Error

2040+ | ReplBadLocalDeps FilePath Error.Module [Error.Module]

2041+ | ReplProjectProblem BuildProjectProblem

2042+ | ReplBadGenerate Generate

2043+ | ReplBadCache

2044+ | ReplBlocked

9222045

923− OP_BadConstraint constraintError ->

924− error "TODO OP_BadConstraint" constraintError

9252046

926− OP_BadModuleName row col ->

927− error "TODO OP_BadModuleName" row col

2047+replToReport :: Repl -> Help.Report

2048+replToReport problem =

2049+ case problem of

2050+ ReplBadDetails details ->

2051+ toDetailsReport details

9282052

929− OP_BadModuleHeaderTooLong ->

930− error "TODO OP_BadModuleHeaderTooLong"

2053+ ReplBadInput source err ->

2054+ Help.compilerReport "/" (Error.Module N.replModule "REPL" File.zeroTime source err) []

9312055

932− OP_BadDependencyName row col ->

933− error "TODO OP_BadDependencyName"

2056+ ReplBadLocalDeps root e es ->

2057+ Help.compilerReport root e es

9342058

935− OP_BadLicense badLicense suggestions ->

936− error "TODO OP_BadLicense" badLicense suggestions

2059+ ReplProjectProblem projectProblem ->

2060+ toProjectProblemReport projectProblem

9372061

938− OP_BadSummaryTooLong ->

939− error "TODO OP_BadSummaryTooLong"

2062+ ReplBadGenerate generate ->

2063+ toGenerateReport generate

9402064

941− OP_NoSrcDirs ->

942− error "TODO OP_NoSrcDirs"

2065+ ReplBadCache ->

2066+ corruptCacheReport

9432067

2068+ ReplBlocked ->

2069+ corruptCacheReport

builder/src/Reporting/Exit/Assets.hsdeleted−227

@@ -1,227 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−module Reporting.Exit.Assets

3− ( Exit(..)

4− , ElmJsonProblem(..)

5− , toReport

6− , BadElmJsonContent(..)

7− , badContentToDocs

8− )

9− where

10−

11−

12−import qualified Data.Text as Text

13−

14−import qualified Elm.Package as Pkg

15−import Reporting.Doc ((<>))

16−import qualified Reporting.Doc as D

17−import qualified Reporting.Exit.Help as Help

18−

19−

20−

21−-- EXITS

22−

23−

24−data Exit

25− = BadElmJson ElmJsonProblem

26− | CorruptElmJson Pkg.Name Pkg.Version

27− | CorruptDocumentation Pkg.Name Pkg.Version

28− | CorruptBinary FilePath FilePath

29−

30−

31−

32−-- ELM JSON PROBLEM

33−

34−

35−data ElmJsonProblem

36− = BadJson D.Doc

37− | BadSrcDir FilePath

38− | NoPkgCore

39− | NoAppCore

40− | NoAppJson

41−

42−

43−

44−-- TO REPORT

45−

46−

47−toReport :: Exit -> Help.Report

48−toReport exit =

49− case exit of

50− CorruptElmJson pkg vsn ->

51− corruptJsonToReport "elm.json" pkg vsn

52−

53− CorruptDocumentation pkg vsn ->

54− corruptJsonToReport "docs.json" pkg vsn

55−

56− CorruptBinary elmHome path ->

57− Help.report "CORRUPT BINARY" (Just path)

58− ("The binary data at " ++ path ++ " is corrupt.")

59− [ D.reflow "Elm caches build artifacts in the following directories:"

60− , D.dullyellow $ D.indent 4 $ D.vcat $

61− [ D.fromString elmHome

62− , "elm-stuff/"

63− ]

64− , D.reflow

65− "Maybe you recently installed a command line tool or editor plugin that messes\

66− \ with them? They definitely should not be doing that, but you never know! So\

67− \ maybe try deleting them? Everything will be rebuilt from scratch. This may\

68− \ help reveal the corrupting influence."

69− ]

70−

71− BadElmJson problem ->

72− elmJsonProblemToReport problem

73−

74−

75−

76−-- CORRUPT JSON

77−

78−

79−corruptJsonToReport :: FilePath -> Pkg.Name -> Pkg.Version -> Help.Report

80−corruptJsonToReport path pkg vsn =

81− Help.report "CORRUPT JSON" Nothing

82− ( "The " ++ path ++ " for " ++ Pkg.toString pkg

83− ++ " " ++ Pkg.versionToString vsn ++ " got corrupted somehow."

84− )

85− [ D.reflow $

86− "I removed it from my file cache, so if it was some transient\

87− \ error it should be fixed if you try the same thing again.\

88− \ Please report this if it seems like an Elm problem though!"

89− ]

90−

91−

92−

93−-- BAD ELM JSON

94−

95−

96−elmJsonProblemToReport :: ElmJsonProblem -> Help.Report

97−elmJsonProblemToReport problem =

98− case problem of

99− BadJson doc ->

100− Help.jsonReport "BAD JSON" (Just "elm.json") doc

101−

102− BadSrcDir dir ->

103− Help.report "BAD JSON" (Just "elm.json")

104− "The \"source-directories\" in your elm.json lists the following directory:"

105− [ D.indent 4 (D.dullyellow (D.fromString dir))

106− , D.reflow "I cannot find that directory though! Is it missing? Is there a typo?"

107− ]

108−

109− NoPkgCore ->

110− Help.report "MISSING DEPENDENCY" (Just "elm.json")

111− "A package must have \"elm/core\" as a dependency. Try running:"

112− [ D.indent 4 $ D.green $ "elm install elm/core"

113− , D.reflow "I need it for the default imports that make `List` and `Maybe` available."

114− ]

115−

116− NoAppCore ->

117− Help.report "MISSING DEPENDENCY" (Just "elm.json")

118− "An application must have \"elm/core\" as a dependency. Try running:"

119− [ D.indent 4 $ D.green $ "elm install elm/core"

120− , D.reflow "It has some supporting code that is needed by every Elm application!"

121− ]

122−

123− NoAppJson ->

124− Help.report "MISSING DEPENDENCY" (Just "elm.json")

125− "An application must have \"elm/json\" as a dependency. Try running:"

126− [ D.indent 4 $ D.green $ "elm install elm/json"

127− , D.reflow "It helps me handle flags and ports."

128− ]

129−

130−

131−

132−-- PROBLEM TO DOCS

133−

134−

135−data BadElmJsonContent

136− = BadType Text.Text

137− | BadPkgName String

138− | BadVersion Text.Text

139− | BadConstraint String

140− | BadModuleName Text.Text

141− | BadModuleHeaderTooLong Text.Text

142− | BadDependencyName Text.Text

143− | BadLicense Text.Text [Text.Text]

144− | BadDirectoryNotString

145− | BadSummaryTooLong

146−

147−

148−badContentToDocs :: BadElmJsonContent -> [D.Doc]

149−badContentToDocs badContent =

150− case badContent of

151− BadType _ ->

152− ["The","only","valid","types","of","elm.json","are"

153− ,D.green "\"application\"","and",D.green "\"package\"" <> "."

154− ]

155−

156− BadPkgName problem ->

157− map D.fromString (words problem)

158−

159− BadVersion txt ->

160− ["You","provided",D.red (D.fromString (show txt))

161− ,"which","is","not","a","valid","version.","I","need","something","like"

162− ,D.green "\"1.0.0\"","or",D.green "\"2.0.4\"" <> "."

163− ]

164−

165− BadConstraint problem ->

166− map D.fromString (words ("It is not a valid constraint. " ++ problem))

167−

168− BadModuleName name ->

169− ["You","provided",D.fromString (show name),"which","is","not","a","valid","module","name."

170− ,"I","need","something","like",D.green "\"Html.Events\"","or",D.green "\"Browser.Navigation\"" <> "."

171− ]

172−

173− BadModuleHeaderTooLong header ->

174− ["The",D.fromString (show header),"header","is","too","long."

175− ,"I","need","it","to","be",D.green "under",D.green "20",D.green "characters"

176− ,"to","ensure","that","formatting","is","nice","on","the","package","website."

177− ]

178−

179− BadDependencyName name ->

180− ["The",D.fromString (show name),"entry","is","not","a","valid","package","name."

181− ,"I","recommend","deleting","it,","finding","the","package","you","want","on"

182− ,"the","package","website,","and","installing","it","with","the"

183− ,D.green "`elm install`","command","instead."

184− ]

185−

186− BadLicense _given suggestions ->

187− case suggestions of

188− [] ->

189− ["I","need","an","OSI","approved","SPDX","license,","like"

190− ,D.green "\"BSD-3-Clause\"","or",D.green "\"MIT\".","See"

191− ,"<https://spdx.org/licenses/>","for","a","full","list","of","options."

192− ]

193−

194− code:codes ->

195− ["I","need","an","OSI","approved","SPDX","license."]

196− ++ ["Maybe you wanted"] ++ oneOf code codes ++ ["instead?"]

197− ++ ["See","<https://spdx.org/licenses/>","for","a","full","list","of","options."]

198−

199− BadDirectoryNotString ->

200− ["I","need","a",D.green "STRING","that","points","to","a","directory","of","Elm","code."

201− ]

202−

203− BadSummaryTooLong ->

204− ["Your","summary","is","too","long.","I","need","it","to"

205− ,"be",D.green "under",D.green "80",D.green "characters."

206− ]

207−

208−

209−oneOf :: Text.Text -> [Text.Text] -> [D.Doc]

210−oneOf code codes =

211− let

212− toDoc spdx =

213− D.green (D.fromString (show spdx))

214− in

215− case codes of

216− [] ->

217− [toDoc code]

218−

219− [code2] ->

220− [toDoc code,"or",toDoc code2]

221−

222− _:_ ->

223− let

224− these = code : init codes

225− final = last codes

226− in

227− map (\spdx -> toDoc spdx <> ",") these ++ ["or",toDoc final]

builder/src/Reporting/Exit/Crawl.hsdeleted−345

@@ -1,345 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−module Reporting.Exit.Crawl

3− ( Exit(..)

4− , Problem(..)

5− , Origin(..)

6− , SrcDirs(..)

7− , toReport

8− )

9− where

10−

11−

12−import qualified Data.Char as Char

13−import qualified Data.Map as Map

14−import qualified Data.Time.Clock as Time

15−

16−import qualified Elm.Compiler as Compiler

17−import qualified Elm.ModuleName as ModuleName

18−import qualified Elm.Package as Pkg

19−import qualified Elm.Version as V

20−import Reporting.Doc ((<+>), (<>))

21−import qualified Reporting.Doc as D

22−import qualified Reporting.Exit.Compile as Compile

23−import qualified Reporting.Exit.Help as Help

24−

25−

26−

27−-- EXIT

28−

29−

30−data Exit

31− = RootFileNotFound FilePath

32− | RootModuleNameDuplicate ModuleName.Raw [FilePath]

33− | RootNameless FilePath

34− | DependencyProblems Problem [Problem]

35− | BadKernelHeader FilePath

36−

37−

38−data Problem

39− = ModuleNotFound Origin ModuleName.Raw SrcDirs

40− | ModuleAmbiguous Origin ModuleName.Raw [FilePath] [Pkg.Canonical]

41− | BadHeader FilePath Time.UTCTime String Compiler.Error

42− | ModuleNameReservedForKernel Origin ModuleName.Raw

43− | ModuleNameMissing FilePath ModuleName.Raw

44− | ModuleNameMismatch

45− FilePath

46− ModuleName.Raw -- expected

47− ModuleName.Raw -- actual

48− | PortsInPackage FilePath ModuleName.Raw

49− | EffectsUnexpected FilePath ModuleName.Raw

50−

51−

52−data Origin

53− = ElmJson

54− | File FilePath

55− | Module FilePath ModuleName.Raw

56−

57−

58−data SrcDirs

59− = App [FilePath]

60− | Pkg

61−

62−

63−

64−-- TO REPORT

65−

66−

67−toReport :: Exit -> Help.Report

68−toReport exit =

69− case exit of

70− RootFileNotFound path ->

71− Help.report "FILE NOT FOUND" Nothing

72− "You want me to compile this file:"

73− [ D.indent 4 $ D.dullyellow $ D.fromChars path

74− , "I cannot find it though! Is there a typo?"

75− ]

76−

77− RootModuleNameDuplicate name paths ->

78− Help.report "DUPLICATE NAMES" Nothing

79− "I am trying to compile multiple modules with the same name:"

80− [ D.indent 4 $ D.dullyellow $ D.vcat $

81− map D.fromChars paths

82− , D.fillSep $

83− [ "These", "modules", if length paths == 2 then "both" else "all", "claim"

84− , "to", "be", "named", D.dullyellow (D.fromChars (ModuleName.nameToChars name)) <> "."

85− , "Change", "them", "to", "have", "unique", "names", "and", "you"

86− , "should", "be", "all", "set!"

87− ]

88− ]

89−

90− RootNameless path ->

91− namelessToDoc path "Main"

92−

93− DependencyProblems problem otherProblems ->

94− case otherProblems of

95− [] ->

96− problemToReport problem

97−

98− _ ->

99− problemToReport problem

100− -- error "TODO handle multiple dependency errors"

101−

102− BadKernelHeader filePath ->

103− Help.report "BAD KERNEL HEADER" Nothing

104− "I ran into a bad header in this file:"

105− [ D.indent 4 $ D.dullyellow $ D.fromChars filePath

106− , D.reflow $

107− "NOTE: Kernel code is only available to core Elm libraries to ensure\

108− \ the portability and security of the Elm ecosystem. This restriction\

109− \ also makes it possible to improve code gen (i.e. performance) without\

110− \ disrupting the ecosystem."

111− ]

112−

113−

114−

115−-- PROBLEM TO REPORT

116−

117−

118−problemToReport :: Problem -> Help.Report

119−problemToReport problem =

120− case problem of

121− ModuleNotFound origin name srcDirs ->

122− notFoundToDoc origin name srcDirs

123−

124− ModuleAmbiguous origin child paths pkgs ->

125− ambiguousToDoc origin child paths pkgs

126−

127− BadHeader path time source compilerError ->

128− let

129− compilerExit =

130− Compile.Exit "???" path time source [compilerError]

131− in

132− Help.compilerReport compilerExit []

133−

134− ModuleNameMissing path name ->

135− namelessToDoc path name

136−

137− ModuleNameMismatch path expected actual ->

138− Help.report "MODULE NAME MISMATCH" (Just path)

139− ( "The file at " ++ path ++ " has a typo in the module name. It says:"

140− )

141− [ D.indent 4 $ D.dullyellow $ "module" <+> D.red (D.fromChars (ModuleName.nameToChars actual)) <+> "exposing (..)"

142− , "Looks like a typo or copy/paste error. Instead it needs to say:"

143− , D.indent 4 $ D.dullyellow $ "module" <+> D.green (D.fromChars (ModuleName.nameToChars expected)) <+> "exposing (..)"

144− , "Make the change and you should be all set!"

145− ]

146−

147− ModuleNameReservedForKernel origin name ->

148− kernelNameToDoc origin name

149−

150− PortsInPackage path name ->

151− badTagToDoc path name "port" "port-modules" $

152− "Packages cannot have any `port` modules."

153−

154− EffectsUnexpected path name ->

155− badTagToDoc path name "effect" "effect-modules" $

156− "Creating `effect` modules is relatively experimental. There are a\

157− \ couple in @elm repos right now, but we have decided to be very\

158− \ cautious in expanding its usage."

159−

160−

161−badTagToDoc :: FilePath -> ModuleName.Raw -> String -> String -> String -> Help.Report

162−badTagToDoc path name tag hintName summary =

163− Help.report

164− ("UNEXPECTED " ++ map Char.toUpper tag ++ " MODULE")

165− (Just path)

166− summary

167− [ D.fillSep $

168− [ "Get", "rid", "of", "all", "the"

169− , D.red (D.fromChars tag)

170− , "stuff", "in"

171− , D.dullyellow (D.fromChars (ModuleName.nameToChars name))

172− , "to", "proceed."

173− ]

174− , D.toSimpleNote $

175− "You can learn the reasoning behind this design choice at "

176− ++ D.makeLink hintName

177− ]

178−

179−

180−

181−-- NAMELESS

182−

183−

184−namelessToDoc :: FilePath -> ModuleName.Raw -> Help.Report

185−namelessToDoc path name =

186− Help.report "UNNAMED MODULE" (Just path)

187− ( "The `" ++ ModuleName.nameToChars name

188− ++ "` module must start with a line like this:"

189− )

190− [ D.indent 4 $ D.dullyellow $ D.fromChars $

191− "module " ++ ModuleName.nameToChars name ++ " exposing (..)"

192− , D.reflow $

193− "Try adding that as the first line of your file!"

194− , D.toSimpleNote $

195− "It is best to replace (..) with an explicit list of types and\

196− \ functions you want to expose. If you know a value is only used\

197− \ WITHIN this module, it is extra easy to refactor. This kind of\

198− \ information is great, especially as your project grows!"

199− ]

200−

201−

202−

203−-- NOT FOUND

204−

205−

206−notFoundToDoc :: Origin -> ModuleName.Raw -> SrcDirs -> Help.Report

207−notFoundToDoc origin child srcDirs =

208− case origin of

209− ElmJson ->

210− Help.report "MODULE NOT FOUND" (Just "elm.json")

211− "Your elm.json says your project has the following module:"

212− [ D.indent 4 $ D.red $ D.fromChars $ ModuleName.nameToChars child

213− , D.reflow $

214− "When creating packages, all modules must live in the src/ directory."

215− ]

216−

217− File path ->

218− Help.report "UNKNOWN IMPORT" (Just path)

219− ("I cannot find a `" ++ ModuleName.nameToChars child ++ "` module to import.")

220− (notFoundDetails child srcDirs)

221−

222− Module path parent ->

223− Help.report "UNKNOWN IMPORT" (Just path)

224− ("The " ++ ModuleName.nameToChars parent ++ " module has a bad import:")

225− (notFoundDetails child srcDirs)

226−

227−

228−notFoundDetails :: ModuleName.Raw -> SrcDirs -> [D.Doc]

229−notFoundDetails child srcDirs =

230− let

231− simulatedCode =

232− D.indent 4 $ D.red $ D.fromChars $ "import " ++ ModuleName.nameToChars child

233− in

234− case Map.lookup child Pkg.suggestions of

235− Just pkg ->

236− [ simulatedCode

237− , D.reflow $

238− "Do you want the one from the " ++ Pkg.toChars pkg

239− ++ " package? If so, run this command to add that dependency to your elm.json file:"

240− , D.indent 4 $ D.green $ D.fromChars $ "elm install " ++ Pkg.toChars pkg

241− , case srcDirs of

242− Pkg ->

243− D.reflow $

244− "If you want a local file, make sure the `"

245− ++ ModuleName.nameToChars child

246− ++ "` module is in your src/ directory."

247−

248− App _ ->

249− D.reflow $

250− "If you want a local file, make sure the `"

251− ++ ModuleName.nameToChars child

252− ++ "` module is in one of the \"source-directories\" listed in your elm.json file."

253− ]

254−

255− Nothing ->

256− [ simulatedCode

257− , "I cannot find that module! Is there a typo in the module name?"

258− , D.reflow $

259− case srcDirs of

260− Pkg ->

261− "When creating a package, all modules must live in the src/ directory."

262−

263− App [] ->

264− "The \"source-directories\" field of your elm.json is empty, so I only\

265− \ searched in packages. Maybe you need to add a \"src\" directory there?"

266−

267− App [dir] ->

268− "The \"source-directories\" field of your elm.json tells me to only look in the "

269− ++ dir ++ " directory, but it is not there. Maybe it is in a package that is not installed yet?"

270−

271− App (dir:_:_) ->

272− "The \"source-directories\" field of your elm.json tells me to look in directories like "

273− ++ dir ++ ", but it is not in any of them. Maybe it is in a package that is not installed yet?"

274− ]

275−

276−

277−ambiguousToDoc :: Origin -> ModuleName.Raw -> [FilePath] -> [Pkg.Canonical] -> Help.Report

278−ambiguousToDoc origin child paths pkgs =

279− let

280− pkgToString (Pkg.Canonical pkg vsn) =

281− "exposed by " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn

282−

283− makeReport maybePath summary yellowString =

284− Help.report "AMBIGUOUS IMPORT" maybePath summary

285− [ D.indent 4 $ D.dullyellow $ D.fromChars yellowString

286− , D.reflow $

287− "I found multiple module with that name though:"

288− , D.indent 4 $ D.dullyellow $ D.vcat $

289− map D.fromChars $ paths ++ map pkgToString pkgs

290− , D.reflow $

291− if null paths then

292− "It looks like the name clash is in your dependencies, which is\

293− \ out of your control. Elm does not support this scenario right\

294− \ now, but it may be worthwhile. Please open an issue describing\

295− \ your scenario so we can gather more usage information!"

296− else

297− "Which is the right one? Try renaming your modules to have unique names."

298− ]

299− in

300− case origin of

301− ElmJson ->

302− makeReport

303− Nothing

304− "Your elm.json wants the following module:"

305− (ModuleName.nameToChars child)

306−

307− File path ->

308− makeReport

309− (Just path)

310− ("The file at " ++ path ++ " has an ambiguous import:")

311− ("import " ++ ModuleName.nameToChars child)

312−

313− Module path parent ->

314− makeReport

315− (Just path)

316− ("The " ++ ModuleName.nameToChars parent ++ " module has an ambiguous import:")

317− ("import " ++ ModuleName.nameToChars child)

318−

319−

320−kernelNameToDoc :: Origin -> ModuleName.Raw -> Help.Report

321−kernelNameToDoc origin kernelName =

322− let

323− (maybePath, statement) =

324− case origin of

325− ElmJson ->

326− ( Nothing

327− , "Your elm.json says your project has the following module:"

328− )

329−

330− File path ->

331− ( Just path

332− , "This file is trying to import the following module:"

333− )

334−

335− Module path parent ->

336− ( Just path

337− , "Your " ++ ModuleName.nameToChars parent ++ " module is trying to import:"

338− )

339− in

340− Help.report "BAD MODULE NAME" maybePath statement

341− [ D.indent 4 $ D.dullyellow $ D.fromChars $ ModuleName.nameToChars kernelName

342− , D.reflow $

343− "But names like that are reserved for internal use.\

344− \ Switch to a name outside of the Elm/Kernel/ namespace."

345− ]

builder/src/Reporting/Exit/Deps.hsdeleted−123

@@ -1,123 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−module Reporting.Exit.Deps

3− ( Exit(..)

4− , toReport

5− )

6− where

7−

8−

9−import qualified Elm.Constraint as Con

10−import qualified Elm.Package as Pkg

11−import qualified Elm.Version as V

12−import Reporting.Doc ((<>))

13−import qualified Reporting.Doc as D

14−import qualified Reporting.Exit.Help as Help

15−

16−

17−

18−-- EXITS

19−

20−

21−data Exit

22− = CorruptVersionCache FilePath Pkg.Name

23− | PackageNotFound Pkg.Name [Pkg.Name]

24− -- verify

25− | PkgBadElm Con.Constraint

26− | AppBadElm V.Version

27− | AppMissingTrans [(Pkg.Name, V.Version)]

28− | BadDeps

29− | BuildFailure FilePath Pkg.Name V.Version

30−

31−

32−

33−-- TO DOC

34−

35−

36−toReport :: Exit -> Help.Report

37−toReport exit =

38− case exit of

39− CorruptVersionCache elmHome pkg ->

40− Help.report "CORRUPT CACHE" Nothing

41− ( "I ran into an unknown package while exploring dependencies:"

42− )

43− [ D.indent 4 $ D.dullyellow $ D.fromUtf8 $ Pkg.toString pkg

44− , D.reflow $

45− "This suggests that your " ++ elmHome ++ " directory has been corrupted.\

46− \ Maybe some program is messing with it? It is just cached files,\

47− \ so you can delete it and see if that fixes the issue."

48− ]

49−

50− PackageNotFound package suggestions ->

51− Help.docReport "PACKAGE NOT FOUND" Nothing

52− ( D.fillSep

53− ["I","cannot","find","a"

54− ,D.red (D.fromUtf8 (Pkg.toString package))

55− ,"package","on","the","package","website."

56− ]

57− )

58− [ "Maybe you want one of these instead?"

59− , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromUtf8 . Pkg.toString) suggestions

60− , "But check <https://package.elm-lang.org> to see all possibilities!"

61− ]

62−

63− PkgBadElm constraint ->

64− Help.report "ELM VERSION MISMATCH" (Just "elm.json")

65− "Your elm.json says this package needs a version of Elm in this range:"

66− [ D.indent 4 $ D.dullyellow $ D.fromUtf8 $ Con.toString constraint

67− , D.fillSep

68− [ "But", "you", "are", "using", "Elm"

69− , D.red (D.fromUtf8 (V.toString V.compiler))

70− , "right", "now."

71− ]

72− ]

73−

74− AppBadElm version ->

75− Help.report "ELM VERSION MISMATCH" (Just "elm.json")

76− "Your elm.json says this application needs a different version of Elm."

77− [ D.fillSep

78− [ "It", "requires"

79− , D.green (D.fromUtf8 (V.toString version)) <> ","

80− , "but", "you", "are", "using"

81− , D.red (D.fromUtf8 (V.toString V.compiler))

82− , "right", "now."

83− ]

84− ]

85−

86− AppMissingTrans missingDeps ->

87− let

88− toEntry (pkg, vsn) =

89− "\"" ++ Pkg.toChars pkg ++ "\": \"" ++ V.toChars vsn ++ "\""

90− in

91− Help.report "MISSING DEPENDENCIES" (Just "elm.json")

92− "Your elm.json is missing some \"indirect\" dependencies:"

93− [ D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromChars . toEntry) missingDeps

94− , D.fillSep

95− ["This","usually","means","you","are","editing","elm.json","by","hand."

96− ,"It","is","much","more","reliable","to","use","the"

97− ,D.green "elm install","command","instead."

98− ]

99− ]

100−

101− BadDeps ->

102− Help.report "INVALID PACKAGE DEPENDENCIES" (Just "elm.json")

103− "The dependencies in your elm.json are not compatible."

104− [ D.fillSep

105− ["Did","you","change","them","by","hand?","Try","to","change","it","back!"

106− ,"It","is","much","better","to","add","dependencies","with",D.green "elm install"

107− ,"or","the","dependency","management","tool","in",D.green "elm reactor" <> "."

108− ]

109− , D.reflow $

110− "Please ask for help on the Elm slack <http://elmlang.herokuapp.com/> if\

111− \ you try those paths and still cannot figure it out!"

112− ]

113−

114− BuildFailure elmHome pkg vsn ->

115− Help.report "CORRUPT DEPENDENCY" Nothing

116− "I ran into a problem while building the following package:"

117− [ D.indent 4 $ D.red $ D.fromChars $ Pkg.toChars pkg ++ " " ++ V.toChars vsn

118− , D.fillSep

119− ["This","probably","means","the","downloaded","files","got","corrupted","somehow."

120− ,"Try","deleting",D.dullyellow (D.fromChars elmHome),"(a","directory","for"

121− ,"caching","build","artifacts)","and","see","if","that","resolves","the","issue."

122− ]

123− ]

builder/src/Reporting/Exit/Help.hs+5−5

@@ -29,7 +29,7 @@ import qualified Reporting.Error as Error

2929

3030

3131data Report

32− = CompilerReport Error.Module [Error.Module]

32+ = CompilerReport FilePath Error.Module [Error.Module]

3333 | Report

3434 { _title :: String

3535 , _path :: Maybe FilePath

@@ -52,7 +52,7 @@ jsonReport =

5252 Report

5353

5454

55−compilerReport :: Error.Module -> [Error.Module] -> Report

55+compilerReport :: FilePath -> Error.Module -> [Error.Module] -> Report

5656compilerReport =

5757 CompilerReport

5858

@@ -64,8 +64,8 @@ compilerReport =

6464reportToDoc :: Report -> D.Doc

6565reportToDoc report_ =

6666 case report_ of

67− CompilerReport e es ->

68− Error.toDoc e es

67+ CompilerReport root e es ->

68+ Error.toDoc root e es

6969

7070 Report title maybePath message ->

7171 let

@@ -94,7 +94,7 @@ reportToDoc report_ =

9494reportToJson :: Report -> E.Value

9595reportToJson report_ =

9696 case report_ of

97− CompilerReport e es ->

97+ CompilerReport _ e es ->

9898 E.object

9999 [ "type" ==> E.chars "compile-errors"

100100 , "errors" ==> E.list Error.toJson (e:es)

builder/src/Reporting/Exit/Http.hsdeleted−104

@@ -1,104 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−module Reporting.Exit.Http

3− ( Exit(..)

4− , toReport

5− , BadJson(..)

6− , badJsonToDocs

7− )

8− where

9−

10−

11−import qualified Data.Text as Text

12−

13−import Reporting.Doc ((<>))

14−import qualified Reporting.Doc as D

15−import qualified Reporting.Exit.Help as Help

16−

17−

18−

19−-- EXITS

20−

21−

22−data Exit

23− = Unknown String

24− | BadJson String D.Doc

25− | BadZipData

26− | BadZipSha String String

27−

28−

29−

30−-- TO REPORT

31−

32−

33−toReport :: String -> Exit -> Help.Report

34−toReport url exit =

35− let

36− urlDoc =

37− D.indent 4 $ D.dullyellow $ "<" <> D.fromString url <> ">"

38− in

39− case exit of

40− Unknown message ->

41− Help.report "HTTP PROBLEM" Nothing "The following HTTP request failed:"

42− [ urlDoc

43− , D.stack

44− [ "Here is the error message I was able to extract:"

45− , D.indent 4 $ D.reflow message

46− ]

47− ]

48−

49− BadJson path doc ->

50− Help.jsonReport "UNEXPECTED JSON" (Just path) doc

51−

52− BadZipData ->

53− Help.report "CORRUPT ZIP" Nothing "I could not unzip the file downloaded from:"

54− [ urlDoc

55− , D.reflow $

56− "If it is a transient issue, it should be fixed if you try this\

57− \ again. If it seems like an Elm problem, please report it though!"

58− ]

59−

60− BadZipSha expectedHash actualHash ->

61− Help.report "CORRUPT ZIP" Nothing "I got an unexpected zip file from:"

62− [ urlDoc

63− , D.reflow "I check the hash the zip, and it seems off:"

64− , D.vcat $ map D.fromString $

65− [ " Expected: " ++ expectedHash

66− , " Actual: " ++ actualHash

67− ]

68− , D.reflow $

69− "This usually means that the package author moved the version\

70− \ tag, so report it to them and see if that is the issue. Folks\

71− \ on Elm slack can probably help as well."

72− ]

73−

74−

75−

76−-- BAD JSON

77−

78−

79−data BadJson

80− = BadNewPkg Text.Text

81− | BadAllPkg Text.Text String

82− | BadAllVsn Text.Text

83−

84−

85−badJsonToDocs :: BadJson -> [D.Doc]

86−badJsonToDocs badJson =

87− case badJson of

88− BadNewPkg txt ->

89− ["I","ran","into",D.red (D.fromString (show txt)) <> ","

90− ,"but","I","need","entries","like"

91− ,D.green "\"elm/core@6.0.0\"" <> "."

92− ]

93−

94− BadAllPkg txt suggestion ->

95− ["The",D.red (D.fromString (show txt)),"value","is","not","a","valid","package","name."

96− ]

97− ++ map D.fromString (words suggestion)

98−

99− BadAllVsn txt ->

100− ["You","provided",D.red (D.fromString (show txt))

101− ,"which","is","not","a","valid","version.","I","need","something","like"

102− ,D.green "\"1.0.0\"","or",D.green "\"2.0.4\"" <> "."

103− ]

104−

builder/src/Reporting/Task.hs+17

@@ -3,8 +3,10 @@ module Reporting.Task

33 ( Task

44 , run

55 , throw

6+ , mapError

67 --

78 , io

9+ , mio

810 , eio

911 )

1012 where

@@ -31,6 +33,12 @@ throw x =

3133 Task $ \_ err -> err x

3234

3335

36+mapError :: (x -> y) -> Task x a -> Task y a

37+mapError func (Task task) =

38+ Task $ \ok err ->

39+ task ok (err . func)

40+

41+

3442

3543-- IO

3644

@@ -41,6 +49,15 @@ io work =

4149 Task $ \ok _ -> work >>= ok

4250

4351

52+mio :: x -> IO (Maybe a) -> Task x a

53+mio x work =

54+ Task $ \ok err ->

55+ do result <- work

56+ case result of

57+ Just a -> ok a

58+ Nothing -> err x

59+

60+

4461eio :: (x -> y) -> IO (Either x a) -> Task y a

4562eio func work =

4663 Task $ \ok err ->

builder/src/Stuff.hs+8−9

@@ -8,8 +8,8 @@ module Stuff

88 , elmo

99 , temp

1010 , findRoot

11− , withProjectLock

12− , withCacheLock

11+ , withRootLock

12+ , withRegistryLock

1313 , PackageCache

1414 , getPackageCache

1515 , registry

@@ -120,17 +120,16 @@ findRootHelp dirs =

120120-- LOCKS

121121

122122

123−withProjectLock :: FilePath -> IO a -> IO a

124−withProjectLock root work =

123+withRootLock :: FilePath -> IO a -> IO a

124+withRootLock root work =

125125 do let dir = stuff root

126126 Dir.createDirectoryIfMissing True dir

127− Lock.withFileLock (dir </> "project.lock") Lock.Exclusive (\_ -> work)

127+ Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)

128128

129129

130−withCacheLock :: PackageCache -> IO a -> IO a

131−withCacheLock (PackageCache dir) work =

132− Lock.withFileLock (dir </> "cache.lock") Lock.Exclusive (\_ -> work)

133−

130+withRegistryLock :: PackageCache -> IO a -> IO a

131+withRegistryLock (PackageCache dir) work =

132+ Lock.withFileLock (dir </> "lock") Lock.Exclusive (\_ -> work)

134133

135134

136135

cabal.confignew file+2

@@ -0,0 +1,2 @@

1+profiling: False

2+library-profiling: True

compiler/src/AST/Canonical.hs+2−2

@@ -342,7 +342,7 @@ instance Binary CtorOpts where

342342 0 -> return Normal

343343 1 -> return Enum

344344 2 -> return Unbox

345− _ -> error "binary encoding of CtorOpts was corrupted"

345+ _ -> fail "binary encoding of CtorOpts was corrupted"

346346

347347

348348instance Binary Annotation where

@@ -393,7 +393,7 @@ instance Binary AliasType where

393393 case n of

394394 0 -> liftM Holey get

395395 1 -> liftM Filled get

396− _ -> error "binary encoding of AliasType was corrupted"

396+ _ -> fail "binary encoding of AliasType was corrupted"

397397

398398

399399instance Binary FieldType where

compiler/src/AST/Optimized.hs+9−9

@@ -135,7 +135,7 @@ data GlobalGraph =

135135data LocalGraph =

136136 LocalGraph

137137 { _l_main :: Maybe Main

138− , _l_nodes :: Map.Map Global Node -- TODO profile switching Global to Name

138+ , _l_nodes :: Map.Map Global Node -- PERF profile switching Global to Name

139139 , _l_fields :: Map.Map Name Int

140140 }

141141

@@ -308,7 +308,7 @@ instance Binary Expr where

308308 24 -> pure Unit

309309 25 -> liftM3 Tuple get get get

310310 26 -> liftM3 Shader get get get

311− _ -> error "problem getting Opt.Expr binary"

311+ _ -> fail "problem getting Opt.Expr binary"

312312

313313

314314instance Binary Def where

@@ -322,7 +322,7 @@ instance Binary Def where

322322 case word of

323323 0 -> liftM2 Def get get

324324 1 -> liftM3 TailDef get get get

325− _ -> error "problem getting Opt.Def binary"

325+ _ -> fail "problem getting Opt.Def binary"

326326

327327

328328instance Binary Destructor where

@@ -345,7 +345,7 @@ instance Binary Path where

345345 1 -> liftM2 Field get get

346346 2 -> liftM Unbox get

347347 3 -> liftM Root get

348− _ -> error "problem getting Opt.Path binary"

348+ _ -> fail "problem getting Opt.Path binary"

349349

350350

351351instance (Binary a) => Binary (Decider a) where

@@ -361,7 +361,7 @@ instance (Binary a) => Binary (Decider a) where

361361 0 -> liftM Leaf get

362362 1 -> liftM3 Chain get get get

363363 2 -> liftM3 FanOut get get get

364− _ -> error "problem getting Opt.Decider binary"

364+ _ -> fail "problem getting Opt.Decider binary"

365365

366366

367367instance Binary Choice where

@@ -375,7 +375,7 @@ instance Binary Choice where

375375 case word of

376376 0 -> liftM Inline get

377377 1 -> liftM Jump get

378− _ -> error "problem getting Opt.Choice binary"

378+ _ -> fail "problem getting Opt.Choice binary"

379379

380380

381381

@@ -400,7 +400,7 @@ instance Binary Main where

400400 case word of

401401 0 -> return Static

402402 1 -> liftM2 Dynamic get get

403− _ -> error "problem getting Opt.Main binary"

403+ _ -> fail "problem getting Opt.Main binary"

404404

405405

406406instance Binary Node where

@@ -432,7 +432,7 @@ instance Binary Node where

432432 8 -> liftM2 Kernel get get

433433 9 -> liftM2 PortIncoming get get

434434 10 -> liftM2 PortOutgoing get get

435− _ -> error "problem getting Opt.Node binary"

435+ _ -> fail "problem getting Opt.Node binary"

436436

437437

438438instance Binary EffectsType where

@@ -448,4 +448,4 @@ instance Binary EffectsType where

448448 0 -> return Cmd

449449 1 -> return Sub

450450 2 -> return Fx

451− _ -> error "problem getting Opt.EffectsType binary"

451+ _ -> fail "problem getting Opt.EffectsType binary"

compiler/src/AST/Source.hs+5−5

@@ -195,15 +195,15 @@ newtype Comment =

195195

196196data Exposing

197197 = Open

198− | Explicit [A.Located Exposed]

198+ | Explicit [Exposed]

199199

200200

201201data Exposed

202− = Lower Name

203− | Upper Name Privacy

204− | Operator Name

202+ = Lower (A.Located Name)

203+ | Upper (A.Located Name) Privacy

204+ | Operator A.Region Name

205205

206206

207207data Privacy

208− = Public

208+ = Public A.Region

209209 | Private

compiler/src/AST/Utils/Binop.hs+5−6

@@ -41,12 +41,11 @@ instance Binary Precedence where

4141instance Binary Associativity where

4242 get =

4343 do n <- getWord8

44− return $

45− case n of

46− 0 -> Left

47− 1 -> Non

48− 2 -> Right

49− _ -> error "Error reading valid associativity from serialized string"

44+ case n of

45+ 0 -> return Left

46+ 1 -> return Non

47+ 2 -> return Right

48+ _ -> fail "Error reading valid associativity from serialized string"

5049

5150 put assoc =

5251 putWord8 $

compiler/src/AST/Utils/Shader.hs+2

@@ -74,9 +74,11 @@ escape chars =

7474 []

7575

7676 c:cs

77+ | c == '\r' -> escape cs

7778 | c == '\n' -> '\\' : 'n' : escape cs

7879 | c == '\"' -> '\\' : '"' : escape cs

7980 | c == '\'' -> '\\' : '\'' : escape cs

81+ | c == '\\' -> '\\' : '\\' : escape cs

8082 | otherwise -> c : escape cs

8183

8284

compiler/src/AST/Utils/Type.hs−1

@@ -1,5 +1,4 @@

11{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE OverloadedStrings #-}

32module AST.Utils.Type

43 ( delambda

54 , dealias

compiler/src/Canonicalize/Environment.hs+50−20

@@ -4,6 +4,8 @@ module Canonicalize.Environment

44 ( Env(..)

55 , Exposed

66 , Qualified

7+ , Info(..)

8+ , mergeInfo

79 , Var(..)

810 , Type(..)

911 , Ctor(..)

@@ -20,8 +22,8 @@ module Canonicalize.Environment

2022

2123import qualified Data.Map.Merge.Strict as Map

2224import qualified Data.Map.Strict as Map

23−import qualified Data.Map.Strict.Internal as I

2425import qualified Data.Name as Name

26+import qualified Data.OneOrMore as OneOrMore

2527

2628import qualified AST.Utils.Binop as Binop

2729import qualified AST.Canonical as Can

@@ -58,11 +60,34 @@ data Env =

5860

5961

6062type Exposed a =

61− Map.Map Name.Name (Map.Map ModuleName.Canonical a)

63+ Map.Map Name.Name (Info a)

6264

6365

6466type Qualified a =

65− Map.Map Name.Name (Map.Map Name.Name (Map.Map ModuleName.Canonical a))

67+ Map.Map Name.Name (Map.Map Name.Name (Info a))

68+

69+

70+

71+-- INFO

72+

73+

74+data Info a

75+ = Specific ModuleName.Canonical a

76+ | Ambiguous ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

77+

78+

79+mergeInfo :: Info a -> Info a -> Info a

80+mergeInfo info1 info2 =

81+ case info1 of

82+ Specific h1 _ ->

83+ case info2 of

84+ Specific h2 _ -> if h1 == h2 then info1 else Ambiguous h1 (OneOrMore.one h2)

85+ Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more (OneOrMore.one h2) hs2)

86+

87+ Ambiguous h1 hs1 ->

88+ case info2 of

89+ Specific h2 _ -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.one h2))

90+ Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.more (OneOrMore.one h2) hs2))

6691

6792

6893

@@ -72,7 +97,8 @@ type Qualified a =

7297data Var

7398 = Local A.Region

7499 | TopLevel A.Region

75− | Foreign (Map.Map ModuleName.Canonical Can.Annotation)

100+ | Foreign ModuleName.Canonical Can.Annotation

101+ | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

76102

77103

78104

@@ -139,7 +165,10 @@ addLocalLeft _ region =

139165addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var

140166addLocalBoth name region var =

141167 case var of

142− Foreign _ ->

168+ Foreign _ _ ->

169+ Result.ok (Local region)

170+

171+ Foreigns _ _ ->

143172 Result.ok (Local region)

144173

145174 Local parentRegion ->

@@ -150,17 +179,18 @@ addLocalBoth name region var =

150179

151180

152181

182+

153183-- FIND TYPE

154184

155185

156186findType :: A.Region -> Env -> Name.Name -> Result i w Type

157187findType region (Env _ _ ts _ _ _ qts _) name =

158188 case Map.lookup name ts of

159− Just (I.Bin 1 _ tipe _ _) ->

189+ Just (Specific _ tipe) ->

160190 Result.ok tipe

161191

162− Just homes ->

163− Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))

192+ Just (Ambiguous h hs) ->

193+ Result.throw (Error.AmbiguousType region Nothing name h hs)

164194

165195 Nothing ->

166196 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))

@@ -171,11 +201,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =

171201 case Map.lookup prefix qts of

172202 Just qualified ->

173203 case Map.lookup name qualified of

174− Just (I.Bin 1 _ tipe _ _) ->

204+ Just (Specific _ tipe) ->

175205 Result.ok tipe

176206

177− Just homes ->

178− Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))

207+ Just (Ambiguous h hs) ->

208+ Result.throw (Error.AmbiguousType region (Just prefix) name h hs)

179209

180210 Nothing ->

181211 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))

@@ -191,11 +221,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =

191221findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor

192222findCtor region (Env _ _ _ cs _ _ _ qcs) name =

193223 case Map.lookup name cs of

194− Just (I.Bin 1 _ ctor _ _) ->

224+ Just (Specific _ ctor) ->

195225 Result.ok ctor

196226

197− Just homes ->

198− Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))

227+ Just (Ambiguous h hs) ->

228+ Result.throw (Error.AmbiguousVariant region Nothing name h hs)

199229

200230 Nothing ->

201231 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))

@@ -206,11 +236,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =

206236 case Map.lookup prefix qcs of

207237 Just qualified ->

208238 case Map.lookup name qualified of

209− Just (I.Bin 1 _ pattern _ _) ->

239+ Just (Specific _ pattern) ->

210240 Result.ok pattern

211241

212− Just homes ->

213− Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))

242+ Just (Ambiguous h hs) ->

243+ Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)

214244

215245 Nothing ->

216246 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))

@@ -226,11 +256,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =

226256findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop

227257findBinop region (Env _ _ _ _ binops _ _ _) name =

228258 case Map.lookup name binops of

229− Just (I.Bin 1 _ binop _ _) ->

259+ Just (Specific _ binop) ->

230260 Result.ok binop

231261

232− Just homes ->

233− Result.throw (Error.AmbiguousBinop region name (Map.keys homes))

262+ Just (Ambiguous h hs) ->

263+ Result.throw (Error.AmbiguousBinop region name h hs)

234264

235265 Nothing ->

236266 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))

compiler/src/Canonicalize/Environment/Dups.hs+1−1

@@ -105,7 +105,7 @@ one name region value =

105105

106106insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a

107107insert name region value dict =

108− Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict

108+ Map.insertWith (\new old -> OneOrMore.more old new) name (OneOrMore.one (Info region value)) dict

109109

110110

111111union :: Dict a -> Dict a -> Dict a

compiler/src/Canonicalize/Environment/Foreign.hs+49−37

@@ -35,7 +35,14 @@ type Result i w a =

3535createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env

3636createInitialEnv home ifaces imports =

3737 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)

38− Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)

38+ Result.ok (Env.Env home (Map.map infoToVar vs) ts cs bs qvs qts qcs)

39+

40+

41+infoToVar :: Env.Info Can.Annotation -> Env.Var

42+infoToVar info =

43+ case info of

44+ Env.Specific home tipe -> Env.Foreign home tipe

45+ Env.Ambiguous h hs -> Env.Foreigns h hs

3946

4047

4148

@@ -61,7 +68,7 @@ emptyState =

6168

6269emptyTypes :: Env.Exposed Env.Type

6370emptyTypes =

64− Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))

71+ Map.singleton "List" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))

6572

6673

6774

@@ -102,8 +109,8 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe

102109 (Map.mapMaybeWithKey (unionToType home) unions)

103110 (Map.mapMaybeWithKey (aliasToType home) aliases)

104111

105− !vars = Map.map (Map.singleton home) defs

106− !types = Map.map (Map.singleton home . fst) rawTypeInfo

112+ !vars = Map.map (Env.Specific home) defs

113+ !types = Map.map (Env.Specific home . fst) rawTypeInfo

107114 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo

108115

109116 !qvs2 = addQualified prefix vars qvs

@@ -129,7 +136,7 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe

129136

130137addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a

131138addExposed =

132− Map.unionWith Map.union

139+ Map.unionWith Env.mergeInfo

133140

134141

135142addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a

@@ -150,7 +157,7 @@ unionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type,

150157unionToTypeHelp home name union@(Can.Union vars ctors _ _) =

151158 let

152159 addCtor dict (Can.Ctor ctor index _ args) =

153− Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict

160+ Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict

154161 in

155162 ( Env.Union (length vars) home

156163 , List.foldl' addCtor Map.empty ctors

@@ -181,7 +188,7 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =

181188 (Can.TAlias home name avars (Can.Filled tipe))

182189 (Can.fieldsToList fields)

183190 in

184− Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))

191+ Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))

185192

186193 _ ->

187194 Map.empty

@@ -192,9 +199,9 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =

192199-- BINOP

193200

194201

195−binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop

202+binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop

196203binopToBinop home op (I.Binop name annotation associativity precedence) =

197− Map.singleton home (Env.Binop op home name annotation associativity precedence)

204+ Env.Specific home (Env.Binop op home name annotation associativity precedence)

198205

199206

200207

@@ -207,19 +214,19 @@ addExposedValue

207214 -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor)

208215 -> Map.Map Name.Name I.Binop

209216 -> State

210− -> A.Located Src.Exposed

217+ -> Src.Exposed

211218 -> Result i w State

212−addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At region exposed) =

219+addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =

213220 case exposed of

214− Src.Lower name ->

221+ Src.Lower (A.At region name) ->

215222 case Map.lookup name vars of

216223 Just info ->

217− Result.ok (State (Map.insert name info vs) ts cs bs qvs qts qcs)

224+ Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)

218225

219226 Nothing ->

220227 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))

221228

222− Src.Upper name privacy ->

229+ Src.Upper (A.At region name) privacy ->

223230 case privacy of

224231 Src.Private ->

225232 case Map.lookup name types of

@@ -227,43 +234,43 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg

227234 case tipe of

228235 Env.Union _ _ ->

229236 let

230− !ts2 = Map.insert name (Map.singleton home tipe) ts

237+ !ts2 = Map.insert name (Env.Specific home tipe) ts

231238 in

232239 Result.ok (State vs ts2 cs bs qvs qts qcs)

233240

234241 Env.Alias _ _ _ _ ->

235242 let

236− !ts2 = Map.insert name (Map.singleton home tipe) ts

243+ !ts2 = Map.insert name (Env.Specific home tipe) ts

237244 !cs2 = addExposed cs ctors

238245 in

239246 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

240247

241248 Nothing ->

242− case Map.lookup name (toCtors types) of

243− Just tipe ->

249+ case checkForCtorMistake name types of

250+ tipe:_ ->

244251 Result.throw $ Error.ImportCtorByName region name tipe

245252

246− Nothing ->

253+ [] ->

247254 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)

248255

249− Src.Public ->

256+ Src.Public dotDotRegion ->

250257 case Map.lookup name types of

251258 Just (tipe, ctors) ->

252259 case tipe of

253260 Env.Union _ _ ->

254261 let

255− !ts2 = Map.insert name (Map.singleton home tipe) ts

262+ !ts2 = Map.insert name (Env.Specific home tipe) ts

256263 !cs2 = addExposed cs ctors

257264 in

258265 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

259266

260267 Env.Alias _ _ _ _ ->

261− Result.throw (Error.ImportOpenAlias region name)

268+ Result.throw (Error.ImportOpenAlias dotDotRegion name)

262269

263270 Nothing ->

264271 Result.throw (Error.ImportExposingNotFound region home name (Map.keys types))

265272

266− Src.Operator op ->

273+ Src.Operator region op ->

267274 case Map.lookup op binops of

268275 Just binop ->

269276 let

@@ -275,18 +282,23 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg

275282 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))

276283

277284

278−

279−toCtors :: Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> Map.Map Name.Name Name.Name

280−toCtors types =

281− Map.foldr addCtors Map.empty types

285+checkForCtorMistake :: Name.Name -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> [Name.Name]

286+checkForCtorMistake givenName types =

287+ Map.foldr addMatches [] types

282288 where

283− addCtors (_, exposedCtors) dict =

284− Map.foldrWithKey addCtor dict exposedCtors

285−

286− addCtor ctorName homes dict =

287− case Map.elems homes of

288− [Env.Ctor _ tipeName _ _ _] ->

289− Map.insert ctorName tipeName dict

290−

291− _ ->

292− dict

289+ addMatches (_, exposedCtors) matches =

290+ Map.foldrWithKey addMatch matches exposedCtors

291+

292+ addMatch ctorName info matches =

293+ if ctorName /= givenName

294+ then matches

295+ else

296+ case info of

297+ Env.Specific _ (Env.Ctor _ tipeName _ _ _) ->

298+ tipeName : matches

299+

300+ Env.Specific _ (Env.RecordCtor _ _ _) ->

301+ matches

302+

303+ Env.Ambiguous _ _ ->

304+ matches

compiler/src/Canonicalize/Environment/Local.hs+5−5

@@ -110,7 +110,7 @@ addTypes (Src.Module _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs

110110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)

111111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =

112112 do arity <- checkUnionFreeVars union

113− let one = Map.singleton home (Env.Union arity home)

113+ let one = Env.Specific home (Env.Union arity home)

114114 Result.ok $ Map.insert name one types

115115

116116

@@ -133,7 +133,7 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

133133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->

134134 do args <- checkAliasFreeVars alias

135135 ctype <- Type.canonicalize env tipe

136− let one = Map.singleton home (Env.Alias (length args) home args ctype)

136+ let one = Env.Specific home (Env.Alias (length args) home args ctype)

137137 let ts1 = Map.insert name one ts

138138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs

139139

@@ -281,7 +281,7 @@ addCtors (Src.Module _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs

281281 )

282282

283283

284−type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)

284+type CtorDups = Dups.Dict (Env.Info Env.Ctor)

285285

286286

287287

@@ -297,7 +297,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At regi

297297 ,

298298 case ctipe of

299299 Can.TRecord fields Nothing ->

300− Dups.one name region (Map.singleton home (toRecordCtor home name vars fields))

300+ Dups.one name region (Env.Specific home (toRecordCtor home name vars fields))

301301

302302 _ ->

303303 Dups.none

@@ -351,5 +351,5 @@ toOpts ctors =

351351

352352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups

353353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =

354− Dups.one name region $ Map.singleton home $

354+ Dups.one name region $ Env.Specific home $

355355 Env.Ctor home typeName union index args

compiler/src/Canonicalize/Expression.hs+6−7

@@ -14,7 +14,6 @@ import Control.Monad (foldM)

1414import qualified Data.Graph as Graph

1515import qualified Data.List as List

1616import qualified Data.Map.Strict as Map

17−import qualified Data.Map.Strict.Internal as I

1817import qualified Data.Name as Name

1918

2019import qualified AST.Canonical as Can

@@ -696,15 +695,15 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =

696695 Env.TopLevel _ ->

697696 logVar name (Can.VarTopLevel localHome name)

698697

699− Env.Foreign (I.Bin 1 home annotation _ _) ->

698+ Env.Foreign home annotation ->

700699 Result.ok $

701700 if home == ModuleName.debug then

702701 Can.VarDebug localHome name annotation

703702 else

704703 Can.VarForeign home name annotation

705704

706− Env.Foreign homes ->

707− Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))

705+ Env.Foreigns h hs ->

706+ Result.throw (Error.AmbiguousVar region Nothing name h hs)

708707

709708 Nothing ->

710709 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))

@@ -715,15 +714,15 @@ findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =

715714 case Map.lookup prefix qvs of

716715 Just qualified ->

717716 case Map.lookup name qualified of

718− Just (I.Bin 1 home annotation _ _) ->

717+ Just (Env.Specific home annotation) ->

719718 Result.ok $

720719 if home == ModuleName.debug then

721720 Can.VarDebug localHome name annotation

722721 else

723722 Can.VarForeign home name annotation

724723

725− Just homes ->

726− Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))

724+ Just (Env.Ambiguous h hs) ->

725+ Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)

727726

728727 Nothing ->

729728 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))

compiler/src/Canonicalize/Module.hs+7−7

@@ -236,11 +236,11 @@ checkExposed

236236 -> Map.Map Name.Name alias

237237 -> Map.Map Name.Name binop

238238 -> Can.Effects

239− -> A.Located Src.Exposed

239+ -> Src.Exposed

240240 -> Result i w (Dups.Dict (A.Located Can.Export))

241−checkExposed values unions aliases binops effects (A.At region exposed) =

241+checkExposed values unions aliases binops effects exposed =

242242 case exposed of

243− Src.Lower name ->

243+ Src.Lower (A.At region name) ->

244244 if Map.member name values then

245245 ok name region Can.ExportValue

246246 else

@@ -252,23 +252,23 @@ checkExposed values unions aliases binops effects (A.At region exposed) =

252252 Result.throw $ Error.ExportNotFound region Error.BadVar name $

253253 ports ++ Map.keys values

254254

255− Src.Operator name ->

255+ Src.Operator region name ->

256256 if Map.member name binops then

257257 ok name region Can.ExportBinop

258258 else

259259 Result.throw $ Error.ExportNotFound region Error.BadOp name $

260260 Map.keys binops

261261

262− Src.Upper name Src.Public ->

262+ Src.Upper (A.At region name) (Src.Public dotDotRegion) ->

263263 if Map.member name unions then

264264 ok name region Can.ExportUnionOpen

265265 else if Map.member name aliases then

266− Result.throw $ Error.ExportOpenAlias region name

266+ Result.throw $ Error.ExportOpenAlias dotDotRegion name

267267 else

268268 Result.throw $ Error.ExportNotFound region Error.BadType name $

269269 Map.keys unions ++ Map.keys aliases

270270

271− Src.Upper name Src.Private ->

271+ Src.Upper (A.At region name) Src.Private ->

272272 if Map.member name unions then

273273 ok name region Can.ExportUnionClosed

274274 else if Map.member name aliases then

compiler/src/Canonicalize/Pattern.hs+3−2

@@ -8,6 +8,7 @@ module Canonicalize.Pattern

88 where

99

1010

11+import qualified Data.List as List

1112import qualified Data.Map.Strict as Map

1213import qualified Data.Name as Name

1314

@@ -173,8 +174,8 @@ logVar name region value =

173174logFields :: [A.Located Name.Name] -> a -> Result DupsDict w a

174175logFields fields value =

175176 let

176− addField (A.At region name) dict =

177+ addField dict (A.At region name) =

177178 Dups.insert name region region dict

178179 in

179180 Result.Result $ \bindings warnings _ ok ->

180− ok (foldr addField bindings fields) warnings value

181+ ok (List.foldl' addField bindings fields) warnings value

compiler/src/Data/Name.hs+60−60

@@ -19,7 +19,6 @@ module Data.Name

1919 , isAppendableType

2020 , isCompappendType

2121 , fromVarIndex

22− , fromReplCount

2322 , fromWords

2423 , fromManyNames

2524 , fromTypeVariable

@@ -32,7 +31,7 @@ module Data.Name

3231 , shader, debug, debugger, bitwise, basics

3332 , utils, negate, true, false, value

3433 , node, program, _main, _Main, dollar, identity

35− , replModule

34+ , replModule, replValueToPrint

3635 )

3736 where

3837

@@ -45,19 +44,14 @@ import qualified Data.Coerce as Coerce

4544import qualified Data.List as List

4645import qualified Data.String as Chars

4746import qualified Data.Utf8 as Utf8

48−import Foreign.Ptr (plusPtr, minusPtr)

4947import GHC.Exts

50− ( Int(I#), Ptr(Ptr)

51− , RealWorld

48+ ( Int(I#), Ptr

5249 , MutableByteArray#

5350 , isTrue#

5451 , newByteArray#

5552 , sizeofByteArray#

56− , writeWord8OffAddr#

57− , copyByteArrayToAddr#

5853 , unsafeFreezeByteArray#

5954 )

60−import GHC.IO

6155import GHC.ST (ST(ST), runST)

6256import GHC.Prim

6357import GHC.Word (Word8(W8#))

@@ -208,11 +202,11 @@ fromVarIndex :: Int -> Name

208202fromVarIndex n =

209203 runST

210204 (

211− do let !size = getIndexSize n

205+ do let !size = 2 + getIndexSize n

212206 mba <- newByteArray size

213207 writeWord8 mba 0 0x5F {- _ -}

214208 writeWord8 mba 1 0x76 {- v -}

215− writeDigits mba (size - 1) n

209+ writeDigitsAtEnd mba size n

216210 freeze mba

217211 )

218212

@@ -220,19 +214,20 @@ fromVarIndex n =

220214{-# INLINE getIndexSize #-}

221215getIndexSize :: Int -> Int

222216getIndexSize n

223− | n < 10 = 3

224− | n < 100 = 4

225− | True = 2 + ceiling (logBase 10 (fromIntegral n + 1) :: Float)

217+ | n < 10 = 1

218+ | n < 100 = 2

219+ | True = ceiling (logBase 10 (fromIntegral n + 1) :: Float)

226220

227221

228222

229−writeDigits :: MBA s -> Int -> Int -> ST s ()

230−writeDigits !mba !offset !n =

223+writeDigitsAtEnd :: MBA s -> Int -> Int -> ST s ()

224+writeDigitsAtEnd !mba !oldOffset !n =

231225 do let (q,r) = quotRem n 10

232− writeWord8 mba offset (0x30 + fromIntegral r)

226+ let !newOffset = oldOffset - 1

227+ writeWord8 mba newOffset (0x30 + fromIntegral r)

233228 if q <= 0

234229 then return ()

235− else writeDigits mba (offset-1) q

230+ else writeDigitsAtEnd mba newOffset q

236231

237232

238233

@@ -255,7 +250,7 @@ fromTypeVariable name@(Utf8.Utf8 ba#) index =

255250 mba <- newByteArray size

256251 copyToMBA name mba

257252 writeWord8 mba (I# len#) 0x5F {- _ -}

258− writeDigits mba (size - 1) index

253+ writeDigitsAtEnd mba size index

259254 freeze mba

260255 )

261256 else

@@ -264,7 +259,7 @@ fromTypeVariable name@(Utf8.Utf8 ba#) index =

264259 do let !size = I# len# + getIndexSize index

265260 mba <- newByteArray size

266261 copyToMBA name mba

267− writeDigits mba (size - 1) index

262+ writeDigitsAtEnd mba size index

268263 freeze mba

269264 )

270265

@@ -283,61 +278,61 @@ fromTypeVariableScheme scheme =

283278 freeze mba

284279 else

285280 do let (extra, letter) = quotRem scheme 26

286− let !size = getIndexSize extra

281+ let !size = 1 + getIndexSize extra

287282 mba <- newByteArray size

288283 writeWord8 mba 0 (0x61 + fromIntegral letter)

289− writeDigits mba (size - 1) extra

284+ writeDigitsAtEnd mba size extra

290285 freeze mba

291286 )

292287

293288

294289

295−-- FROM REPL COUNT

296−

297−

298−fromReplCount :: Int -> Name

299−fromReplCount n =

300− Utf8.fromChars ("repl_value_" ++ show n)

301−

302−

303−

304290-- FROM MANY NAMES

291+--

292+-- Creating a unique name by combining all the subnames can create names

293+-- longer than 256 bytes relatively easily. So instead, the first given name

294+-- (e.g. foo) is prefixed chars that are valid in JS but not Elm (e.g. _M$foo)

295+--

296+-- This should be a unique name since 0.19 disallows shadowing. It would not

297+-- be possible for multiple top-level cycles to include values with the same

298+-- name, so the important thing is to make the cycle name distinct from the

299+-- normal name. Same logic for destructuring patterns like (x,y)

305300

306301

307302fromManyNames :: [Name] -> Name

308303fromManyNames names =

309− let

310− !(I# size#) = sum (map (\(Utf8.Utf8 ba#) -> I# (sizeofByteArray# ba# +# 1#)) names)

311− in

312− runST

313− (

314− ST $ \s ->

315− case newByteArray# size# s of

316− (# s, mba# #) ->

317− case writeNames mba# 0# names s of

318− s ->

319− case unsafeFreezeByteArray# mba# s of

320− (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)

321− )

322−

323−

324−writeNames :: MutableByteArray# s -> Int# -> [Name] -> State# s -> State# s

325−writeNames mba# !offset# names s =

326304 case names of

327305 [] ->

328− s

329−

330− (Utf8.Utf8 ba#) : names ->

331− case writeWord8Array# mba# offset# 0x24## {- $ -} s of

332− s ->

333− let

334− !offset1# = offset# +# 1#

335− !len# = sizeofByteArray# ba#

336− !newOffset# = offset1# +# len#

337− in

338− case copyByteArray# ba# 0# mba# offset1# len# s of

339− s ->

340− writeNames mba# newOffset# names s

306+ blank

307+ -- NOTE: this case is needed for (let _ = Debug.log "x" x in ...)

308+ -- but maybe unused patterns should be stripped out instead

309+

310+ Utf8.Utf8 ba# : _ ->

311+ let

312+ len# = sizeofByteArray# ba#

313+ in

314+ runST

315+ (

316+ ST $ \s ->

317+ case newByteArray# (len# +# 3#) s of

318+ (# s, mba# #) ->

319+ case writeWord8Array# mba# 0# 0x5F## {-_-} s of

320+ s ->

321+ case writeWord8Array# mba# 1# 0x4D## {-M-} s of

322+ s ->

323+ case writeWord8Array# mba# 2# 0x24## {-$-} s of

324+ s ->

325+ case copyByteArray# ba# 0# mba# 3# len# s of

326+ s ->

327+ case unsafeFreezeByteArray# mba# s of

328+ (# s, ba# #) -> (# s, Utf8.Utf8 ba# #)

329+ )

330+

331+

332+{-# NOINLINE blank #-}

333+blank :: Name

334+blank =

335+ fromWords [0x5F,0x4D,0x24] {-_M$-}

341336

342337

343338

@@ -608,3 +603,8 @@ identity = fromChars "identity"

608603{-# NOINLINE replModule #-}

609604replModule :: Name

610605replModule = fromChars "Elm_Repl"

606+

607+

608+{-# NOINLINE replValueToPrint #-}

609+replValueToPrint :: Name

610+replValueToPrint = fromChars "repl_input_value_"

compiler/src/Data/NonEmptyList.hs+6−2

@@ -52,8 +52,12 @@ instance Foldable List where

5252-- SORT BY

5353

5454

55−sortBy :: (a -> a -> Ordering) -> List a -> List a

56−sortBy comparison (List x xs) =

55+sortBy :: (Ord b) => (a -> b) -> List a -> List a

56+sortBy toRank (List x xs) =

57+ let

58+ comparison a b =

59+ compare (toRank a) (toRank b)

60+ in

5761 case List.sortBy comparison xs of

5862 [] ->

5963 List x []

compiler/src/Data/Utf8.hs+6−4

@@ -63,7 +63,7 @@ import GHC.Exts

6363import GHC.IO

6464import GHC.ST (ST(ST), runST)

6565import GHC.Prim

66−import GHC.Word (Word8(W8#), Word16(W16#))

66+import GHC.Word (Word8(W8#))

6767

6868import qualified Parse.Primitives as P

6969

@@ -261,7 +261,9 @@ instance Eq (Utf8 t) where

261261

262262

263263-- COMPARE

264−

264+--

265+-- TODO: is it fine to sort by length and only compare bytes on length ties?

266+--

265267

266268instance Ord (Utf8 t) where

267269 compare (Utf8 ba1#) (Utf8 ba2#) =

@@ -455,7 +457,7 @@ toEscapedBuilderHelp before after !name@(Utf8 ba#) k =

455457 !bLen = minusPtr bEnd bOffset

456458 in

457459 if len <= bLen then

458− do -- TODO test if writing word-by-word is faster

460+ do -- PERF test if writing word-by-word is faster

459461 copyToPtr name offset bOffset len

460462 escape before after bOffset name offset len 0

461463 let !newBufferRange = B.BufferRange (plusPtr bOffset len) bEnd

@@ -565,7 +567,7 @@ data MBA s =

565567 MBA# (MutableByteArray# s)

566568

567569

568−newByteArray :: Int -> ST s (MBA s) -- TODO see if newPinnedByteArray for len > 256 is positive

570+newByteArray :: Int -> ST s (MBA s) -- PERF see if newPinnedByteArray for len > 256 is positive

569571newByteArray (I# len#) =

570572 ST $ \s ->

571573 case newByteArray# len# s of

compiler/src/Elm/Compiler/Imports.hs+3−3

@@ -49,14 +49,14 @@ closed =

4949

5050typeOpen :: Name.Name -> Src.Exposing

5151typeOpen name =

52− Src.Explicit [ A.At A.zero (Src.Upper name Src.Public) ]

52+ Src.Explicit [ Src.Upper (A.At A.zero name) (Src.Public A.zero) ]

5353

5454

5555typeClosed :: Name.Name -> Src.Exposing

5656typeClosed name =

57− Src.Explicit [ A.At A.zero (Src.Upper name Src.Private) ]

57+ Src.Explicit [ Src.Upper (A.At A.zero name) Src.Private ]

5858

5959

6060operator :: Name.Name -> Src.Exposing

6161operator op =

62− Src.Explicit [ A.At A.zero (Src.Operator op) ]

62+ Src.Explicit [ Src.Operator A.zero op ]

compiler/src/Elm/Compiler/Type/Extract.hs+1−1

@@ -87,7 +87,7 @@ toPublicName (ModuleName.Canonical _ home) name =

8787

8888newtype Types =

8989 Types (Map.Map ModuleName.Canonical Types_)

90− -- TODO profile Opt.Global representation

90+ -- PERF profile Opt.Global representation

9191 -- current representation needs less allocation

9292 -- but maybe the lookup is much worse

9393

compiler/src/Elm/Constraint.hs+1−1

@@ -216,7 +216,7 @@ instance Binary Op where

216216 case n of

217217 0 -> return Less

218218 1 -> return LessOrEqual

219− _ -> error "binary encoding of Op was corrupted"

219+ _ -> fail "binary encoding of Op was corrupted"

220220

221221

222222

compiler/src/Elm/Docs.hs+3−3

@@ -346,9 +346,9 @@ chompDocs :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

346346chompDocs names =

347347 do name <-

348348 P.addLocation $

349− P.oneOf E.Export

350− [ Var.lower E.Export

351− , Var.upper E.Export

349+ P.oneOf E.Name

350+ [ Var.lower E.Name

351+ , Var.upper E.Name

352352 , chompOperator

353353 ]

354354

compiler/src/Elm/Interface.hs+3−3

@@ -215,7 +215,7 @@ instance Binary Union where

215215 0 -> liftM OpenUnion get

216216 1 -> liftM ClosedUnion get

217217 2 -> liftM PrivateUnion get

218− _ -> error "binary encoding of Union was corrupted"

218+ _ -> fail "binary encoding of Union was corrupted"

219219

220220

221221instance Binary Alias where

@@ -229,7 +229,7 @@ instance Binary Alias where

229229 case n of

230230 0 -> liftM PublicAlias get

231231 1 -> liftM PrivateAlias get

232− _ -> error "binary encoding of Alias was corrupted"

232+ _ -> fail "binary encoding of Alias was corrupted"

233233

234234

235235instance Binary Binop where

@@ -251,4 +251,4 @@ instance Binary DependencyInterface where

251251 case n of

252252 0 -> liftM Public get

253253 1 -> liftM3 Private get get get

254− _ -> error "binary encoding of DependencyInterface was corrupted"

254+ _ -> fail "binary encoding of DependencyInterface was corrupted"

compiler/src/Elm/Kernel.hs+9−9

@@ -15,7 +15,7 @@ import qualified Data.ByteString.Internal as B

1515import qualified Data.List as List

1616import qualified Data.Map as Map

1717import qualified Data.Name as Name

18−import Data.Word (Word8, Word16)

18+import Data.Word (Word8)

1919import Foreign.Ptr (Ptr, plusPtr, minusPtr)

2020import Foreign.ForeignPtr (ForeignPtr)

2121import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

@@ -128,7 +128,7 @@ parseChunks vtable enums fields =

128128 cerr row col toError

129129

130130

131−chompChunks :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> 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 #)

132132chompChunks vs es fs src pos end row col lastPos revChunks =

133133 if pos >= end then

134134 let !js = toByteString src lastPos end in

@@ -168,7 +168,7 @@ toByteString src pos end =

168168

169169

170170-- relies on external checks in chompChunks

171−chompTag :: VarTable -> Enums -> Fields -> ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> 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 #)

172172chompTag vs es fs src pos end row col revChunks =

173173 let

174174 (# newPos, newCol #) = Var.chompInnerChars pos end col

@@ -319,19 +319,19 @@ toNames exposing =

319319 map toName exposedList

320320

321321

322−toName :: A.Located Src.Exposed -> Name.Name

323−toName (A.At _ exposed) =

322+toName :: Src.Exposed -> Name.Name

323+toName exposed =

324324 case exposed of

325− Src.Lower name ->

325+ Src.Lower (A.At _ name) ->

326326 name

327327

328− Src.Upper name Src.Private ->

328+ Src.Upper (A.At _ name) Src.Private ->

329329 name

330330

331− Src.Upper _ Src.Public ->

331+ Src.Upper _ (Src.Public _) ->

332332 error "cannot have Maybe(..) syntax in kernel code header"

333333

334− Src.Operator _ ->

334+ Src.Operator _ _ ->

335335 error "cannot use binops in kernel code"

336336

337337

compiler/src/Elm/Licenses.hs+25−25

@@ -83,63 +83,61 @@ check givenCode =

8383osiApprovedSpdxLicenses :: Map.Map Json.String [Char]

8484osiApprovedSpdxLicenses =

8585 Map.fromList

86− [ "AFL-1.1" ==> "Academic Free License v1.1"

86+ [ "0BSD" ==> "BSD Zero Clause License"

87+ , "AAL" ==> "Attribution Assurance License"

88+ , "AFL-1.1" ==> "Academic Free License v1.1"

8789 , "AFL-1.2" ==> "Academic Free License v1.2"

8890 , "AFL-2.0" ==> "Academic Free License v2.0"

8991 , "AFL-2.1" ==> "Academic Free License v2.1"

9092 , "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"

9294 , "Apache-1.1" ==> "Apache License 1.1"

9395 , "Apache-2.0" ==> "Apache License 2.0"

96+ , "APL-1.0" ==> "Adaptive Public License 1.0"

9497 , "APSL-1.0" ==> "Apple Public Source License 1.0"

9598 , "APSL-1.1" ==> "Apple Public Source License 1.1"

9699 , "APSL-1.2" ==> "Apple Public Source License 1.2"

97100 , "APSL-2.0" ==> "Apple Public Source License 2.0"

98101 , "Artistic-1.0" ==> "Artistic License 1.0"

99− , "Artistic-1.0-Perl" ==> "Artistic License 1.0 (Perl)"

100102 , "Artistic-1.0-cl8" ==> "Artistic License 1.0 w/clause 8"

103+ , "Artistic-1.0-Perl" ==> "Artistic License 1.0 (Perl)"

101104 , "Artistic-2.0" ==> "Artistic License 2.0"

102− , "AAL" ==> "Attribution Assurance License"

103− , "BSL-1.0" ==> "Boost Software License 1.0"

104105 , "BSD-2-Clause" ==> "BSD 2-clause \"Simplified\" License"

105106 , "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"

107110 , "CECILL-2.1" ==> "CeCILL Free Software License Agreement v2.1"

108111 , "CNRI-Python" ==> "CNRI Python License"

109− , "CDDL-1.0" ==> "Common Development and Distribution License 1.0"

110112 , "CPAL-1.0" ==> "Common Public Attribution License 1.0"

111113 , "CPL-1.0" ==> "Common Public License 1.0"

112− , "CATOSL-1.1" ==> "Computer Associates Trusted Open Source License 1.1"

113114 , "CUA-OPL-1.0" ==> "CUA Office Public License v1.0"

114− , "EPL-1.0" ==> "Eclipse Public License 1.0"

115115 , "ECL-1.0" ==> "Educational Community License v1.0"

116116 , "ECL-2.0" ==> "Educational Community License v2.0"

117117 , "EFL-1.0" ==> "Eiffel Forum License v1.0"

118118 , "EFL-2.0" ==> "Eiffel Forum License v2.0"

119119 , "Entessa" ==> "Entessa Public License v1.0"

120+ , "EPL-1.0" ==> "Eclipse Public License 1.0"

120121 , "EUDatagrid" ==> "EU DataGrid Software License"

121122 , "EUPL-1.1" ==> "European Union Public License 1.1"

122123 , "Fair" ==> "Fair License"

123124 , "Frameworx-1.0" ==> "Frameworx Open License 1.0"

124− , "AGPL-3.0" ==> "GNU Affero General Public License v3.0"

125125 , "GPL-2.0" ==> "GNU General Public License v2.0 only"

126126 , "GPL-3.0" ==> "GNU General Public License v3.0 only"

127− , "LGPL-2.1" ==> "GNU Lesser General Public License v2.1 only"

128− , "LGPL-3.0" ==> "GNU Lesser General Public License v3.0 only"

129− , "LGPL-2.0" ==> "GNU Library General Public License v2 only"

130127 , "HPND" ==> "Historic Permission Notice and Disclaimer"

131− , "IPL-1.0" ==> "IBM Public License v1.0"

132128 , "Intel" ==> "Intel Open Source License"

133129 , "IPA" ==> "IPA Font License"

130+ , "IPL-1.0" ==> "IBM Public License v1.0"

134131 , "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"

136135 , "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"

138136 , "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"

140138 , "LPL-1.0" ==> "Lucent Public License Version 1.0"

141− , "MS-PL" ==> "Microsoft Public License"

142− , "MS-RL" ==> "Microsoft Reciprocal License"

139+ , "LPL-1.02" ==> "Lucent Public License v1.02"

140+ , "LPPL-1.3c" ==> "LaTeX Project Public License v1.3c"

143141 , "MirOS" ==> "MirOS Licence"

144142 , "MIT" ==> "MIT License"

145143 , "Motosoto" ==> "Motosoto License"

@@ -147,38 +145,40 @@ osiApprovedSpdxLicenses =

147145 , "MPL-1.1" ==> "Mozilla Public License 1.1"

148146 , "MPL-2.0" ==> "Mozilla Public License 2.0"

149147 , "MPL-2.0-no-copyleft-exception" ==> "Mozilla Public License 2.0 (no copyleft exception)"

148+ , "MS-PL" ==> "Microsoft Public License"

149+ , "MS-RL" ==> "Microsoft Reciprocal License"

150150 , "Multics" ==> "Multics License"

151151 , "NASA-1.3" ==> "NASA Open Source Agreement 1.3"

152152 , "Naumen" ==> "Naumen Public License"

153+ , "NCSA" ==> "University of Illinois/NCSA Open Source License"

153154 , "NGPL" ==> "Nethack General Public License"

154155 , "Nokia" ==> "Nokia Open Source License"

155156 , "NPOSL-3.0" ==> "Non-Profit Open Software License 3.0"

156157 , "NTP" ==> "NTP License"

157158 , "OCLC-2.0" ==> "OCLC Research Public License 2.0"

159+ , "OFL-1.1" ==> "SIL Open Font License 1.1"

158160 , "OGTSL" ==> "Open Group Test Suite License"

161+ , "OSET-PL-2.1" ==> "OSET Public License version 2.1"

159162 , "OSL-1.0" ==> "Open Software License 1.0"

160163 , "OSL-2.0" ==> "Open Software License 2.0"

161164 , "OSL-2.1" ==> "Open Software License 2.1"

162165 , "OSL-3.0" ==> "Open Software License 3.0"

163− , "OSET-PL-2.1" ==> "OSET Public License version 2.1"

164166 , "PHP-3.0" ==> "PHP License v3.0"

165167 , "PostgreSQL" ==> "PostgreSQL License"

166168 , "Python-2.0" ==> "Python License 2.0"

167169 , "QPL-1.0" ==> "Q Public License 1.0"

168− , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"

169170 , "RPL-1.1" ==> "Reciprocal Public License 1.1"

170171 , "RPL-1.5" ==> "Reciprocal Public License 1.5"

172+ , "RPSL-1.0" ==> "RealNetworks Public Source License v1.0"

171173 , "RSCPL" ==> "Ricoh Source Code Public License"

172− , "OFL-1.1" ==> "SIL Open Font License 1.1"

173174 , "SimPL-2.0" ==> "Simple Public License 2.0"

174− , "Sleepycat" ==> "Sleepycat License"

175175 , "SISSL" ==> "Sun Industry Standards Source License v1.1"

176+ , "Sleepycat" ==> "Sleepycat License"

176177 , "SPL-1.0" ==> "Sun Public License v1.0"

177− , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"

178178 , "UPL-1.0" ==> "Universal Permissive License v1.0"

179− , "NCSA" ==> "University of Illinois/NCSA Open Source License"

180179 , "VSL-1.0" ==> "Vovida Software License v1.0"

181180 , "W3C" ==> "W3C Software Notice and License (2002-12-31)"

181+ , "Watcom-1.0" ==> "Sybase Open Watcom Public License 1.0"

182182 , "Xnet" ==> "X.Net License"

183183 , "Zlib" ==> "zlib License"

184184 , "ZPL-2.0" ==> "Zope Public License 2.0"

compiler/src/Elm/ModuleName.hs+2−7

@@ -7,12 +7,13 @@ module Elm.ModuleName

77 --

88 , encode

99 , decoder

10+ , parser

1011 --

1112 , Canonical(..)

1213 , basics, char, string

1314 , maybe, result, list, array, dict, tuple

1415 , platform, cmd, sub

15− , debug, bitwise

16+ , debug

1617 , virtualDom

1718 , jsonDecode, jsonEncode

1819 , webgl, texture, vector2, vector3, vector4, matrix4

@@ -22,7 +23,6 @@ module Elm.ModuleName

2223

2324import Control.Monad (liftM2)

2425import Data.Binary (Binary(..))

25−import qualified Data.Char as Char

2626import qualified Data.Name as Name

2727import qualified Data.Utf8 as Utf8

2828import Data.Word (Word8)

@@ -226,11 +226,6 @@ debug :: Canonical

226226debug = Canonical Pkg.core Name.debug

227227

228228

229−{-# NOINLINE bitwise #-}

230−bitwise :: Canonical

231−bitwise = Canonical Pkg.core Name.bitwise

232−

233−

234229

235230-- HTML

236231

compiler/src/Elm/Package.hs+5−15

@@ -31,7 +31,6 @@ module Elm.Package

3131import Control.Monad (liftM2)

3232import Data.Binary (Binary, get, put)

3333import qualified Data.Coerce as Coerce

34−import Data.Function (on)

3534import qualified Data.List as List

3635import qualified Data.Map as Map

3736import qualified Data.Name as Name

@@ -59,6 +58,7 @@ data Name =

5958 { _author :: !Author

6059 , _project :: !Project

6160 }

61+ deriving (Ord)

6262

6363

6464type Author = Utf8.Utf8 AUTHOR

@@ -236,12 +236,10 @@ nearbyNames (Name author1 project1) possibleNames =

236236 authorDist = authorDistance (Utf8.toChars author1)

237237 projectDist = projectDistance (Utf8.toChars project1)

238238

239− addDistance name@(Name author2 project2) =

240− ( authorDist author2 + projectDist project2, name )

239+ nameDistance (Name author2 project2) =

240+ authorDist author2 + projectDist project2

241241 in

242− map snd $ take 4 $

243− List.sortBy (compare `on` fst) $

244− map addDistance possibleNames

242+ take 4 $ List.sortOn nameDistance possibleNames

245243

246244

247245authorDistance :: [Char] -> Author -> Int

@@ -270,19 +268,11 @@ instance Eq Canonical where

270268 version1 == version2 && package1 == package2

271269

272270

273−instance Ord Name where

274− compare (Name author1 project1) (Name author2 project2) =

275− case compare project1 project2 of

276− LT -> LT

277− EQ -> compare author1 author2

278− GT -> GT

279−

280−

281271

282272-- BINARY

283273

284274

285−instance Binary Name where -- TODO try storing as a Word16

275+instance Binary Name where -- PERF try storing as a Word16

286276 get = liftM2 Name Utf8.getUnder256 Utf8.getUnder256

287277 put (Name a b) = Utf8.putUnder256 a >> Utf8.putUnder256 b

288278

compiler/src/Elm/String.hs−1

@@ -108,7 +108,6 @@ writeChunks mba offset chunks =

108108 writeChunks mba newOffset chunks

109109

110110

111−-- TODO see if it is faster to writeWord32 a block of hex-as-ascii

112111writeCode :: MBA RealWorld -> Int -> Int -> ST RealWorld ()

113112writeCode mba offset code =

114113 do writeWord8 mba offset 0x5C {- \ -}

compiler/src/Generate/Html.hs+11−10

@@ -29,22 +29,23 @@ sandwich moduleName javascript =

2929

3030<body>

3131

32−<pre id="elm">

33−This is a headless program, meaning there is nothing to show here.

34−

35−I started the program anyway though!

36−

37−You can access it as `app` in the developer console.

38−</pre>

32+<pre id="elm"></pre>

3933

4034<script>

35+try {

4136|] <> javascript <> [r|

4237

43−try {

4438 var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });

45−} catch (e) {

39+}

40+catch (e)

41+{

4642 // display initialization errors (e.g. bad flags, infinite recursion)

47− document.getElementById("elm").innerText = e;

43+ var header = document.createElement("h1");

44+ header.style.fontFamily = "monospace";

45+ header.innerText = "Initialization Error";

46+ var pre = document.getElementById("elm");

47+ document.body.insertBefore(header, pre);

48+ pre.innerText = e;

4849 throw e;

4950}

5051</script>

compiler/src/Generate/JavaScript.hs+46−10

@@ -2,6 +2,7 @@

22module Generate.JavaScript

33 ( generate

44 , generateForRepl

5+ , generateForReplEndpoint

56 )

67 where

78

@@ -85,7 +86,9 @@ generateForRepl ansi localizer (Opt.GlobalGraph graph _) home name (Can.Forall _

8586 debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")

8687 evalState = addGlobal mode graph debugState (Opt.Global home name)

8788 in

88− stateToBuilder evalState

89+ "process.on('uncaughtException', function(err) { process.stderr.write(err.toString() + '\\n'); process.exit(1); });"

90+ <> Functions.functions

91+ <> stateToBuilder evalState

8992 <> print ansi localizer home name tipe

9093

9194

@@ -97,14 +100,47 @@ print ansi localizer home name tipe =

97100 tipeDoc = RT.canToDoc localizer RT.None tipe

98101 bool = if ansi then "true" else "false"

99102 in

100− "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\

101− \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\

102− \function _print(t) { console.log(_value + (" <> bool <> " ? '\x1b[90m' + t + '\x1b[0m' : t)); }\n\

103− \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\

104− \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\

105− \} else {\n\

106− \ _print(' : ' + _type);\n\

107− \}\n"

103+ "var _value = " <> toString <> "(" <> bool <> ", " <> value <> ");\n\

104+ \var _type = " <> B.stringUtf8 (show (D.toString tipeDoc)) <> ";\n\

105+ \function _print(t) { console.log(_value + (" <> bool <> " ? '\x1b[90m' + t + '\x1b[0m' : t)); }\n\

106+ \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\

107+ \ _print('\\n : ' + _type.split('\\n').join('\\n '));\n\

108+ \} else {\n\

109+ \ _print(' : ' + _type);\n\

110+ \}\n"

111+

112+

113+

114+-- GENERATE FOR REPL ENDPOINT

115+

116+

117+generateForReplEndpoint :: L.Localizer -> Opt.GlobalGraph -> ModuleName.Canonical -> Maybe Name.Name -> Can.Annotation -> B.Builder

118+generateForReplEndpoint localizer (Opt.GlobalGraph graph _) home maybeName (Can.Forall _ tipe) =

119+ let

120+ name = maybe Name.replValueToPrint id maybeName

121+ mode = Mode.Dev Nothing

122+ debugState = addGlobal mode graph emptyState (Opt.Global ModuleName.debug "toString")

123+ evalState = addGlobal mode graph debugState (Opt.Global home name)

124+ in

125+ Functions.functions

126+ <> stateToBuilder evalState

127+ <> postMessage localizer home maybeName tipe

128+

129+

130+postMessage :: L.Localizer -> ModuleName.Canonical -> Maybe Name.Name -> Can.Type -> B.Builder

131+postMessage localizer home maybeName tipe =

132+ let

133+ name = maybe Name.replValueToPrint id maybeName

134+ value = JsName.toBuilder (JsName.fromGlobal home name)

135+ toString = JsName.toBuilder (JsName.fromKernel Name.debug "toAnsiString")

136+ tipeDoc = RT.canToDoc localizer RT.None tipe

137+ toName n = "\"" <> Name.toBuilder n <> "\""

138+ in

139+ "self.postMessage({\n\

140+ \ name: " <> maybe "null" toName maybeName <> ",\n\

141+ \ value: " <> toString <> "(true, " <> value <> "),\n\

142+ \ type: " <> B.stringUtf8 (show (D.toString tipeDoc)) <> "\n\

143+ \});\n"

108144

109145

110146

@@ -256,7 +292,7 @@ generateCycle mode (Opt.Global home _) names values functions =

256292 "Some top-level definitions from `" <> Name.toBuilder (ModuleName._module home) <> "` are causing infinite recursion:\\n"

257293 <> drawCycle names

258294 <> "\\n\\nThese errors are very tricky, so read "

259− <> B.stringUtf8 (D.makeNakedLink "halting-problem")

295+ <> B.stringUtf8 (D.makeNakedLink "bad-recursion")

260296 <> " to learn how to fix it!"

261297 ]

262298

compiler/src/Generate/Mode.hs−1

@@ -49,7 +49,6 @@ shortenFieldNames (Opt.GlobalGraph _ frequencies) =

4949

5050addToBuckets :: Name.Name -> Int -> Map.Map Int [Name.Name] -> Map.Map Int [Name.Name]

5151addToBuckets field frequency buckets =

52− -- TODO try using an IntMap for buckets

5352 Map.insertWith (++) frequency [field] buckets

5453

5554

compiler/src/Json/Decode.hs+77−72

@@ -24,6 +24,7 @@ module Json.Decode

2424 , Problem(..)

2525 , DecodeExpectation(..)

2626 , ParseError(..)

27+ , StringProblem(..)

2728 )

2829 where

2930

@@ -31,7 +32,7 @@ module Json.Decode

3132import qualified Data.ByteString.Internal as B

3233import qualified Data.Map as Map

3334import qualified Data.NonEmptyList as NE

34−import Data.Word (Word8, Word16)

35+import Data.Word (Word8)

3536import Foreign.Ptr (Ptr, plusPtr, minusPtr)

3637import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

3738

@@ -39,6 +40,7 @@ import qualified Json.String as Json

3940import qualified Parse.Keyword as K

4041import qualified Parse.Primitives as P

4142import Parse.Primitives (Row, Col)

43+import qualified Reporting.Annotation as A

4244

4345

4446

@@ -49,10 +51,10 @@ fromByteString :: Decoder x a -> B.ByteString -> Either (Error x) a

4951fromByteString (Decoder decode) src =

5052 case P.fromByteString pFile BadEnd src of

5153 Right ast ->

52− decode ast Right (Left . DecodeProblem)

54+ decode ast Right (Left . DecodeProblem src)

5355

5456 Left problem ->

55− Left (ParseProblem problem)

57+ Left (ParseProblem src problem)

5658

5759

5860

@@ -75,8 +77,8 @@ newtype Decoder x a =

7577

7678

7779data Error x

78− = DecodeProblem (Problem x)

79− | ParseProblem ParseError

80+ = DecodeProblem B.ByteString (Problem x)

81+ | ParseProblem B.ByteString ParseError

8082

8183

8284

@@ -87,8 +89,8 @@ data Problem x

8789 = Field B.ByteString (Problem x)

8890 | Index Int (Problem x)

8991 | OneOf (Problem x) [Problem x]

90− | Failure x

91− | Expecting DecodeExpectation

92+ | Failure A.Region x

93+ | Expecting A.Region DecodeExpectation

9294

9395

9496data DecodeExpectation

@@ -155,26 +157,26 @@ instance Monad (Decoder x) where

155157

156158string :: Decoder x Json.String

157159string =

158− Decoder $ \ast ok err ->

160+ Decoder $ \(A.At region ast) ok err ->

159161 case ast of

160162 String snippet ->

161163 ok (Json.fromSnippet snippet)

162164

163165 _ ->

164− err (Expecting TString)

166+ err (Expecting region TString)

165167

166168

167169customString :: P.Parser x a -> (Row -> Col -> x) -> Decoder x a

168170customString parser toBadEnd =

169− Decoder $ \ast ok err ->

171+ Decoder $ \(A.At region ast) ok err ->

170172 case ast of

171173 String snippet ->

172174 case P.fromSnippet parser toBadEnd snippet of

173175 Right a -> ok a

174− Left x -> err (Failure x)

176+ Left x -> err (Failure region x)

175177

176178 _ ->

177− err (Expecting TString)

179+ err (Expecting region TString)

178180

179181

180182

@@ -183,7 +185,7 @@ customString parser toBadEnd =

183185

184186bool :: Decoder x Bool

185187bool =

186− Decoder $ \ast ok err ->

188+ Decoder $ \(A.At region ast) ok err ->

187189 case ast of

188190 TRUE ->

189191 ok True

@@ -192,7 +194,7 @@ bool =

192194 ok False

193195

194196 _ ->

195− err (Expecting TBool)

197+ err (Expecting region TBool)

196198

197199

198200

@@ -201,13 +203,13 @@ bool =

201203

202204int :: Decoder x Int

203205int =

204− Decoder $ \ast ok err ->

206+ Decoder $ \(A.At region ast) ok err ->

205207 case ast of

206208 Int n ->

207209 ok n

208210

209211 _ ->

210− err (Expecting TInt)

212+ err (Expecting region TInt)

211213

212214

213215

@@ -216,13 +218,13 @@ int =

216218

217219list :: Decoder x a -> Decoder x [a]

218220list decoder =

219− Decoder $ \ast ok err ->

221+ Decoder $ \(A.At region ast) ok err ->

220222 case ast of

221223 Array asts ->

222224 listHelp decoder ok err 0 asts []

223225

224226 _ ->

225− err (Expecting TArray)

227+ err (Expecting region TArray)

226228

227229

228230listHelp :: Decoder x a -> ([a] -> b) -> (Problem x -> b) -> Int -> [AST] -> [a] -> b

@@ -257,7 +259,7 @@ nonEmptyList decoder x =

257259

258260pair :: Decoder x a -> Decoder x b -> Decoder x (a,b)

259261pair (Decoder decodeA) (Decoder decodeB) =

260− Decoder $ \ast ok err ->

262+ Decoder $ \(A.At region ast) ok err ->

261263 case ast of

262264 Array vs ->

263265 case vs of

@@ -274,10 +276,10 @@ pair (Decoder decodeA) (Decoder decodeB) =

274276 decodeA astA ok0 err0

275277

276278 _ ->

277− err (Expecting (TArrayPair (length vs)))

279+ err (Expecting region (TArrayPair (length vs)))

278280

279281 _ ->

280− err (Expecting TArray)

282+ err (Expecting region TArray)

281283

282284

283285

@@ -295,13 +297,13 @@ dict keyDecoder valueDecoder =

295297

296298pairs :: KeyDecoder x k -> Decoder x a -> Decoder x [(k, a)]

297299pairs keyDecoder valueDecoder =

298− Decoder $ \ast ok err ->

300+ Decoder $ \(A.At region ast) ok err ->

299301 case ast of

300302 Object kvs ->

301303 pairsHelp keyDecoder valueDecoder ok err kvs []

302304

303305 _ ->

304− err (Expecting TObject)

306+ err (Expecting region TObject)

305307

306308

307309pairsHelp :: KeyDecoder x k -> Decoder x a -> ([(k, a)] -> b) -> (Problem x -> b) -> [(P.Snippet, AST)] -> [(k, a)] -> b

@@ -313,7 +315,7 @@ pairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decod

313315 (snippet, ast) : kvs ->

314316 case P.fromSnippet keyParser toBadEnd snippet of

315317 Left x ->

316− err (Failure x)

318+ err (Failure (snippetToRegion snippet) x)

317319

318320 Right key ->

319321 let

@@ -325,13 +327,18 @@ pairsHelp keyDecoder@(KeyDecoder keyParser toBadEnd) valueDecoder@(Decoder decod

325327 decodeA ast ok' err'

326328

327329

330+snippetToRegion :: P.Snippet -> A.Region

331+snippetToRegion (P.Snippet _ _ len row col) =

332+ A.Region (A.Position row col) (A.Position row (col + fromIntegral len))

333+

334+

328335

329336-- FIELDS

330337

331338

332339field :: B.ByteString -> Decoder x a -> Decoder x a

333340field key (Decoder decodeA) =

334− Decoder $ \ast ok err ->

341+ Decoder $ \(A.At region ast) ok err ->

335342 case ast of

336343 Object kvs ->

337344 case findField key kvs of

@@ -343,10 +350,10 @@ field key (Decoder decodeA) =

343350 decodeA value ok err'

344351

345352 Nothing ->

346− err (Expecting (TObjectWith key))

353+ err (Expecting region (TObjectWith key))

347354

348355 _ ->

349− err (Expecting TObject)

356+ err (Expecting region TObject)

350357

351358

352359findField :: B.ByteString -> [(P.Snippet, AST)] -> Maybe AST

@@ -410,8 +417,8 @@ oneOfError problems prob ps =

410417

411418failure :: x -> Decoder x a

412419failure x =

413− Decoder $ \_ _ err ->

414− err (Failure x)

420+ Decoder $ \(A.At region _) _ err ->

421+ err (Failure region x)

415422

416423

417424

@@ -430,18 +437,22 @@ mapError func (Decoder decodeA) =

430437mapErrorHelp :: (x -> y) -> Problem x -> Problem y

431438mapErrorHelp func problem =

432439 case problem of

433− Field k p -> Field k (mapErrorHelp func p)

434− Index i p -> Index i (mapErrorHelp func p)

435− OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)

436− Failure x -> Failure (func x)

437− Expecting e -> Expecting e

440+ Field k p -> Field k (mapErrorHelp func p)

441+ Index i p -> Index i (mapErrorHelp func p)

442+ OneOf p ps -> OneOf (mapErrorHelp func p) (map (mapErrorHelp func) ps)

443+ Failure r x -> Failure r (func x)

444+ Expecting r e -> Expecting r e

438445

439446

440447

441448-- AST

442449

443450

444−data AST

451+type AST =

452+ A.Located AST_

453+

454+

455+data AST_

445456 = Array [AST]

446457 | Object [(P.Snippet, AST)]

447458 | String P.Snippet

@@ -460,21 +471,14 @@ type Parser a =

460471

461472

462473data ParseError

463− = ObjectStart Row Col

464− | ObjectMore Row Col

474+ = Start Row Col

475+ | ObjectField Row Col

476+ | ObjectColon Row Col

465477 | ObjectEnd Row Col

466− | ArrayStart Row Col

467− | ArrayMore Row Col

468478 | ArrayEnd Row Col

469− | StringStart Row Col

470479 | StringProblem StringProblem Row Col

471− | IntStart Row Col

472480 | NoLeadingZeros Row Col

473481 | NoFloats Row Col

474− | Bool Row Col

475− | Null Row Col

476− | Value Row Col

477− | Colon Row Col

478482 | BadEnd Row Col

479483

480484-- PIndex Int ParseError Row Col

@@ -502,14 +506,15 @@ pFile =

502506

503507pValue :: Parser AST

504508pValue =

505− P.oneOf Value

506− [ String <$> pString

509+ P.addLocation $

510+ P.oneOf Start

511+ [ String <$> pString Start

507512 , pObject

508513 , pArray

509514 , pInt

510− , K.k4 0x74 0x72 0x75 0x65 Bool >> return TRUE

511− , K.k5 0x66 0x61 0x6C 0x73 0x65 Bool >> return FALSE

512− , K.k4 0x6E 0x75 0x6C 0x6C Null >> return NULL

515+ , K.k4 0x74 0x72 0x75 0x65 Start >> return TRUE

516+ , K.k5 0x66 0x61 0x6C 0x73 0x65 Start >> return FALSE

517+ , K.k4 0x6E 0x75 0x6C 0x6C Start >> return NULL

513518 ]

514519

515520

@@ -517,11 +522,11 @@ pValue =

517522-- OBJECT

518523

519524

520−pObject :: Parser AST

525+pObject :: Parser AST_

521526pObject =

522− do P.word1 0x7B {- { -} ObjectStart

527+ do P.word1 0x7B {- { -} Start

523528 spaces

524− P.oneOf ObjectMore

529+ P.oneOf ObjectField

525530 [ do entry <- pField

526531 spaces

527532 pObjectHelp [entry]

@@ -530,11 +535,11 @@ pObject =

530535 ]

531536

532537

533−pObjectHelp :: [(P.Snippet, AST)] -> Parser AST

538+pObjectHelp :: [(P.Snippet, AST)] -> Parser AST_

534539pObjectHelp revEntries =

535− P.oneOf ObjectMore

540+ P.oneOf ObjectEnd

536541 [

537− do P.word1 0x2C {-,-} ObjectMore

542+ do P.word1 0x2C {-,-} ObjectEnd

538543 spaces

539544 entry <- pField

540545 spaces

@@ -547,9 +552,9 @@ pObjectHelp revEntries =

547552

548553pField :: Parser (P.Snippet, AST)

549554pField =

550− do key <- pString

555+ do key <- pString ObjectField

551556 spaces

552− P.word1 0x3A {-:-} Colon

557+ P.word1 0x3A {-:-} ObjectColon

553558 spaces

554559 value <- pValue

555560 return (key, value)

@@ -559,11 +564,11 @@ pField =

559564-- ARRAY

560565

561566

562−pArray :: Parser AST

567+pArray :: Parser AST_

563568pArray =

564− do P.word1 0x5B {-[-} ArrayStart

569+ do P.word1 0x5B {-[-} Start

565570 spaces

566− P.oneOf ArrayMore

571+ P.oneOf Start

567572 [ do entry <- pValue

568573 spaces

569574 pArrayHelp 1 [entry]

@@ -572,11 +577,11 @@ pArray =

572577 ]

573578

574579

575−pArrayHelp :: Int -> [AST] -> Parser AST

580+pArrayHelp :: Int -> [AST] -> Parser AST_

576581pArrayHelp !len revEntries =

577− P.oneOf ArrayMore

582+ P.oneOf ArrayEnd

578583 [

579− do P.word1 0x2C {-,-} ArrayMore

584+ do P.word1 0x2C {-,-} ArrayEnd

580585 spaces

581586 entry <- pValue

582587 spaces

@@ -591,8 +596,8 @@ pArrayHelp !len revEntries =

591596-- STRING

592597

593598

594−pString :: Parser P.Snippet

595−pString =

599+pString :: (Row -> Col -> ParseError) -> Parser P.Snippet

600+pString start =

596601 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

597602 if pos < end && P.unsafeIndex pos == 0x22 {-"-} then

598603

@@ -617,7 +622,7 @@ pString =

617622 cerr newRow newCol (StringProblem problem)

618623

619624 else

620− eerr row col StringStart

625+ eerr row col start

621626

622627

623628data StringStatus

@@ -625,7 +630,7 @@ data StringStatus

625630 | BadString StringProblem

626631

627632

628−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 #)

629634pStringHelp pos end row col =

630635 if pos >= end then

631636 (# BadString BadStringEnd, pos, row, col #)

@@ -703,7 +708,7 @@ spaces =

703708 cok () newState

704709

705710

706−eatSpaces :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Ptr Word8, Word16, Word16 #)

711+eatSpaces :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Ptr Word8, Row, Col #)

707712eatSpaces pos end row col =

708713 if pos >= end then

709714 (# pos, row, col #)

@@ -722,16 +727,16 @@ eatSpaces pos end row col =

722727-- INTS

723728

724729

725−pInt :: Parser AST

730+pInt :: Parser AST_

726731pInt =

727732 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->

728733 if pos >= end then

729− eerr row col IntStart

734+ eerr row col Start

730735

731736 else

732737 let !word = P.unsafeIndex pos in

733738 if not (isDecimalDigit word) then

734− eerr row col IntStart

739+ eerr row col Start

735740

736741 else if word == 0x30 {-0-} then

737742

compiler/src/Json/Encode.hs+4−3

@@ -104,21 +104,22 @@ list encodeEntry entries =

104104-- CHARS

105105

106106

107−chars :: [Char] -> Value -- TODO can this be done better? Look for examples.

107+chars :: [Char] -> Value -- PERF can this be done better? Look for examples.

108108chars chrs =

109109 String (B.char7 '"' <> B.stringUtf8 (escape chrs) <> B.char7 '"')

110110

111111

112−escape :: [Char] -> [Char] -- TODO is this correct?

112+escape :: [Char] -> [Char]

113113escape chrs =

114114 case chrs of

115115 [] ->

116116 []

117117

118118 c:cs

119+ | c == '\r' -> '\\' : 'r' : escape cs

119120 | c == '\n' -> '\\' : 'n' : escape cs

120121 | c == '\"' -> '\\' : '"' : escape cs

121− | c == '\'' -> '\\' : '\'' : escape cs

122+ | c == '\\' -> '\\' : '\\' : escape cs

122123 | otherwise -> c : escape cs

123124

124125

compiler/src/Json/String.hs+1−2

@@ -37,7 +37,7 @@ import qualified Parse.Primitives as P

3737

3838

3939-- INVARIANT: any Json.String is appropriately escaped already

40−-- TODO: is this the right representation for Json.String? Maybe ByteString instead?

40+-- PERF: is this the right representation for Json.String? Maybe ByteString instead?

4141--

4242type String =

4343 Utf8.Utf8 JSON_STRING

@@ -116,7 +116,6 @@ chompChunks pos end start revChunks =

116116 case word of

117117 0x0A {-\n-} -> chompEscape 0x6E {-n-} pos end start revChunks

118118 0x22 {-"-} -> chompEscape 0x22 {-"-} pos end start revChunks

119− 0x27 {-'-} -> chompEscape 0x27 {-'-} pos end start revChunks

120119 0x5C {-\-} -> chompEscape 0x5C {-\-} pos end start revChunks

121120 0x0D {-\r-} ->

122121 let

compiler/src/Optimize/DecisionTree.hs+2−2

@@ -618,7 +618,7 @@ instance Binary Test where

618618 5 -> liftM IsStr get

619619 6 -> liftM IsInt get

620620 7 -> liftM IsBool get

621− _ -> error "problem getting DecisionTree.Test binary"

621+ _ -> fail "problem getting DecisionTree.Test binary"

622622

623623

624624instance Binary Path where

@@ -634,4 +634,4 @@ instance Binary Path where

634634 0 -> liftM2 Index get get

635635 1 -> liftM Unbox get

636636 2 -> pure Empty

637− _ -> error "problem getting DecisionTree.Path binary"

637+ _ -> fail "problem getting DecisionTree.Path binary"

compiler/src/Optimize/Port.hs+1−1

@@ -58,7 +58,7 @@ toEncoder tipe =

5858 | name == Name.array -> encodeArray arg

5959

6060 _ ->

61− error "toEncoder: bad union type"

61+ error "toEncoder: bad custom type"

6262

6363 Can.TRecord _ (Just _) ->

6464 error "toEncoder: bad record"

compiler/src/Parse/Docs.hsdeleted−275

@@ -1,275 +0,0 @@

1−module Parse.Docs

2− ( Docs(..)

3− , parser

4− )

5− where

6−

7−

8−

9−-- DOCS

10−

11−

12−data Docs =

13− Docs

14− { _exposed :: [A.Located Name.Name]

15− , _overview :: Utf8.String

16− , _listed :: [A.Located Name.Name]

17− , _comments :: Map.Map Name.Name Utf8.String

18− }

19−

20−

21−

22−-- PARSER

23−

24−

25−parser :: Parser Docs

26−parser =

27− error "TODO implement docs parser"

28−

29−

30−chompUntilDocs :: Parser Bool

31−chompUntilDocs =

32− P.Parser $ \(P.State fp offset terminal indent row col ctx) cok _ _ _ ->

33− let

34− (# isStart, newOffset, newRow, newCol #) =

35− eatDocs fp offset terminal row col

36−

37− !newState =

38− P.State fp newOffset terminal indent newRow newCol ctx

39− in

40− cok isStart newState

41−

42−

43−eatDocs :: ForeignPtr Word8 -> Int -> Int -> Word16 -> Word16 -> (# Bool, Int, Word16, Word16 #)

44−eatDocs fp offset terminal row col =

45− if offset >= terminal then

46− (# False, offset, row, col #)

47−

48− else if isDocsStart fp offset terminal then

49− (# True, offset + 5, row, col + 5 #)

50−

51− else

52− let !word = P.unsafeIndex fp offset in

53− if word == 0x0A {- \n -} then

54− eatDocs fp (offset + 1) terminal (row + 1) 1

55−

56− else

57− let !newOffset = offset + P.getCharWidth fp offset terminal word in

58− eatDocs fp newOffset terminal row (col + 1)

59−

60−

61−isDocsStart :: ForeignPtr Word8 -> Int -> Int -> Bool

62−isDocsStart =

63− let (B.PS dfp doff dlen) = docsStart in

64− P.isSubstring dfp doff dlen

65−

66−

67−{-# NOINLINE docsStart #-}

68−docsStart :: B.ByteString

69−docsStart =

70− "@docs"

71−

72−

73−chompOverview :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

74−chompOverview names =

75− do isDocs <- chompUntilDocs

76− if isDocs

77− then chompOverviewHelp names

78− else return names

79−

80−

81−chompOverviewHelp :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

82−chompOverviewHelp names =

83− do pos <- getPosition

84− (SPos spos) <- whitespace

85− if pos == spos

86− then chompOverview names

87− else chompOverview =<< chompDocs names

88−

89−

90−chompDocs :: [A.Located Name.Name] -> Parser [A.Located Name.Name]

91−chompDocs names =

92− do name <- addLocation (oneOf SE.XXX [ Var.lower, Var.upper, chompBinop ])

93− spos <- whitespace

94− oneOf SE.XXX

95− [ do checkSpace spos

96− word1 0x2C {-,-} SE.XXX

97− spaces

98− chompDocs (name:names)

99− , return (name:names)

100− ]

101−

102−

103−chompBinop :: Parser Name.Name

104−chompBinop =

105− do word1 0x28 {-(-} SE.XXX

106− name <- Symbol.binop

107− word1 0x29 {-)-} SE.XXX

108− return name

109−

110−

111−

112−

113−-- CHECK NAMES

114−

115−

116−type Result i w a =

117− Result.Result i w E.Error a

118−

119−

120−type Dups =

121− Map.Map Name.Name (OneOrMore.OneOrMore A.Region)

122−

123−

124−checkNames :: Map.Map Name.Name (A.Located Can.Export) -> [A.Located Name.Name] -> Result i w ()

125−checkNames exports names =

126− do docs <- Map.traverseWithKey isUnique (List.foldl' addName Map.empty names)

127− let overlap = Map.size (Map.intersection docs exports)

128− if Map.size exports == overlap && overlap == Map.size docs

129− then Result.ok ()

130− else

131− do _ <- Map.traverseWithKey onlyInDocs (Map.difference docs exports)

132− _ <- Map.traverseWithKey onlyInExports (Map.difference exports docs)

133− Result.ok ()

134−

135−

136−addName :: Dups -> A.Located Name.Name -> Dups

137−addName dict (A.At region name) =

138− Map.insertWith OneOrMore.more name (OneOrMore.one region) dict

139−

140−

141−isUnique :: Name.Name -> OneOrMore.OneOrMore A.Region -> Result i w A.Region

142−isUnique name regions =

143− case regions of

144− OneOrMore.One region ->

145− Result.ok region

146−

147− OneOrMore.More _ _ ->

148− let (r1:r2:_) = OneOrMore.toList regions in

149− Result.throw (E.Duplicate name r1 r2)

150−

151−

152−onlyInDocs :: Name.Name -> A.Region -> Result i w a

153−onlyInDocs name region =

154− Result.throw $ E.OnlyInDocs name region

155−

156−

157−onlyInExports :: Name.Name -> A.Located Can.Export -> Result i w a

158−onlyInExports name (A.At region _) =

159− Result.throw $ E.OnlyInExports name region

160−

161−

162−

163−-- CHECK EXPORTS

164−

165−

166−data Info =

167− Info

168− { _iComments :: Map.Map Name.Name Comment

169− , _iValues :: Types

170− , _iUnions :: Map.Map Name.Name Can.Union

171− , _iAliases :: Map.Map Name.Name Can.Alias

172− , _iBinops :: Map.Map Name.Name Can.Binop

173− , _iEffects :: Can.Effects

174− }

175−

176−

177−checkExport :: Info -> Name.Name -> A.Located Can.Export -> Result i w (Module -> Module)

178−checkExport info name (A.At region export) =

179− case export of

180− Can.ExportValue ->

181− do tipe <- getType name info

182− comment <- getComment region name info

183− Result.ok $ \m ->

184− m { _values = Map.insert name (Value comment tipe) (_values m) }

185−

186− Can.ExportBinop ->

187− do let (Can.Binop_ assoc prec realName) = _iBinops info ! name

188− tipe <- getType realName info

189− comment <- getComment region realName info

190− Result.ok $ \m ->

191− m { _binops = Map.insert name (Binop comment tipe assoc prec) (_binops m) }

192−

193− Can.ExportAlias ->

194− do let (Can.Alias tvars tipe) = _iAliases info ! name

195− comment <- getComment region name info

196− Result.ok $ \m ->

197− m { _aliases = Map.insert name (Alias comment tvars (Extract.fromType tipe)) (_aliases m) }

198−

199− Can.ExportUnionOpen ->

200− do let (Can.Union tvars ctors _ _) = _iUnions info ! name

201− comment <- getComment region name info

202− Result.ok $ \m ->

203− m { _unions = Map.insert name (Union comment tvars (map dector ctors)) (_unions m) }

204−

205− Can.ExportUnionClosed ->

206− do let (Can.Union tvars _ _ _) = _iUnions info ! name

207− comment <- getComment region name info

208− Result.ok $ \m ->

209− m { _unions = Map.insert name (Union comment tvars []) (_unions m) }

210−

211− Can.ExportPort ->

212− do tipe <- getType name info

213− comment <- getComment region name info

214− Result.ok $ \m ->

215− m { _values = Map.insert name (Value comment tipe) (_values m) }

216−

217−

218−getComment :: A.Region -> Name.Name -> Info -> Result i w Comment

219−getComment region name info =

220− case Map.lookup name (_iComments info) of

221− Nothing ->

222− Result.throw (E.NoComment name region)

223−

224− Just comment ->

225− Result.ok comment

226−

227−

228−getType :: Name.Name -> Info -> Result i w Type.Type

229−getType name info =

230− case _iValues info ! name of

231− A.At defRegion Nothing ->

232− Result.throw (E.NoAnnotation name defRegion)

233−

234− A.At _ (Just tipe) ->

235− Result.ok (Extract.fromType tipe)

236−

237−

238−dector :: Can.Ctor -> (Name.Name, [Type.Type])

239−dector (Can.Ctor name _ _ args) =

240− ( name, map Extract.fromType args )

241−

242−

243−

244−-- GATHER TYPES

245−

246−

247−type Types =

248− Map.Map Name.Name (A.Located (Maybe Can.Type))

249−

250−

251−gatherTypes :: Can.Decls -> Types -> Types

252−gatherTypes decls types =

253− case decls of

254− Can.Declare def subDecls ->

255− gatherTypes subDecls (addDef types def)

256−

257− Can.DeclareRec defs subDecls ->

258− gatherTypes subDecls (List.foldl' addDef types defs)

259−

260− Can.SaveTheEnvironment ->

261− types

262−

263−

264−addDef :: Types -> Can.Def -> Types

265−addDef types def =

266− case def of

267− Can.Def (A.At region name) _ _ ->

268− Map.insert name (A.At region Nothing) types

269−

270− Can.TypedDef (A.At region name) _ typedArgs _ resultType ->

271− let

272− tipe =

273− foldr Can.TLambda resultType (map snd typedArgs)

274− in

275− Map.insert name (A.At region (Just tipe)) types

compiler/src/Parse/Expression.hs+40−32

@@ -128,38 +128,46 @@ chompListEnd start entries =

128128tuple :: A.Position -> Parser E.Expr Src.Expr

129129tuple start@(A.Position row col) =

130130 inContext E.Tuple (word1 0x28 {-(-} E.Start) $

131− oneOf E.TupleIndentExpr1

132− [

133− do op <- Symbol.operator E.TupleIndentExpr1 E.TupleOperatorReserved

134− if op == "-"

135− then

136− oneOf E.TupleOperatorClose

137− [

138− do word1 0x29 {-)-} E.TupleOperatorClose

139− addEnd start (Src.Op op)

140− ,

141− do (entry, end) <-

142− specialize E.TupleExpr $

143− do negatedExpr@(A.At (A.Region _ end) _) <- term

144− Space.chomp E.Space

145− let exprStart = A.Position row (col + 2)

146− let expr = A.at exprStart end (Src.Negate negatedExpr)

147− chompExprEnd exprStart (State [] expr [] end)

148− Space.checkIndent end E.TupleIndentEnd

149− chompTupleEnd start entry []

150− ]

151− else

152− do word1 0x29 {-)-} E.TupleOperatorClose

153− addEnd start (Src.Op op)

154− ,

155− do word1 0x29 {-)-} E.TupleIndentExpr1

156− addEnd start Src.Unit

157− ,

158− do Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr1

159− (entry, end) <- specialize E.TupleExpr expression

160− Space.checkIndent end E.TupleIndentEnd

161− chompTupleEnd start entry []

162− ]

131+ do before <- getPosition

132+ Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr1

133+ after <- getPosition

134+ if before /= after

135+ then

136+ do (entry, end) <- specialize E.TupleExpr expression

137+ Space.checkIndent end E.TupleIndentEnd

138+ chompTupleEnd start entry []

139+ else

140+ oneOf E.TupleIndentExpr1

141+ [

142+ do op <- Symbol.operator E.TupleIndentExpr1 E.TupleOperatorReserved

143+ if op == "-"

144+ then

145+ oneOf E.TupleOperatorClose

146+ [

147+ do word1 0x29 {-)-} E.TupleOperatorClose

148+ addEnd start (Src.Op op)

149+ ,

150+ do (entry, end) <-

151+ specialize E.TupleExpr $

152+ do negatedExpr@(A.At (A.Region _ end) _) <- term

153+ Space.chomp E.Space

154+ let exprStart = A.Position row (col + 2)

155+ let expr = A.at exprStart end (Src.Negate negatedExpr)

156+ chompExprEnd exprStart (State [] expr [] end)

157+ Space.checkIndent end E.TupleIndentEnd

158+ chompTupleEnd start entry []

159+ ]

160+ else

161+ do word1 0x29 {-)-} E.TupleOperatorClose

162+ addEnd start (Src.Op op)

163+ ,

164+ do word1 0x29 {-)-} E.TupleIndentExpr1

165+ addEnd start Src.Unit

166+ ,

167+ do (entry, end) <- specialize E.TupleExpr expression

168+ Space.checkIndent end E.TupleIndentEnd

169+ chompTupleEnd start entry []

170+ ]

163171

164172

165173chompTupleEnd :: A.Position -> Src.Expr -> [Src.Expr] -> Parser E.Tuple Src.Expr

compiler/src/Parse/Module.hs+110−60

@@ -2,7 +2,10 @@

22{-# LANGUAGE OverloadedStrings #-}

33module Parse.Module

44 ( fromByteString

5+ , ProjectType(..)

6+ , isKernel

57 , chompImports

8+ , chompImport

69 )

710 where

811

@@ -28,14 +31,37 @@ import qualified Reporting.Error.Syntax as E

2831-- FROM BYTE STRING

2932

3033

31−fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module

32−fromByteString pkg source =

33− case P.fromByteString (chompModule pkg) E.ModuleBadEnd source of

34− Right modul -> checkModule modul

34+fromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module

35+fromByteString projectType source =

36+ case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of

37+ Right modul -> checkModule projectType modul

3538 Left err -> Left (E.ParseError err)

3639

3740

3841

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+

3965-- MODULE

4066

4167

@@ -48,11 +74,11 @@ data Module =

4874 }

4975

5076

51−chompModule :: Pkg.Name -> Parser E.Module Module

52−chompModule pkg =

77+chompModule :: ProjectType -> Parser E.Module Module

78+chompModule projectType =

5379 do header <- chompHeader

54− imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)

55− infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []

80+ imports <- chompImports (if isCore projectType then [] else Imports.defaults)

81+ infixes <- if isKernel projectType then chompInfixes [] else return []

5682 decls <- specialize E.Declarations $ chompDecls []

5783 return (Module header imports infixes decls)

5884

@@ -61,15 +87,15 @@ chompModule pkg =

6187-- CHECK MODULE

6288

6389

64−checkModule :: Module -> Either E.Error Src.Module

65−checkModule (Module maybeHeader imports infixes decls) =

90+checkModule :: ProjectType -> Module -> Either E.Error Src.Module

91+checkModule projectType (Module maybeHeader imports infixes decls) =

6692 let

6793 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls

6894 in

6995 case maybeHeader of

7096 Just (Header name effects exports docs) ->

7197 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes

72− <$> checkEffects ports effects

98+ <$> checkEffects projectType ports effects

7399

74100 Nothing ->

75101 Right $

@@ -79,23 +105,37 @@ checkModule (Module maybeHeader imports infixes decls) =

79105 _:_ -> Src.Ports ports

80106

81107

82−checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects

83−checkEffects ports effects =

108+checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects

109+checkEffects projectType ports effects =

84110 case effects of

85111 NoEffects region ->

86112 case ports of

87− [] -> Right Src.NoEffects

88− _:_ -> Left (E.UnexpectedPort region)

113+ [] ->

114+ Right Src.NoEffects

115+

116+ Src.Port name _ : _ ->

117+ case projectType of

118+ Package _ -> Left (E.NoPortsInPackage name)

119+ Application -> Left (E.UnexpectedPort region)

89120

90121 Ports region ->

91− case ports of

92− [] -> Left (E.NoPorts region)

93− _:_ -> Right (Src.Ports ports)

122+ case projectType of

123+ Package _ ->

124+ Left (E.NoPortModulesInPackage region)

125+

126+ Application ->

127+ case ports of

128+ [] -> Left (E.NoPorts region)

129+ _:_ -> Right (Src.Ports ports)

94130

95131 Manager region manager ->

96− case ports of

97− [] -> Right (Src.Manager region manager)

98− _:_ -> Left (E.UnexpectedPort region)

132+ if isKernel projectType then

133+ case ports of

134+ [] -> Right (Src.Manager region manager)

135+ _:_ -> Left (E.UnexpectedPort region)

136+ else

137+ Left (E.NoEffectsOutsideKernel region)

138+

99139

100140

101141categorizeDecls :: [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] )

@@ -332,28 +372,33 @@ spaces_em =

332372

333373

334374chompImports :: [Src.Import] -> Parser E.Module [Src.Import]

335−chompImports imports =

375+chompImports is =

336376 oneOfWithFallback

337− [ do Keyword.import_ E.ImportStart

338− Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName

339− name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName)

340− Space.chomp E.ModuleSpace

341− oneOf E.ImportEnd

342− [ do Space.checkFreshLine E.ImportEnd

343− chompImports $

344− Src.Import name Nothing (Src.Explicit []) : imports

345− , do Space.checkIndent end E.ImportEnd

346− oneOf E.ImportAs

347− [ chompAs name imports

348− , chompExposing name Nothing imports

349− ]

350− ]

377+ [ do i <- chompImport

378+ chompImports (i:is)

351379 ]

352− (reverse imports)

380+ (reverse is)

381+

382+

383+chompImport :: Parser E.Module Src.Import

384+chompImport =

385+ do Keyword.import_ E.ImportStart

386+ Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName

387+ name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName)

388+ Space.chomp E.ModuleSpace

389+ oneOf E.ImportEnd

390+ [ do Space.checkFreshLine E.ImportEnd

391+ return $ Src.Import name Nothing (Src.Explicit [])

392+ , do Space.checkIndent end E.ImportEnd

393+ oneOf E.ImportAs

394+ [ chompAs name

395+ , chompExposing name Nothing

396+ ]

397+ ]

353398

354399

355−chompAs :: A.Located Name.Name -> [Src.Import] -> Parser E.Module [Src.Import]

356−chompAs name imports =

400+chompAs :: A.Located Name.Name -> Parser E.Module Src.Import

401+chompAs name =

357402 do Keyword.as_ E.ImportAs

358403 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias

359404 alias <- Var.upper E.ImportAlias

@@ -361,21 +406,19 @@ chompAs name imports =

361406 Space.chomp E.ModuleSpace

362407 oneOf E.ImportEnd

363408 [ do Space.checkFreshLine E.ImportEnd

364− chompImports $

365− Src.Import name (Just alias) (Src.Explicit []) : imports

409+ return $ Src.Import name (Just alias) (Src.Explicit [])

366410 , do Space.checkIndent end E.ImportEnd

367− chompExposing name (Just alias) imports

411+ chompExposing name (Just alias)

368412 ]

369413

370414

371−chompExposing :: A.Located Name.Name -> Maybe Name.Name -> [Src.Import] -> Parser E.Module [Src.Import]

372−chompExposing name maybeAlias imports =

415+chompExposing :: A.Located Name.Name -> Maybe Name.Name -> Parser E.Module Src.Import

416+chompExposing name maybeAlias =

373417 do Keyword.exposing_ E.ImportExposing

374418 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList

375419 exposed <- specialize E.ImportExposingList exposing

376420 freshLine E.ImportEnd

377− chompImports $

378− Src.Import name maybeAlias exposed : imports

421+ return $ Src.Import name maybeAlias exposed

379422

380423

381424

@@ -391,18 +434,18 @@ exposing =

391434 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

392435 word1 0x29 {-)-} E.ExposingEnd

393436 return Src.Open

394− , do exposed <- addLocation chompExposed

437+ , do exposed <- chompExposed

395438 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

396439 exposingHelp [exposed]

397440 ]

398441

399442

400−exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing

443+exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing

401444exposingHelp revExposed =

402445 oneOf E.ExposingEnd

403446 [ do word1 0x2C {-,-} E.ExposingEnd

404447 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue

405− exposed <- addLocation chompExposed

448+ exposed <- chompExposed

406449 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

407450 exposingHelp (exposed:revExposed)

408451 , do word1 0x29 {-)-} E.ExposingEnd

@@ -412,16 +455,21 @@ exposingHelp revExposed =

412455

413456chompExposed :: Parser E.Exposing Src.Exposed

414457chompExposed =

415− oneOf E.ExposingValue

416− [ Src.Lower <$> Var.lower E.ExposingValue

417− , do word1 0x28 {-(-} E.ExposingValue

418− op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved

419− word1 0x29 {-)-} E.ExposingOperatorRightParen

420− return (Src.Operator op)

421− , do name <- Var.upper E.ExposingValue

422− Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

423− Src.Upper name <$> privacy

424− ]

458+ do start <- getPosition

459+ oneOf E.ExposingValue

460+ [ do name <- Var.lower E.ExposingValue

461+ end <- getPosition

462+ return $ Src.Lower $ A.at start end name

463+ , do word1 0x28 {-(-} E.ExposingValue

464+ op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved

465+ word1 0x29 {-)-} E.ExposingOperatorRightParen

466+ end <- getPosition

467+ return $ Src.Operator (A.Region start end) op

468+ , do name <- Var.upper E.ExposingValue

469+ end <- getPosition

470+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd

471+ Src.Upper (A.at start end name) <$> privacy

472+ ]

425473

426474

427475privacy :: Parser E.Exposing Src.Privacy

@@ -429,9 +477,11 @@ privacy =

429477 oneOfWithFallback

430478 [ do word1 0x28 {-(-} E.ExposingTypePrivacy

431479 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy

480+ start <- getPosition

432481 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy

482+ end <- getPosition

433483 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy

434484 word1 0x29 {-)-} E.ExposingTypePrivacy

435− return Src.Public

485+ return $ Src.Public (A.Region start end)

436486 ]

437487 Src.Private

compiler/src/Parse/Pattern.hs+1−1

@@ -129,7 +129,7 @@ recordHelp start vars =

129129 Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd

130130 recordHelp start (var:vars)

131131 , do word1 0x7D {-}-} E.PRecordEnd

132− addEnd start (Src.PRecord vars)

132+ addEnd start (Src.PRecord (reverse vars))

133133 ]

134134

135135

compiler/src/Parse/Primitives.hs+2−2

@@ -46,7 +46,7 @@ newtype Parser x a =

4646 )

4747

4848

49−data State = -- TODO try taking some out to avoid allocation?

49+data State = -- PERF try taking some out to avoid allocation

5050 State

5151 { _src :: ForeignPtr Word8

5252 , _pos :: !(Ptr Word8)

@@ -145,7 +145,7 @@ oneOfHelp state cok eok cerr eerr toError parsers =

145145

146146

147147{-# INLINE oneOfWithFallback #-}

148−oneOfWithFallback :: [Parser x a] -> a -> Parser x a -- TODO is this function okay? Worried about allocation/laziness with fallback values.

148+oneOfWithFallback :: [Parser x a] -> a -> Parser x a -- PERF is this function okay? Worried about allocation/laziness with fallback values.

149149oneOfWithFallback parsers fallback =

150150 Parser $ \state cok eok cerr _ ->

151151 oowfHelp state cok eok cerr parsers fallback

compiler/src/Parse/Repl.hsdeleted−117

@@ -1,117 +0,0 @@

1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−module Parse.Repl

4− ( Entry(..)

5− , parseEntry

6− )

7− where

8−

9−

10−import qualified Data.ByteString.UTF8 as BS_UTF8

11−import Data.Name (Name)

12−

13−import qualified AST.Source as Src

14−import qualified Parse.Primitives as P

15−import Parse.Utils

16−

17−

18−

19−-- ENTRY

20−

21−

22−data Entry

23− = Import Name (Maybe Name) Src.Exposing String

24− | Type Name String

25− | Def (Maybe Name) String

26− | Other String

27− | Annotation

28− | Port

29−

30−

31−

32−-- PARSE

33−

34−

35−parseEntry :: String -> Entry

36−parseEntry source =

37− case P.fromByteString parser (BS_UTF8.fromString source) of

38− P.Ok entry _ ->

39− entry

40−

41− P.Err _ _ _ _ ->

42− Other source

43−

44−

45−parser :: Parser Entry

46−parser =

47− error "TODO parse the REPL stuff"

48−

49−{-

50− oneOf

51− [

52− do Keyword.import_

53− spaces

54− name <- Var.moduleName

55− alias <- tryAlias

56− exposing <-

57− oneOf

58− [ do spaces

59− Keyword.exposing_

60− spaces

61− Module.exposing

62− , return (Src.Explicit [])

63− ]

64− return (Import name alias exposing source)

65− ,

66− do Keyword.port_

67− return Port

68− ,

69− do Keyword.type_

70− spaces

71− oneOf

72− [ do Keyword.alias_

73− spaces

74− , return ()

75− ]

76− name <- Var.upper

77− return (Type name source)

78− ,

79− do root <- Pattern.term

80− spaces

81− case A.toValue root of

82− Src.PVar name ->

83− oneOf

84− [ do word1 0x3A {-:-} E.XXX

85− return Annotation

86− , do chompArgs

87− return (Def (Just name) source)

88− ]

89−

90− _ ->

91− do word1 0x3D {-=-} E.XXX

92− return (Def Nothing source)

93− ]

94−

95−

96−chompArgs :: Parser ()

97−chompArgs =

98− oneOf

99− [ do Pattern.term

100− spaces

101− chompArgs

102− , do word1 0x3D {-=-} E.XXX

103− return ()

104− ]

105−

106−

107−tryAlias :: Parser (Maybe Name)

108−tryAlias =

109− oneOf

110− [ try $

111− do spaces

112− Keyword.as_

113− spaces

114− Just <$> Var.upper

115− , return Nothing

116− ]

117−-}

compiler/src/Parse/Space.hs+2−2

@@ -157,7 +157,7 @@ eatSpaces pos end row col =

157157-- LINE COMMENTS

158158

159159

160−eatLineComment :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)

160+eatLineComment :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)

161161eatLineComment pos end row col =

162162 if pos >= end then

163163 (# Good, pos, row, col #)

@@ -208,7 +208,7 @@ data MultiStatus

208208 | MultiEndless

209209

210210

211−eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Word16, Word16 #)

211+eatMultiCommentHelp :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> (# MultiStatus, Ptr Word8, Row, Col #)

212212eatMultiCommentHelp pos end row col openComments =

213213 if pos >= end then

214214 (# MultiEndless, pos, row, col #)

compiler/src/Parse/String.hs+2−2

@@ -165,7 +165,7 @@ addEscape chunk start end revChunks =

165165-- SINGLE STRINGS

166166

167167

168−singleString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [ES.Chunk] -> StringResult

168+singleString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> [ES.Chunk] -> StringResult

169169singleString pos end row col initialPos revChunks =

170170 if pos >= end then

171171 Err row col E.StringEndless_Single

@@ -211,7 +211,7 @@ singleString pos end row col initialPos revChunks =

211211-- MULTI STRINGS

212212

213213

214−multiString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> Word16 -> Word16 -> [ES.Chunk] -> StringResult

214+multiString :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Ptr Word8 -> Row -> Col -> [ES.Chunk] -> StringResult

215215multiString pos end row col initialPos sr sc revChunks =

216216 if pos >= end then

217217 Err sr sc E.StringEndless_Multi

compiler/src/Parse/Symbol.hs+1−1

@@ -40,7 +40,7 @@ operator toExpectation toError =

4040

4141 else

4242 case Name.fromPtr pos newPos of

43− "." -> cerr row col (toError BadDot)

43+ "." -> eerr row col (toError BadDot)

4444 "|" -> cerr row col (toError BadPipe)

4545 "->" -> cerr row col (toError BadArrow)

4646 "=" -> cerr row col (toError BadEquals)

compiler/src/Parse/Variable.hs+3−3

@@ -67,7 +67,7 @@ lower toError =

6767

6868

6969{-# NOINLINE reservedWords #-}

70−reservedWords :: Set.Set Name.Name -- TODO try using a trie instead

70+reservedWords :: Set.Set Name.Name -- PERF try using a trie instead

7171reservedWords =

7272 Set.fromList

7373 [ "if", "then", "else"

@@ -149,14 +149,14 @@ foreignUpper toError =

149149 let

150150 !newState = P.State src upperEnd end indent row newCol

151151 !name = Name.fromPtr upperStart upperEnd

152− !foreign =

152+ !upperName =

153153 if upperStart == pos then

154154 Unqualified name

155155 else

156156 let !home = Name.fromPtr pos (plusPtr upperStart (-1)) in

157157 Qualified home name

158158 in

159− cok foreign newState

159+ cok upperName newState

160160

161161

162162foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)

compiler/src/Reporting/Annotation.hs+1−1

@@ -26,7 +26,7 @@ import Data.Word (Word16)

2626

2727

2828data Located a =

29− At Region a -- TODO see if unpacking region is helpful

29+ At Region a -- PERF see if unpacking region is helpful

3030

3131

3232instance Functor Located where

compiler/src/Reporting/Doc.hs+18−24

@@ -56,6 +56,7 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P

5656import qualified Data.Index as Index

5757import qualified Elm.Package as Pkg

5858import qualified Elm.Version as V

59+import Json.Encode ((==>))

5960import qualified Json.Encode as E

6061import qualified Json.String as Json

6162

@@ -171,19 +172,19 @@ toFancyHint chunks =

171172-- LINKS

172173

173174

174−link :: P.Doc -> String -> String -> String -> P.Doc

175+link :: String -> String -> String -> String -> P.Doc

175176link word before fileName after =

176177 P.fillSep $

177− (P.underline word <> ":")

178+ (P.underline (P.text word) <> ":")

178179 : map P.text (words before)

179180 ++ P.text (makeLink fileName)

180181 : map P.text (words after)

181182

182183

183−fancyLink :: P.Doc -> [P.Doc] -> String -> [P.Doc] -> P.Doc

184+fancyLink :: String -> [P.Doc] -> String -> [P.Doc] -> P.Doc

184185fancyLink word before fileName after =

185186 P.fillSep $

186− (P.underline word <> ":") : before ++ P.text (makeLink fileName) : after

187+ (P.underline (P.text word) <> ":") : before ++ P.text (makeLink fileName) : after

187188

188189

189190makeLink :: [Char] -> [Char]

@@ -305,10 +306,8 @@ data Color

305306 | WHITE

306307

307308

308−toJsonHelp :: Style -> [a] -> P.SimpleDoc -> [E.Value]

309+toJsonHelp :: Style -> [String] -> P.SimpleDoc -> [E.Value]

309310toJsonHelp style revChunks simpleDoc =

310− error "TODO generate json on errors" style revChunks simpleDoc sgrToStyle encodeColor

311−{-

312311 case simpleDoc of

313312 P.SFail ->

314313 error $

@@ -319,23 +318,18 @@ toJsonHelp style revChunks simpleDoc =

319318 [ encodeChunks style revChunks ]

320319

321320 P.SChar char rest ->

322− toJsonHelp style (TB.singleton char : revChunks) rest

321+ toJsonHelp style ([char] : revChunks) rest

323322

324323 P.SText _ string rest ->

325− toJsonHelp style (TB.fromString string : revChunks) rest

324+ toJsonHelp style (string : revChunks) rest

326325

327326 P.SLine indent rest ->

328− toJsonHelp style (spaces indent : "\n" : revChunks) rest

327+ toJsonHelp style (replicate indent ' ' : "\n" : revChunks) rest

329328

330329 P.SSGR sgrs rest ->

331330 encodeChunks style revChunks : toJsonHelp (sgrToStyle sgrs style) [] rest

332331

333332

334−spaces :: Int -> TB.Builder

335−spaces n =

336− TB.fromText (Text.replicate n " ")

337−-}

338−

339333sgrToStyle :: [Ansi.SGR] -> Style -> Style

340334sgrToStyle sgrs style@(Style bold underline color) =

341335 case sgrs of

@@ -396,24 +390,24 @@ toColor layer intensity color =

396390 Ansi.White -> pick White WHITE

397391 Ansi.Black -> pick Black BLACK

398392

399−{-

400−encodeChunks :: Style -> [TB.Builder] -> E.Value

393+

394+encodeChunks :: Style -> [String] -> E.Value

401395encodeChunks (Style bold underline color) revChunks =

402396 let

403− !str = Utf8.concat (reverse revChunks)

397+ chars = concat (reverse revChunks)

404398 in

405399 case color of

406400 Nothing | not bold && not underline ->

407− E.string str

401+ E.chars chars

408402

409403 _ ->

410404 E.object

411− [ ("bold", E.bool bold)

412− , ("underline", E.bool underline)

413− , ("color", maybe E.null encodeColor color)

414− , ("string", E.string str)

405+ [ "bold" ==> E.bool bold

406+ , "underline" ==> E.bool underline

407+ , "color" ==> maybe E.null encodeColor color

408+ , "string" ==> E.chars chars

415409 ]

416−-}

410+

417411

418412encodeColor :: Color -> E.Value

419413encodeColor color =

compiler/src/Reporting/Error.hs+32−26

@@ -10,10 +10,9 @@ module Reporting.Error

1010

1111

1212import qualified Data.ByteString as B

13−import qualified Data.Name as Name

1413import qualified Data.NonEmptyList as NE

1514import qualified Data.OneOrMore as OneOrMore

16−import qualified Data.Utf8 as Utf8

15+import qualified System.FilePath as FP

1716

1817import qualified Elm.ModuleName as ModuleName

1918import qualified File

@@ -22,6 +21,7 @@ import Json.Encode ((==>))

2221import qualified Reporting.Annotation as A

2322import qualified Reporting.Doc as D

2423import qualified Reporting.Error.Canonicalize as Canonicalize

24+import qualified Reporting.Error.Docs as Docs

2525import qualified Reporting.Error.Import as Import

2626import qualified Reporting.Error.Main as Main

2727import qualified Reporting.Error.Pattern as Pattern

@@ -39,8 +39,8 @@ import qualified Reporting.Report as Report

3939data Module =

4040 Module

4141 { _name :: ModuleName.Raw

42− , _path :: FilePath

43− , _time :: File.Time

42+ , _absolutePath :: FilePath

43+ , _modificationTime :: File.Time

4444 , _source :: B.ByteString

4545 , _error :: Error

4646 }

@@ -57,6 +57,7 @@ data Error

5757 | BadTypes L.Localizer (NE.List Type.Error)

5858 | BadMains L.Localizer (OneOrMore.OneOrMore Main.Error)

5959 | BadPatterns (NE.List Pattern.Error)

60+ | BadDocs Docs.Error

6061

6162

6263

@@ -84,32 +85,34 @@ toReports source err =

8485 BadPatterns errs ->

8586 fmap (Pattern.toReport source) errs

8687

88+ BadDocs docsErr ->

89+ Docs.toReports source docsErr

90+

8791

8892

8993-- TO DOC

9094

9195

92−toDoc :: Module -> [Module] -> D.Doc

93−toDoc err errs =

96+toDoc :: FilePath -> Module -> [Module] -> D.Doc

97+toDoc root err errs =

9498 let

95− timeCompare m1 m2 = compare (_time m1) (_time m2)

96− (NE.List m ms) = NE.sortBy timeCompare (NE.List err errs)

99+ (NE.List m ms) = NE.sortBy _modificationTime (NE.List err errs)

97100 in

98− D.vcat (toDocHelp m ms)

101+ D.vcat (toDocHelp root m ms)

99102

100103

101−toDocHelp :: Module -> [Module] -> [D.Doc]

102−toDocHelp module1 modules =

104+toDocHelp :: FilePath -> Module -> [Module] -> [D.Doc]

105+toDocHelp root module1 modules =

103106 case modules of

104107 [] ->

105− [moduleToDoc module1

108+ [moduleToDoc root module1

106109 ,""

107110 ]

108111

109112 module2 : otherModules ->

110− moduleToDoc module1

113+ moduleToDoc root module1

111114 : toSeparator module1 module2

112− : toDocHelp module2 otherModules

115+ : toDocHelp root module2 otherModules

113116

114117

115118toSeparator :: Module -> Module -> D.Doc

@@ -131,19 +134,22 @@ toSeparator beforeModule afterModule =

131134-- MODULE TO DOC

132135

133136

134−moduleToDoc :: Module -> D.Doc

135−moduleToDoc (Module _ path _ source err) =

137+moduleToDoc :: FilePath -> Module -> D.Doc

138+moduleToDoc root (Module _ absolutePath _ source err) =

136139 let

137140 reports =

138141 toReports (Code.toSource source) err

142+

143+ relativePath =

144+ FP.makeRelative root absolutePath

139145 in

140− D.vcat $ map (reportToDoc path) (NE.toList reports)

146+ D.vcat $ map (reportToDoc relativePath) (NE.toList reports)

141147

142148

143149reportToDoc :: FilePath -> Report.Report -> D.Doc

144−reportToDoc path (Report.Report title _ _ message) =

150+reportToDoc relativePath (Report.Report title _ _ message) =

145151 D.vcat

146− [ toMessageBar title path

152+ [ toMessageBar title relativePath

147153 , ""

148154 , message

149155 , ""

@@ -173,8 +179,8 @@ toJson (Module name path _ source err) =

173179 toReports (Code.toSource source) err

174180 in

175181 E.object

176− [ "path" ==> E.string (Utf8.fromChars path)

177− , "name" ==> E.string (Name.toUtf8 name)

182+ [ "path" ==> E.chars path

183+ , "name" ==> E.name name

178184 , "problems" ==> E.array (map reportToJson (NE.toList reports))

179185 ]

180186

@@ -182,7 +188,7 @@ toJson (Module name path _ source err) =

182188reportToJson :: Report.Report -> E.Value

183189reportToJson (Report.Report title region _sgstns message) =

184190 E.object

185− [ "title" ==> E.string (Utf8.fromChars title)

191+ [ "title" ==> E.chars title

186192 , "region" ==> encodeRegion region

187193 , "message" ==> D.encode message

188194 ]

@@ -193,12 +199,12 @@ encodeRegion (A.Region (A.Position sr sc) (A.Position er ec)) =

193199 E.object

194200 [ "start" ==>

195201 E.object

196− [ ("line", E.int (fromIntegral sr))

197− , ("column", E.int (fromIntegral sc))

202+ [ "line" ==> E.int (fromIntegral sr)

203+ , "column" ==> E.int (fromIntegral sc)

198204 ]

199205 , "end" ==>

200206 E.object

201− [ ("line", E.int (fromIntegral er))

202− , ("column", E.int (fromIntegral ec))

207+ [ "line" ==> E.int (fromIntegral er)

208+ , "column" ==> E.int (fromIntegral ec)

203209 ]

204210 ]

compiler/src/Reporting/Error/Canonicalize.hs+41−40

@@ -14,8 +14,10 @@ module Reporting.Error.Canonicalize

1414

1515

1616import qualified Data.Char as Char

17+import qualified Data.List as List

1718import qualified Data.Map as Map

1819import qualified Data.Name as Name

20+import qualified Data.OneOrMore as OneOrMore

1921import qualified Data.Set as Set

2022

2123import qualified AST.Canonical as Can

@@ -37,10 +39,10 @@ import qualified Reporting.Suggest as Suggest

3739

3840data Error

3941 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int

40− | AmbiguousVar A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]

41− | AmbiguousType A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]

42− | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]

43− | AmbiguousBinop A.Region Name.Name [ModuleName.Canonical]

42+ | AmbiguousVar A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

43+ | AmbiguousType A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

44+ | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

45+ | AmbiguousBinop A.Region Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)

4446 | BadArity A.Region BadArityContext Name.Name Int Int

4547 | Binop A.Region Name.Name Name.Name

4648 | DuplicateDecl Name.Name A.Region A.Region

@@ -164,17 +166,17 @@ toReport source err =

164166 <> " be deleted? Maybe some parentheses are missing?"

165167 )

166168

167− AmbiguousVar region maybePrefix name possibleHomes ->

168− ambiguousName source region maybePrefix name possibleHomes "variable"

169+ AmbiguousVar region maybePrefix name h hs ->

170+ ambiguousName source region maybePrefix name h hs "variable"

169171

170− AmbiguousType region maybePrefix name possibleHomes ->

171− ambiguousName source region maybePrefix name possibleHomes "type"

172+ AmbiguousType region maybePrefix name h hs ->

173+ ambiguousName source region maybePrefix name h hs "type"

172174

173− AmbiguousVariant region maybePrefix name possibleHomes ->

174− ambiguousName source region maybePrefix name possibleHomes "variant"

175+ AmbiguousVariant region maybePrefix name h hs ->

176+ ambiguousName source region maybePrefix name h hs "variant"

175177

176− AmbiguousBinop region name possibleHomes ->

177− ambiguousName source region Nothing name possibleHomes "operator"

178+ AmbiguousBinop region name h hs ->

179+ ambiguousName source region Nothing name h hs "operator"

178180

179181 BadArity region badArityContext name expected actual ->

180182 let

@@ -242,11 +244,11 @@ toReport source err =

242244

243245 DuplicateAliasArg typeName name r1 r2 ->

244246 nameClash source r1 r2 $

245− "The `" <> Name.toChars typeName <> "` type alias has multilpe `" <> Name.toChars name <> "` type variables."

247+ "The `" <> Name.toChars typeName <> "` type alias has multiple `" <> Name.toChars name <> "` type variables."

246248

247249 DuplicateUnionArg typeName name r1 r2 ->

248250 nameClash source r1 r2 $

249− "The `" <> Name.toChars typeName <> "` type has multilpe `" <> Name.toChars name <> "` type variables."

251+ "The `" <> Name.toChars typeName <> "` type has multiple `" <> Name.toChars name <> "` type variables."

250252

251253 DuplicatePattern context name r1 r2 ->

252254 nameClash source r1 r2 $

@@ -274,7 +276,7 @@ toReport source err =

274276 "You have declared that `" ++ Name.toChars name ++ "` is an effect type:"

275277 ,

276278 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!"

278280 )

279281

280282 EffectFunctionNotFound region name ->

@@ -342,7 +344,7 @@ toReport source err =

342344 Code.toSnippet source region Nothing

343345 (

344346 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 `"

346348 ++ Name.toChars name ++ "` though."

347349 ,

348350 D.reflow $

@@ -355,12 +357,12 @@ toReport source err =

355357 (

356358 D.reflow $

357359 "You are trying to import the `" <> Name.toChars ctor

358− <> "` type constructor by name:"

360+ <> "` variant by name:"

359361 ,

360362 D.fillSep

361363 ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."

362364 ,"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"

364366 , D.fromName ctor <> "."

365367 ]

366368 )

@@ -386,13 +388,8 @@ toReport source err =

386388 D.reflow $

387389 "The `" <> Name.toChars name <> "` type alias cannot be followed by (..) like this:"

388390 ,

389− D.stack

390− [ "Remove the (..) and it should work."

391− , D.link "Hint"

392− "The distinction between `type` and `type alias` is important here. Read"

393− "types-vs-type-aliases"

394− "to learn more."

395− ]

391+ D.reflow $

392+ "Remove the (..) and it should work."

396393 )

397394

398395 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->

@@ -522,7 +519,7 @@ toReport source err =

522519 <> "` as a function, but it is not available in pattern matching like this:"

523520 ,

524521 D.reflow $

525− "I recommend matching matching the record as a variable and unpacking it later."

522+ "I recommend matching the record as a variable and unpacking it later."

526523 )

527524

528525 PortPayloadInvalid region portName _badType invalidPayload ->

@@ -682,7 +679,7 @@ toReport source err =

682679 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."

683680 ,

684681 D.stack

685− [ makeTheory "Are you are trying to mutate a variable?" $

682+ [ makeTheory "Are you trying to mutate a variable?" $

686683 "Elm does not have mutation, so when I see " ++ Name.toChars name

687684 ++ " defined in terms of " ++ Name.toChars name

688685 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"

@@ -728,7 +725,7 @@ toReport source err =

728725 "The `" <> Name.toChars name <> "` value is defined directly in terms of itself, causing an infinite loop."

729726 ,

730727 D.stack

731− [ makeTheory "Are you are trying to mutate a variable?" $

728+ [ makeTheory "Are you trying to mutate a variable?" $

732729 "Elm does not have mutation, so when I see " ++ Name.toChars name

733730 ++ " defined in terms of " ++ Name.toChars name

734731 ++ ", I treat it as a recursive definition. Try giving the new value a new name!"

@@ -979,28 +976,32 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =

979976-- AMBIGUOUS NAME

980977

981978

982−ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> [ModuleName.Canonical] -> String -> Report.Report

983−ambiguousName source region maybePrefix name possibleHomes thing =

979+ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> ModuleName.Canonical -> OneOrMore.OneOrMore ModuleName.Canonical -> String -> Report.Report

980+ambiguousName source region maybePrefix name h hs thing =

981+ let

982+ possibleHomes = List.sort (h : OneOrMore.destruct (:) hs)

983+ in

984984 Report.Report "AMBIGUOUS NAME" region [] $

985985 Code.toSnippet source region Nothing $

986986 case maybePrefix of

987987 Nothing ->

988988 let

989989 homeToYellowDoc (ModuleName.Canonical _ home) =

990− D.dullyellow (D.fromName home)

991−

992− bothOrAll =

993− if length possibleHomes == 2 then "both" else "all"

990+ D.dullyellow (D.fromName home <> "." <> D.fromName name)

994991 in

995992 (

996− D.reflow $ "This usage of `" ++ Name.toChars name ++ "` is ambiguous."

993+ D.reflow $ "This usage of `" ++ Name.toChars name ++ "` is ambiguous:"

997994 ,

998995 D.stack

999996 [ D.reflow $

1000− "Check your imports. The following modules " ++ bothOrAll

1001− ++ " expose a `" ++ Name.toChars name ++ "` " ++ thing ++ ":"

997+ "This name is exposed by " ++ show (length possibleHomes) ++ " of your imports, so I am not\

998+ \ sure which one to use:"

1002999 , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes

1003− , D.reflowLink "Read" "imports" "to learn how to clarify which one you want."

1000+ , D.reflow $

1001+ "I recommend using qualified names for imported values. I also recommend having\

1002+ \ at most one `exposing (..)` per file to make name clashes like this less common\

1003+ \ in the long run."

1004+ , D.link "Note" "Check out" "imports" "for more info on the import syntax."

10041005 ]

10051006 )

10061007

@@ -1008,9 +1009,9 @@ ambiguousName source region maybePrefix name possibleHomes thing =

10081009 let

10091010 homeToYellowDoc (ModuleName.Canonical _ home) =

10101011 if prefix == home then

1011− D.blue "import" <+> D.dullyellow (D.fromName home)

1012+ D.cyan "import" <+> D.fromName home

10121013 else

1013− D.blue "import" <+> D.dullyellow (D.fromName home) <+> D.blue "as" <+> D.dullyellow (D.fromName prefix)

1014+ D.cyan "import" <+> D.fromName home <+> D.cyan "as" <+> D.fromName prefix

10141015

10151016 eitherOrAny =

10161017 if length possibleHomes == 2 then "either" else "any"

compiler/src/Reporting/Error/Docs.hs+69−4

@@ -35,7 +35,7 @@ data Error

3535data SyntaxProblem

3636 = Op Row Col

3737 | OpBad BadOperator Row Col

38− | Export Row Col

38+ | Name Row Col

3939 | Space E.Space Row Col

4040 | Comma Row Col

4141 | BadEnd Row Col

@@ -69,7 +69,7 @@ toReports source err =

6969 \ declaration and the imports."

7070 ,

7171 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>"

7373 )

7474

7575 ImplicitExposing region ->

@@ -88,8 +88,9 @@ toReports source err =

8888 \ it will be easy to understand as people read the documentation!"

8989 )

9090

91− SyntaxProblem _ ->

92− error "TODO SyntaxProblem in docs"

91+ SyntaxProblem problem ->

92+ NE.singleton $

93+ toSyntaxProblemReport source problem

9394

9495 NameProblems problems ->

9596 fmap (toNameProblemReport source) problems

@@ -98,6 +99,66 @@ toReports source err =

9899 fmap (toDefProblemReport source) problems

99100

100101

102+

103+-- SYNTAX PROBLEM

104+

105+

106+toSyntaxProblemReport :: Code.Source -> SyntaxProblem -> Report.Report

107+toSyntaxProblemReport source problem =

108+ let

109+ toSyntaxReport row col details =

110+ let

111+ region = toRegion row col

112+ in

113+ Report.Report "PROBLEM IN DOCS" region [] $

114+ Code.toSnippet source region Nothing

115+ ( D.reflow "I was partway through parsing your module documentation, but I got stuck here:"

116+ , D.stack $

117+ [ D.reflow details

118+ , D.toSimpleHint $

119+ "Read through <https://package.elm-lang.org/help/documentation-format> for\

120+ \ tips on how to write module documentation!"

121+ ]

122+ )

123+ in

124+ case problem of

125+ Op row col ->

126+ toSyntaxReport row col $

127+ "I am trying to parse an operator like (+) or (*) but something is going wrong."

128+

129+ OpBad _ row col ->

130+ toSyntaxReport row col $

131+ "I am trying to parse an operator like (+) or (*) but it looks like you are using\

132+ \ a reserved symbol in this case."

133+

134+ Name row col ->

135+ toSyntaxReport row col $

136+ "I was expecting to see the name of another exposed value from this module."

137+

138+ Space space row col ->

139+ E.toSpaceReport source space row col

140+

141+ Comma row col ->

142+ toSyntaxReport row col $

143+ "I was expecting to see a comma next."

144+

145+ BadEnd row col ->

146+ toSyntaxReport row col $

147+ "I am not really sure what I am getting stuck on though."

148+

149+

150+toRegion :: Row -> Col -> A.Region

151+toRegion row col =

152+ let

153+ pos = A.Position row col

154+ in

155+ A.Region pos pos

156+

157+

158+

159+-- NAME PROBLEM

160+

161+

101162toNameProblemReport :: Code.Source -> NameProblem -> Report.Report

102163toNameProblemReport source problem =

103164 case problem of

@@ -151,6 +212,10 @@ toNameProblemReport source problem =

151212 )

152213

153214

215+

216+-- DEF PROBLEM

217+

218+

154219toDefProblemReport :: Code.Source -> DefProblem -> Report.Report

155220toDefProblemReport source problem =

156221 case problem of

compiler/src/Reporting/Error/Import.hs+1−1

@@ -56,7 +56,7 @@ toReport source (Error region name unimportedModules problem) =

5656 D.stack

5757 [

5858 D.reflow $

59− "I checked the \"dependencies\" and \"source-directories\" listend in your elm.json,\

59+ "I checked the \"dependencies\" and \"source-directories\" listed in your elm.json,\

6060 \ but I cannot find it! Maybe it is a typo for one of these names?"

6161 ,

6262 D.dullyellow $ D.indent 4 $ D.vcat $

compiler/src/Reporting/Error/Json.hs+281−269

@@ -1,332 +1,344 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

33module Reporting.Error.Json

4− ( Error(..)

5− , Problem(..)

6− , DecodeExpectation(..)

7− , ParseError(..)

8− , toReport

4+ ( toReport

5+ , FailureToReport(..)

6+ , Context(..)

7+ , Reason(..)

98 )

109 where

1110

1211

13−import qualified Data.Utf8 as Utf8

14−import Data.Word (Word16)

12+import qualified Data.ByteString as BS

13+import qualified Data.ByteString.UTF8 as BS_UTF8

14+import qualified Data.NonEmptyList as NE

1515

16−import qualified Reporting.Report as Report

17−

18−

19−

20−-- ERROR

21−

22−

23−data Error e

24− = DecodeProblem (Problem e)

25− | ParseProblem ParseError

26−

27−

28−

29−-- DECODE PROBLEMS

30−

31−

32−data Problem e

33− = Field Utf8.String (Problem e)

34− | Index Int (Problem e)

35− | OneOf (Problem e) [Problem e]

36− | Failure e

37− | Expecting DecodeExpectation

38−

39−

40−data DecodeExpectation

41− = TObject

42− | TArray

43− | TString

44− | TBool

45− | TInt

46− | TObjectWith Utf8.String

47− | TArrayPair Int

48−

49−

50−

51−-- PARSE ERROR

52−

53−

54−data ParseError

55− = PIndex Int ParseError Row Col

56− | PField Utf8.String ParseError Row Col

57− | ObjectStart Row Col

58− | ObjectMore Row Col

59− | ObjectEnd Row Col

60− | ArrayStart Row Col

61− | ArrayMore Row Col

62− | ArrayEnd Row Col

63− | StringStart Row Col

64− | StringEnd Row Col

65− | IntStart Row Col

66− | NoLeadingZeros Row Col

67− | NoFloats Row Col

68− | Bool Row Col

69− | Null Row Col

70− | Value Row Col

71− | Colon Row Col

72− | EndOfFile Row Col

73−

74−

75−type Row = Word16

76−type Col = Word16

16+import Json.Decode (Error(..), Problem(..), DecodeExpectation(..), ParseError(..), StringProblem(..))

17+import qualified Reporting.Annotation as A

18+import qualified Reporting.Doc as D

19+import qualified Reporting.Exit.Help as Help

20+import qualified Reporting.Render.Code as Code

7721

7822

7923

8024-- TO REPORT

8125

8226

83−toReport :: Error e -> Report.Report

84−toReport err =

85− error "TODO Reporting.Error.Json.toReport" err

86−

87−

88−{-

89−

90−-- ERROR

27+toReport :: FilePath -> FailureToReport x -> Error x -> Reason -> Help.Report

28+toReport path ftr err reason =

29+ case err of

30+ DecodeProblem bytes problem ->

31+ problemToReport path ftr (Code.toSource bytes) CRoot problem reason

9132

33+ ParseProblem bytes parseError ->

34+ parseErrorToReport path (Code.toSource bytes) parseError reason

9235

93−data Error e

94− = BadJson Syntax.Error

95− | BadContent (Json.Error e)

9636

37+newtype Reason =

38+ ExplicitReason String

9739

9840

99−-- TO DOC

41+because :: Reason -> String -> String

42+because (ExplicitReason iNeedThings) problem =

43+ iNeedThings ++ " " ++ problem

10044

10145

102−toDoc :: String -> Code.Source -> (e -> [D.Doc]) -> Error e -> D.Doc

103−toDoc rootName source userErrorToDocs err =

104− case err of

105− BadJson syntaxError ->

106− case Syntax.toReport source syntaxError of

107− Report.Report _ _ _ doc ->

108− doc

109−

110− BadContent jsonError ->

111− case flatten jsonError of

112− [] ->

113− D.reflow

114− "I am not sure what is wrong with this JSON. Please create an <http://sscce.org>\

115− \ and share it at <https://github.com/elm/compiler/issues> so I can\

116− \ provide a helpful hint here!"

117−

118− [flatError] ->

119− flatErrorToDoc rootName [] userErrorToDocs flatError

120−

121− flatErrors ->

122− let

123− toNumberedDoc index flatErr =

124− D.dullcyan ("(" <> D.fromInt index <> ")") <+> flatErrorToDoc rootName [] userErrorToDocs flatErr

125− in

126− D.stack $

127− [ D.reflow $

128− "I have " ++ show (length flatErrors) ++ " theories on what is going wrong:"

129− ]

130− ++ zipWith toNumberedDoc [1..] flatErrors

13146

47+-- PARSE ERROR TO REPORT

13248

13349

134−-- FLAT ERROR TO DOC

135−

136−

137−flatErrorToDoc :: String -> [D.Doc] -> (e -> [D.Doc]) -> FlatError e -> D.Doc

138−flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory theories) =

139− case theories of

140− [] ->

50+parseErrorToReport :: FilePath -> Code.Source -> ParseError -> Reason -> Help.Report

51+parseErrorToReport path source parseError reason =

52+ let

53+ toSnippet title row col (problem, details) =

14154 let

142− explanation =

143− case theory of

144− Failure userError ->

145− userErrorToDocs userError

146−

147− Expecting tipe ->

148− ["I","was","expecting"] ++ anExpectedThing tipe

55+ pos = A.Position row col

56+ surroundings = A.Region (A.Position (max 1 (row - 2)) 1) pos

57+ region = A.Region pos pos

14958 in

150− case accesses of

151− [] ->

152− D.fillSep (starter ++ explanation)

153−

154− _ ->

59+ Help.jsonReport title (Just path) $

60+ Code.toSnippet source surroundings (Just region)

61+ ( D.reflow (because reason problem)

62+ , details

63+ )

64+ in

65+ case parseError of

66+ Start row col ->

67+ toSnippet "EXPECTING A VALUE" row col

68+ (

69+ "I was expecting to see a JSON value next:"

70+ ,

15571 D.stack

156− [ D.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."]

157− , D.fillSep explanation

72+ [ D.fillSep

73+ ["Try","something","like",D.dullyellow "\"this\"","or"

74+ ,D.dullyellow "42","to","move","on","to","better","hints!"

75+ ]

76+ , D.toSimpleNote $

77+ "The JSON specification does not allow trailing commas, so you can sometimes\

78+ \ get this error in arrays that have an extra comma at the end. In that case,\

79+ \ remove that last comma or add another array entry after it!"

15880 ]

81+ )

15982

160− _:_ ->

161− let

162− introduction =

163− case accesses of

164− [] ->

165− ["I","am","having","trouble","with","the"]

166− ++ actualThing json

167− ++ ["here","because:"]

168−

169− _ ->

170− ["I","am","having","trouble","with","the"]

171− ++ actualThing json

172− ++ ["at",accessToDoc rootName accesses,"because:"]

173− in

174− D.stack

175− [ D.fillSep (starter ++ introduction)

176− , D.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories)

177− , D.reflow "I accept any of these things."

178− ]

83+ ObjectField row col ->

84+ toSnippet "EXTRA COMMA" row col

85+ (

86+ "I was partway through parsing a JSON object when I got stuck here:"

87+ ,

88+ D.stack

89+ [ D.fillSep

90+ ["I","saw","a","comma","right","before","I","got","stuck","here,"

91+ ,"so","I","was","expecting","to","see","a","field","name","like"

92+ ,D.dullyellow "\"type\"","or",D.dullyellow "\"dependencies\"","next."

93+ ]

94+ , D.reflow $

95+ "This error is commonly caused by trailing commas in JSON objects. Those are\

96+ \ actually disallowed by <https://json.org> so check the previous line for a\

97+ \ trailing comma that may need to be deleted."

98+ , objectNote

99+ ]

100+ )

179101

102+ ObjectColon row col ->

103+ toSnippet "EXPECTING COLON" row col

104+ (

105+ "I was partway through parsing a JSON object when I got stuck here:"

106+ ,

107+ D.stack

108+ [ D.reflow $ "I was expecting to see a colon next."

109+ , objectNote

110+ ]

111+ )

180112

181−accessToDoc :: String -> [String] -> D.Doc

182−accessToDoc rootName accesses =

183− D.dullyellow (D.fromString (rootName ++ concat accesses))

113+ ObjectEnd row col ->

114+ toSnippet "UNFINISHED OBJECT" row col

115+ (

116+ "I was partway through parsing a JSON object when I got stuck here:"

117+ ,

118+ D.stack

119+ [ D.reflow $

120+ "I was expecting to see a comma or a closing curly brace next."

121+ , D.reflow $

122+ "Is a comma missing on the previous line? Is an array missing a closing square\

123+ \ bracket? It is often something tricky like that!"

124+ , objectNote

125+ ]

126+ )

184127

128+ ArrayEnd row col ->

129+ toSnippet "UNFINISHED ARRAY" row col

130+ (

131+ "I was partway through parsing a JSON array when I got stuck here:"

132+ ,

133+ D.stack

134+ [ D.reflow $ "I was expecting to see a comma or a closing square bracket next."

135+ , D.reflow $

136+ "Is a comma missing on the previous line? It is often something like that!"

137+ ]

138+ )

139+

140+ StringProblem stringProblem row col ->

141+ case stringProblem of

142+ BadStringEnd ->

143+ toSnippet "ENDLESS STRING" row col

144+ (

145+ "I got to the end of the line without seeing the closing double quote:"

146+ ,

147+ D.fillSep $

148+ ["Strings","look","like",D.green "\"this\"","with","double"

149+ ,"quotes","on","each","end.","Is","the","closing","double"

150+ ,"quote","missing","in","your","code?"

151+ ]

152+ )

153+

154+ BadStringControlChar ->

155+ toSnippet "UNEXPECTED CONTROL CHARACTER" row col

156+ (

157+ "I ran into a control character unexpectedly:"

158+ ,

159+ D.reflow $

160+ "These are characters that represent tabs, backspaces, newlines, and\

161+ \ a bunch of other invisible characters. They all come before 20 in the\

162+ \ ASCII range, and they are disallowed by the JSON specificaiton. Maybe\

163+ \ a copy/paste added one of these invisible characters to your JSON?"

164+ )

165+

166+ BadStringEscapeChar ->

167+ toSnippet "UNKNOWN ESCAPE" row col

168+ (

169+ "Backslashes always start escaped characters, but I do not recognize this one:"

170+ ,

171+ D.stack

172+ [ D.reflow $

173+ "Valid escape characters include:"

174+ , D.dullyellow $ D.indent 4 $ D.vcat $

175+ ["\\\"","\\\\","\\/","\\b","\\f","\\n","\\r","\\t","\\u003D"]

176+ , D.reflow $

177+ "Do you want one of those instead? Maybe you need \\\\ to escape a backslash?"

178+ ]

179+ )

180+

181+ BadStringEscapeHex ->

182+ toSnippet "BAD HEX ESCAPE" row col

183+ (

184+ "This is not a valid hex escape:"

185+ ,

186+ D.fillSep $

187+ ["Valid","hex","escapes","in","JSON","are","between"

188+ ,D.green "\\u0000","and",D.green "\\uFFFF"

189+ ,"and","always","have","exactly","four","digits."

190+ ]

191+ )

192+

193+ NoLeadingZeros row col ->

194+ toSnippet "BAD NUMBER" row col

195+ (

196+ "Numbers cannot start with zeros like this:"

197+ ,

198+ D.reflow $ "Try deleting the leading zeros?"

199+ )

200+

201+ NoFloats row col ->

202+ toSnippet "UNEXPECTED NUMBER" row col

203+ (

204+ "I got stuck while trying to parse this number:"

205+ ,

206+ D.reflow $

207+ "I do not accept floating point numbers like 3.1415 right now. That kind\

208+ \ of JSON value is not needed for any of the uses that Elm has for now."

209+ )

210+

211+ BadEnd row col ->

212+ toSnippet "JSON PROBLEM" row col

213+ (

214+ "I was partway through parsing some JSON when I got stuck here:"

215+ ,

216+ D.reflow $

217+ "I am not really sure what is wrong. This sometimes means there is extra\

218+ \ stuff after a valid JSON value?"

219+ )

220+

221+

222+objectNote :: D.Doc

223+objectNote =

224+ D.stack

225+ [ D.toSimpleNote $ "Here is an example of a valid JSON object for reference:"

226+ , D.vcat

227+ [ D.indent 4 $ "{"

228+ , D.indent 6 $ D.dullyellow "\"name\"" <> ": " <> D.dullyellow "\"Tom\"" <> ","

229+ , D.indent 6 $ D.dullyellow "\"age\"" <> ": " <> D.dullyellow "42"

230+ , D.indent 4 $ "}"

231+ ]

232+ , D.reflow $

233+ "Notice that (1) the field names are in double quotes and (2) there is no\

234+ \ trailing comma after the last entry. Both are strict requirements in JSON!"

235+ ]

185236

186−actualThing :: E.Value -> [D.Doc]

187−actualThing json =

188− case json of

189− E.Array _ -> [D.red "array"]

190− E.Object _ -> [D.red "object"]

191− E.String _ -> [D.red "string"]

192− E.Boolean b -> [D.red (if b then "true" else "false"),"value"]

193− E.Integer n -> ["number",D.red (D.fromInt n)]

194− E.Number _ -> [D.red "number"]

195− E.Null -> [D.red "null","value"]

196237

197238

198−anExpectedThing :: Json.Type -> [D.Doc]

199−anExpectedThing tipe =

200− case tipe of

201− Json.TObject -> ["an", D.green "OBJECT" <> "."]

202− Json.TArray -> ["an", D.green "ARRAY" <> "."]

203− Json.TString -> ["a", D.green "STRING" <> "."]

204− Json.TBool -> ["a", D.green "BOOLEAN" <> "."]

205− Json.TInt -> ["an", D.green "INT" <> "."]

206− Json.TObjectWith field -> ["an",D.green "OBJECT","with","a",D.green ("\"" <> D.fromString (Text.unpack field) <> "\""),"field."]

207− Json.TArrayPair len ->

208− ["an",D.green "ARRAY","with",D.green "TWO","entries."

209− ,"This","array","has",D.fromInt len, if len == 1 then "element." else "elements."

210− ]

239+-- PROBLEM TO REPORT

211240

212241

213−toBullet :: [D.Doc] -> (e -> [D.Doc]) -> Theory e -> D.Doc

214−toBullet intro userErrorToDocs theory =

215− D.indent 4 $ D.fillSep $ (++) intro $

216− case theory of

217− Failure userError ->

218− userErrorToDocs userError

242+data Context

243+ = CRoot

244+ | CField BS.ByteString Context

245+ | CIndex Int Context

219246

220− Expecting tipe ->

221− ["I","was","expecting"] ++ anExpectedThing tipe

222247

248+problemToReport :: FilePath -> FailureToReport x -> Code.Source -> Context -> Problem x -> Reason -> Help.Report

249+problemToReport path ftr source context problem reason =

250+ case problem of

251+ Field field prob ->

252+ problemToReport path ftr source (CField field context) prob reason

223253

254+ Index index prob ->

255+ problemToReport path ftr source (CIndex index context) prob reason

224256

225−-- TO FLAT ERRORS

257+ OneOf p ps ->

258+ -- NOTE: only displays the deepest problem. This works well for the kind

259+ -- of JSON used by Elm, but probably would not work well in general.

260+ let

261+ (NE.List prob _) = NE.sortBy (negate . getMaxDepth) (NE.List p ps)

262+ in

263+ problemToReport path ftr source context prob reason

226264

265+ Failure region x ->

266+ _failureToReport ftr path source context region x

227267

228−data FlatError e =

229− FlatError [String] E.Value (Theory e) [Theory e]

268+ Expecting region expectation ->

269+ expectationToReport path source context region expectation reason

230270

231271

232−data Theory e

233− = Failure e

234− | Expecting Json.Type

272+getMaxDepth :: Problem x -> Int

273+getMaxDepth problem =

274+ case problem of

275+ Field _ prob -> 1 + getMaxDepth prob

276+ Index _ prob -> 1 + getMaxDepth prob

277+ OneOf p ps -> maximum (getMaxDepth p : map getMaxDepth ps)

278+ Failure _ _ -> 0

279+ Expecting _ _ -> 0

235280

236281

237−flatten :: Json.Error e -> [FlatError e]

238−flatten jsonError =

239− let

240− depth (FlatError accesses _ _ _) =

241− length accesses

242− in

243− List.sortOn depth $ flattenTree (toErrorTree jsonError)

282+newtype FailureToReport x =

283+ FailureToReport { _failureToReport :: FilePath -> Code.Source -> Context -> A.Region -> x -> Help.Report }

244284

245285

246−flattenTree :: ErrorTree e -> [FlatError e]

247−flattenTree (ErrorTree theories subTrees) =

286+expectationToReport :: FilePath -> Code.Source -> Context -> A.Region -> DecodeExpectation -> Reason -> Help.Report

287+expectationToReport path source context (A.Region start end) expectation reason =

248288 let

249− addAccess access (FlatError accesses json t ts) =

250− FlatError (access:accesses) json t ts

289+ (A.Position sr _) = start

290+ (A.Position er _) = end

251291

252− toFlats (name, tree) =

253− map (addAccess name) (flattenTree tree)

254−

255− subErrors =

256− concatMap toFlats (Map.toList subTrees)

257− in

258− case theories of

259− [] ->

260− subErrors

292+ region =

293+ if sr == er then region else A.Region start start

261294

262− (json, theory) : rest ->

263− FlatError [] json theory (map snd rest) : subErrors

295+ introduction =

296+ case context of

297+ CRoot ->

298+ "I ran into some trouble here:"

264299

300+ CField field _ ->

301+ "I ran into trouble with the value of the \"" ++ BS_UTF8.toString field ++ "\" field:"

265302

303+ CIndex index (CField field _) ->

304+ "When looking at the \"" ++ BS_UTF8.toString field ++ "\" field, I ran into trouble with the "

305+ ++ D.intToOrdinal index ++ " entry:"

266306

267−-- TO ERROR TREE

307+ CIndex index _ ->

308+ "I ran into trouble with the " ++ D.intToOrdinal index ++ " index of this array:"

268309

269−

270−data ErrorTree e =

271− ErrorTree

272− { _theories :: [(E.Value, Theory e)]

273− , _subErrors :: Map.Map String (ErrorTree e)

274− }

275−

276−

277−toErrorTree :: Json.Error e -> ErrorTree e

278−toErrorTree jsonError =

279− add jsonError empty

280−

281−

282−empty :: ErrorTree e

283−empty =

284− ErrorTree [] Map.empty

285−

286−

287−add :: Json.Error e -> ErrorTree e -> ErrorTree e

288−add jsonError tree@(ErrorTree theories subErrors) =

289− case jsonError of

290− Json.Field field subErr ->

291− ErrorTree theories (addName (fieldToName field) subErr subErrors)

292−

293− Json.Index index subErr ->

294− ErrorTree theories (addName (indexToName index) subErr subErrors)

295−

296− Json.OneOf errors ->

297− foldr add tree errors

298−

299− Json.Expecting json tipe ->

300− ErrorTree ((json, Expecting tipe) : theories) subErrors

301−

302− Json.Failure json err ->

303− ErrorTree ((json, Failure err) : theories) subErrors

304−

305−

306−addName :: String -> Json.Error e -> Map.Map String (ErrorTree e) -> Map.Map String (ErrorTree e)

307−addName name err subErrors =

308− let

309− subAdd maybeCrush =

310− Just (add err (maybe empty id maybeCrush))

310+ toSnippet title aThing =

311+ Help.jsonReport title (Just path) $

312+ Code.toSnippet source region Nothing

313+ ( D.reflow (because reason introduction)

314+ , D.fillSep $ ["I","was","expecting","to","run","into"] ++ aThing

315+ )

311316 in

312− Map.alter subAdd name subErrors

317+ case expectation of

318+ TObject ->

319+ toSnippet "EXPECTING OBJECT" ["an", D.green "OBJECT" <> "."]

313320

321+ TArray ->

322+ toSnippet "EXPECTING ARRAY" ["an", D.green "ARRAY" <> "."]

314323

315−fieldToName :: Text.Text -> String

316−fieldToName field =

317− case Text.unpack field of

318− [] ->

319− "['']"

324+ TString ->

325+ toSnippet "EXPECTING STRING" ["a", D.green "STRING" <> "."]

320326

321− string@(char : rest) ->

322− if Char.isAlpha char && all Char.isAlphaNum rest then

323− '.' : string

324− else

325− "['" ++ string ++ "']"

327+ TBool ->

328+ toSnippet "EXPECTING BOOL" ["a", D.green "BOOLEAN" <> "."]

326329

330+ TInt ->

331+ toSnippet "EXPECTING INT" ["an", D.green "INT" <> "."]

327332

328−indexToName :: Int -> String

329−indexToName index =

330− "[" ++ show index ++ "]"

333+ TObjectWith field ->

334+ toSnippet "MISSING FIELD"

335+ ["an",D.green "OBJECT","with","a"

336+ ,D.green ("\"" <> D.fromChars (BS_UTF8.toString field) <> "\"")

337+ ,"field."

338+ ]

331339

332−-}

340+ TArrayPair len ->

341+ toSnippet "EXPECTING PAIR"

342+ ["an",D.green "ARRAY","with",D.green "TWO","entries."

343+ ,"This","array","has",D.fromInt len, if len == 1 then "element." else "elements."

344+ ]

compiler/src/Reporting/Error/Pattern.hs+2−2

@@ -41,7 +41,7 @@ toReport source err =

4141 Report.Report "UNSAFE PATTERN" region [] $

4242 Code.toSnippet source region Nothing

4343 (

44− "This pattern does not cover all possiblities:"

44+ "This pattern does not cover all possibilities:"

4545 ,

4646 D.stack

4747 [ "Other possibilities include:"

@@ -64,7 +64,7 @@ toReport source err =

6464 , unhandledPatternsToDocBlock unhandled

6565 , D.reflow $

6666 "I would have to crash if I saw one of those! You can use\

67− \ `let` to deconstruct values only if there is ONE possiblity.\

67+ \ `let` to deconstruct values only if there is ONE possibility.\

6868 \ Switch to a `case` expression to account for all possibilities."

6969 , D.toSimpleHint $

7070 "Are you calling a function that definitely returns values\

compiler/src/Reporting/Error/Syntax.hs+1026−450

@@ -2,6 +2,7 @@

22{-# LANGUAGE OverloadedStrings #-}

33module Reporting.Error.Syntax

44 ( Error(..)

5+ , toReport

56 --

67 , Module(..)

78 , Exposing(..)

@@ -39,7 +40,7 @@ module Reporting.Error.Syntax

3940 , Number(..)

4041 --

4142 , Space(..)

42− , toReport

43+ , toSpaceReport

4344 )

4445 where

4546

@@ -68,6 +69,9 @@ data Error

6869 | ModuleNameMismatch ModuleName.Raw (A.Located ModuleName.Raw)

6970 | UnexpectedPort A.Region

7071 | NoPorts A.Region

72+ | NoPortsInPackage (A.Located Name.Name)

73+ | NoPortModulesInPackage A.Region

74+ | NoEffectsOutsideKernel A.Region

7175 | ParseError Module

7276

7377

@@ -516,7 +520,7 @@ toReport source err =

516520 ,

517521 D.stack

518522 [ D.reflow $

519− "I need it to match the file path, so I was expecting it to see `"

523+ "I need it to match the file path, so I was expecting to see `"

520524 ++ ModuleName.toChars expectedName

521525 ++ "` here. Make the following change, and you should be all set!"

522526 , D.indent 4 $

@@ -560,10 +564,84 @@ toReport source err =

560564 ]

561565 )

562566

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+

563619 ParseError modul ->

564620 toParseErrorReport source modul

565621

566622

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+

567645toParseErrorReport :: Code.Source -> Module -> Report.Report

568646toParseErrorReport source modul =

569647 case modul of

@@ -571,64 +649,9 @@ toParseErrorReport source modul =

571649 toSpaceReport source space row col

572650

573651 ModuleBadEnd row col ->

574− case Code.whatIsNext source row col of

575− Code.Keyword keyword ->

576− let

577− region = toKeywordRegion row col keyword

578− in

579− Report.Report "RESERVED WORD" region [] $

580− Code.toSnippet source region Nothing

581− (

582− D.reflow $

583− "I got stuck on this reserved word:"

584− ,

585− D.reflow $

586− "The name `" ++ keyword ++ "` is reserved, so try using a different name?"

587− )

588−

589− Code.Operator op ->

590− let

591− region = toKeywordRegion row col op

592− in

593− Report.Report "UNEXPECTED SYMBOL" region [] $

594− Code.toSnippet source region Nothing

595− (

596− D.reflow $

597− "I ran into an unexpected symbol:"

598− ,

599− D.reflow $

600− "I was not expecting to see a " ++ op ++ " here. Try deleting it? Maybe\

601− \ I can give a better hint from there?"

602− )

603−

604− Code.Close term bracket ->

605− let

606− region = toRegion row col

607− in

608− Report.Report ("UNEXPECTED " ++ map Char.toUpper term) region [] $

609− Code.toSnippet source region Nothing

610− (

611− D.reflow $

612− "I ran into an unexpected " ++ term ++ ":"

613− ,

614− D.reflow $

615− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"

616− )

617−

618− Code.Other ->

619− let

620− region = toRegion row col

621− in

622− Report.Report "SYNTAX PROBLEM" region [] $

623− Code.toSnippet source region Nothing

624− (

625− D.reflow $

626− "I got stuck here:"

627− ,

628− D.reflow $

629− "Whatever I am running into is confusing me a lot! Normally I can give fairly\

630− \ specific hints, but something is really tripping me up this time."

631− )

652+ if col == 1

653+ then toDeclStartReport source row col

654+ else toWeirdEndReport source row col

632655

633656 ModuleProblem row col ->

634657 let

@@ -774,15 +797,15 @@ toParseErrorReport source modul =

774797 [ D.reflow $

775798 "I am not sure what is going on, but I recommend starting an Elm\

776799 \ file with the following lines:"

777− , D.vcat

800+ , D.indent 4 $ D.vcat $

778801 [ D.fillSep [D.cyan "import","Html"]

779802 , ""

780− , D.fillSep [D.green "main","="]

781− , D.indent 2 $ D.fillSep [D.cyan "Html" <> ".text",D.dullyellow "\"Hello!\""]

803+ , "main ="

804+ , " Html.text " <> D.dullyellow "\"Hello!\""

782805 ]

783806 , D.reflow $

784− "You should be able to copy those lines directly into your file. Check out\

785− \ some of the examples on https://elm-lang.org for more help getting started!"

807+ "You should be able to copy those lines directly into your file. Check out the\

808+ \ examples at <https://elm-lang.org/examples> for more help getting started!"

786809 , D.toSimpleNote $

787810 "This can also happen when something is indented too much!"

788811 ]

@@ -807,11 +830,12 @@ toParseErrorReport source modul =

807830 , D.indent 4 $ D.vcat $

808831 [ D.fillSep [D.cyan "import","Dict"]

809832 , D.fillSep [D.cyan "import","Maybe"]

810− , D.fillSep [D.cyan "import","Html.Attributes"]

811− , D.fillSep [D.cyan "import","Json.Decode"]

833+ , D.fillSep [D.cyan "import","Html.Attributes",D.cyan "as","A"]

834+ , D.fillSep [D.cyan "import","Json.Decode",D.cyan "exposing","(..)"]

812835 ]

813836 , D.reflow $

814837 "Notice that the module names all start with capital letters. That is required!"

838+ , D.reflowLink "Read" "imports" "to learn more."

815839 ]

816840 )

817841

@@ -822,7 +846,7 @@ toParseErrorReport source modul =

822846 let

823847 region = toRegion row col

824848 in

825− Report.Report "EXECTING IMPORT ALIAS" region [] $

849+ Report.Report "EXPECTING IMPORT ALIAS" region [] $

826850 Code.toSnippet source region Nothing

827851 (

828852 D.reflow $

@@ -838,6 +862,7 @@ toParseErrorReport source modul =

838862 ]

839863 , D.reflow $

840864 "Notice that the alias always starts with a capital letter. That is required!"

865+ , D.reflowLink "Read" "imports" "to learn more."

841866 ]

842867 )

843868

@@ -900,6 +925,192 @@ toParseErrorReport source modul =

900925

901926

902927

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+

9031114-- IMPORTS

9041115

9051116

@@ -925,6 +1136,7 @@ toImportReport source row col =

9251136 ]

9261137 , D.reflow $

9271138 "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."

9281140 ]

9291141 )

9301142

@@ -1231,106 +1443,7 @@ toDeclarationsReport :: Code.Source -> Decl -> Report.Report

12311443toDeclarationsReport source decl =

12321444 case decl of

12331445 DeclStart row col ->

1234− case Code.whatIsNext source row col of

1235− Code.Close term bracket ->

1236− let

1237− region = toRegion row col

1238− in

1239− Report.Report ("STRAY " ++ map Char.toUpper term) region [] $

1240− Code.toSnippet source region Nothing

1241− (

1242− D.reflow $

1243− "I was not expecting to see a " ++ term ++ " here:"

1244− , D.reflow $

1245− "This " ++ bracket : " does not match up with an earlier open " ++ term ++ ". Try deleting it?"

1246− )

1247−

1248− Code.Keyword keyword ->

1249− let

1250− region = toKeywordRegion row col keyword

1251− in

1252− Report.Report "RESERVED WORD" region [] $

1253− Code.toSnippet source region Nothing

1254− (

1255− D.reflow $

1256− "I was not expecting to run into the `" ++ keyword ++ "` keyword here:"

1257− ,

1258− case keyword of

1259− "import" ->

1260− D.reflow $

1261− "It is reserved for declaring imports at the top of your module. If you want\

1262− \ another import, try moving it up top with the other imports. If you want to\

1263− \ define a value or function, try changing the name to something else!"

1264−

1265− "case" ->

1266− D.stack

1267− [ D.reflow $

1268− "It is reserved for writing `case` expressions. Try using a different name?"

1269− , D.toSimpleNote $

1270− "If you are trying to write a `case` expression, it needs to be part of a\

1271− \ definition. So you could write something like this instead:"

1272− , D.vcat $

1273− [ D.indent 0 $ D.fillSep [D.green "getWidth","maybeWidth","="]

1274− , D.indent 2 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]

1275− , D.indent 4 $ D.fillSep [D.blue "Just","width","->"]

1276− , D.indent 6 $ D.fillSep ["width","+",D.dullyellow "200"]

1277− , ""

1278− , D.indent 4 $ D.fillSep [D.blue "Nothing","->"]

1279− , D.indent 6 $ D.fillSep [D.dullyellow "400"]

1280− ]

1281− , D.reflow $

1282− "This defines a `getWidth` function that we can use elsewhere in our program."

1283− ]

1284−

1285− "if" ->

1286− D.stack

1287− [ D.reflow $

1288− "It is reserved for writing `if` expressions. Try using a different name?"

1289− , D.toSimpleNote $

1290− "If you are trying to write an `if` expression, it needs to be part of a\

1291− \ definition. So you could write something like this instead:"

1292− , D.vcat $

1293− [ D.indent 0 $ D.fillSep [D.green "reviewPowerLevel","powerLevel","="]

1294− , D.indent 2 $ D.fillSep $

1295− [D.cyan "if","powerLevel",">",D.dullyellow "9000"

1296− ,D.cyan "then",D.dullyellow "\"OVER 9000!!!\""

1297− ,D.cyan "else",D.dullyellow "\"not bad\""

1298− ]

1299− ]

1300− , D.reflow $

1301− "This defines a `reviewPowerLevel` function that we can use elsewhere in our program."

1302− ]

1303−

1304− _ ->

1305− D.reflow $

1306− "It is a reserved word. Try changing the name to something else?"

1307− )

1308−

1309− _ ->

1310− let

1311− region = toRegion row col

1312− in

1313− Report.Report "SYNTAX PROBLEM" region [] $

1314− Code.toSnippet source region Nothing

1315− (

1316− D.reflow $

1317− "I was expecting to see a new declaration here:"

1318− ,

1319− D.stack

1320− [ D.reflow $

1321− "I am not sure what is going wrong exactly, but here are a couple valid\

1322− \ declarations for reference:"

1323− , D.vcat

1324− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

1325− , D.fillSep [D.green "add","x","y","="]

1326− , D.fillSep [" ","x","+","y"]

1327− ]

1328− , D.fillSep [D.cyan "type",D.green "User","=","Anonymous","|","LoggedIn String"]

1329− , D.reflow $

1330− "Note that all declarations start with lower-case letters in Elm. Capitalization\

1331− \ makes a difference, so be consious of that if you are working from examples!"

1332− ]

1333− )

1446+ toDeclStartReport source row col

13341447

13351448 DeclSpace space row col ->

13361449 toSpaceReport source space row col

@@ -1360,6 +1473,165 @@ toDeclarationsReport source decl =

13601473 )

13611474

13621475

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+

13631635

13641636-- PORT

13651637

@@ -1486,7 +1758,7 @@ toPortReport source port_ startRow startCol =

14861758 [ D.reflow $

14871759 "I was expecting to see a type next. Here are examples of outgoing and\

14881760 \ incoming ports for reference:"

1489− , D.vcat

1761+ , D.indent 4 $ D.vcat $

14901762 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]

14911763 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]

14921764 ]

@@ -1505,7 +1777,7 @@ portNote =

15051777 D.stack

15061778 [ D.toSimpleNote $

15071779 "Here are some example `port` declarations for reference:"

1508− , D.vcat

1780+ , D.indent 4 $ D.vcat $

15091781 [ D.fillSep [D.cyan "port","send",":","String -> Cmd msg"]

15101782 , D.fillSep [D.cyan "port","receive",":","(String -> msg) -> Sub msg"]

15111783 ]

@@ -1635,7 +1907,7 @@ toTypeAliasReport source typeAlias startRow startCol =

16351907 ,

16361908 D.stack

16371909 [ D.reflow $

1638− "I was expecting to see a type variable or an an equals sign next."

1910+ "I was expecting to see a type variable or an equals sign next."

16391911 , typeAliasNote

16401912 ]

16411913 )

@@ -1656,7 +1928,7 @@ toTypeAliasReport source typeAlias startRow startCol =

16561928 ,

16571929 D.stack

16581930 [ D.reflow $

1659− "I was expecting to see a type variable or an an equals sign next."

1931+ "I was expecting to see a type variable or an equals sign next."

16601932 , typeAliasNote

16611933 ]

16621934 )

@@ -1688,8 +1960,8 @@ typeAliasNote =

16881960 [ D.toSimpleNote $

16891961 "Here is an example of a valid `type alias` for reference:"

16901962 , D.vcat $

1691− [ D.indent 0 $ D.fillSep [D.cyan "type",D.cyan "alias",D.green "Person","="]

1692− , D.indent 2 $ D.vcat $

1963+ [ D.indent 4 $ D.fillSep [D.cyan "type",D.cyan "alias","Person","="]

1964+ , D.indent 6 $ D.vcat $

16931965 ["{ name : String"

16941966 ,", age : Int"

16951967 ,", height : Float"

@@ -1763,7 +2035,7 @@ toCustomTypeReport source customType startRow startCol =

17632035 ,

17642036 D.stack

17652037 [ D.reflow $

1766− "I was expecting to see a type variable or an an equals sign next."

2038+ "I was expecting to see a type variable or an equals sign next."

17672039 , customTypeNote

17682040 ]

17692041 )

@@ -1823,7 +2095,7 @@ toCustomTypeReport source customType startRow startCol =

18232095 ,

18242096 D.stack

18252097 [ D.reflow $

1826− "I was expecting to see a type variable or an an equals sign next."

2098+ "I was expecting to see a type variable or an equals sign next."

18272099 , customTypeNote

18282100 ]

18292101 )

@@ -1889,10 +2161,10 @@ customTypeNote =

18892161 [ D.toSimpleNote $

18902162 "Here is an example of a valid `type` declaration for reference:"

18912163 , D.vcat $

1892− [ D.indent 0 $ D.fillSep [D.cyan "type",D.green "Status"]

1893− , D.indent 2 $ D.fillSep ["=","Failure"]

1894− , D.indent 2 $ D.fillSep ["|","Waiting"]

1895− , D.indent 2 $ D.fillSep ["|","Success","String"]

2164+ [ D.indent 4 $ D.fillSep [D.cyan "type","Status"]

2165+ , D.indent 6 $ D.fillSep ["=","Failure"]

2166+ , D.indent 6 $ D.fillSep ["|","Waiting"]

2167+ , D.indent 6 $ D.fillSep ["|","Success","String"]

18962168 ]

18972169 , D.reflow $

18982170 "This defines a new `Status` type with three variants. This could be useful if\

@@ -1923,11 +2195,55 @@ toDeclDefReport source name declDef startRow startCol =

19232195 Report.Report "RESERVED WORD" region [] $

19242196 Code.toSnippet source surroundings (Just region)

19252197 (

1926− D.reflow $

1927− "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"

2198+ D.fillSep

2199+ ["The","name"

2200+ ,"`" <> D.cyan (D.fromChars keyword) <> "`"

2201+ ,"is","reserved","in","Elm,","so","it","cannot"

2202+ ,"be","used","as","an","argument","here:"

2203+ ]

19282204 ,

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+ (

19292230 D.reflow $

1930− "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+ ]

19312247 )

19322248

19332249 Code.Operator op ->

@@ -1945,10 +2261,10 @@ toDeclDefReport source name declDef startRow startCol =

19452261 [ D.reflow $

19462262 "I am not sure what is going wrong exactly, so here is a valid\

19472263 \ definition (with an optional type annotation) for reference:"

1948− , D.vcat

1949− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

1950− , D.fillSep [D.green "add","x","y","="]

1951− , D.fillSep [" ","x","+","y"]

2264+ , D.indent 4 $ D.vcat $

2265+ [ "greet : String -> String"

2266+ , "greet name ="

2267+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

19522268 ]

19532269 , D.reflow $

19542270 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

@@ -1970,10 +2286,10 @@ toDeclDefReport source name declDef startRow startCol =

19702286 [ D.reflow $

19712287 "I am not sure what is going wrong exactly, so here is a valid\

19722288 \ definition (with an optional type annotation) for reference:"

1973− , D.vcat

1974− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

1975− , D.fillSep [D.green "add","x","y","="]

1976− , D.fillSep [" ","x","+","y"]

2289+ , D.indent 4 $ D.vcat $

2290+ [ "greet : String -> String"

2291+ , "greet name ="

2292+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

19772293 ]

19782294 , D.reflow $

19792295 "Try to use that format!"

@@ -2088,10 +2404,10 @@ declDefNote =

20882404 D.stack

20892405 [ D.reflow $

20902406 "Here is a valid definition (with a type annotation) for reference:"

2091− , D.vcat

2092− [ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

2093− , D.fillSep [D.green "add","x","y","="]

2094− , D.fillSep [" ","x","+","y"]

2407+ , D.indent 4 $ D.vcat $

2408+ [ "greet : String -> String"

2409+ , "greet name ="

2410+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

20952411 ]

20962412 , D.reflow $

20972413 "The top line (called a \"type annotation\") is optional. You can leave it off\

@@ -2203,25 +2519,40 @@ toExprReport source context expr startRow startCol =

22032519 )

22042520

22052521 OperatorRight op row col ->

2206− let region = toRegion row col in

2522+ let

2523+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

2524+ region = toRegion row col

2525+ isMath = elem op ["-","+","*","/","^"]

2526+ in

22072527 Report.Report "MISSING EXPRESSION" region [] $

2208− Code.toSnippet source region Nothing

2528+ Code.toSnippet source surroundings (Just region)

22092529 (

22102530 D.reflow $

2211− "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:"

22122534 ,

2213− D.stack

2214− [ D.fillSep $

2215− ["You","can","just","put","anything","for","now,","like"

2216− ,D.dullyellow "42","or",D.dullyellow"\"hello\"" <> "."

2217− ,"Once","there","is","something","there,","I","can","probably"

2218− ,"give","a","more","specific","hint!"

2219− ]

2220− , D.toSimpleNote $

2221− "This can also happen if run into reserved words like `let` or `as` unexpectedly.\

2222− \ Or if I run into operators in unexpected spots. Point is, there are a\

2223− \ couple ways I can get confused and give sort of weird advice!"

2224− ]

2535+ if isMath then

2536+ D.fillSep

2537+ ["I","was","expecting","to","see","an","expression","next."

2538+ ,"Something","like",D.dullyellow "42","or",D.dullyellow "1000"

2539+ ,"that","makes","sense","with","a",D.fromName op,"sign."

2540+ ]

2541+ else if op == "&&" || op == "||" then

2542+ D.fillSep

2543+ ["I","was","expecting","to","see","an","expression","next."

2544+ ,"Something","like",D.dullyellow "True","or",D.dullyellow "False"

2545+ ,"that","makes","sense","with","boolean","logic."

2546+ ]

2547+ else if op == "|>" then

2548+ D.reflow $

2549+ "I was expecting to see a function next."

2550+ else if op == "<|" then

2551+ D.reflow $

2552+ "I was expecting to see an argument next."

2553+ else

2554+ D.reflow $

2555+ "I was expecting to see an expression next."

22252556 )

22262557

22272558 OperatorReserved operator row col ->

@@ -2242,7 +2573,6 @@ toExprReport source context expr startRow startCol =

22422573 InNode NElse r c _ -> (r, c, "an `if` expression")

22432574 InNode NCase r c _ -> (r, c, "a `case` expression")

22442575 InNode NBranch r c _ -> (r, c, "a `case` expression")

2245− -- TODO check if this is actually the best way to get error messages here

22462576

22472577 surroundings = A.Region (A.Position contextRow contextCol) (A.Position row col)

22482578 region = toRegion row col

@@ -2261,7 +2591,7 @@ toExprReport source context expr startRow startCol =

22612591 ,"give","a","more","specific","hint!"

22622592 ]

22632593 , D.toSimpleNote $

2264− "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.\

22652595 \ Or if I run into operators in unexpected spots. Point is, there are a\

22662596 \ couple ways I can get confused and give sort of weird advice!"

22672597 ]

@@ -2407,7 +2737,19 @@ toStringReport source string row col =

24072737 ,"quotes","on","each","end.","Is","the","closing","double"

24082738 ,"quote","missing","in","your","code?"

24092739 ]

2410− , D.link "Note" "Read" "TODO" "if you want a string that spans multiple lines."

2740+ , D.toSimpleNote $

2741+ "For a string that spans multiple lines, you can use the multi-line string\

2742+ \ syntax like this:"

2743+ , D.dullyellow $ D.indent 4 $ D.vcat $

2744+ [ "\"\"\""

2745+ , "# Multi-line Strings"

2746+ , ""

2747+ , "- start with triple double quotes"

2748+ , "- write whatever you want"

2749+ , "- no need to escape newlines or double quotes"

2750+ , "- end with triple double quotes"

2751+ , "\"\"\""

2752+ ]

24112753 ]

24122754 )

24132755

@@ -2423,7 +2765,18 @@ toStringReport source string row col =

24232765 ,

24242766 D.stack

24252767 [ D.reflow "Add a \"\"\" somewhere after this to end the string."

2426− , D.link "Hint" "Read" "TODO" "for more information on strings and multi-line strings."

2768+ , D.toSimpleNote $

2769+ "Here is a valid multi-line string for reference:"

2770+ , D.dullyellow $ D.indent 4 $ D.vcat $

2771+ [ "\"\"\""

2772+ , "# Multi-line Strings"

2773+ , ""

2774+ , "- start with triple double quotes"

2775+ , "- write whatever you want"

2776+ , "- no need to escape newlines or double quotes"

2777+ , "- end with triple double quotes"

2778+ , "\"\"\""

2779+ ]

24272780 ]

24282781 )

24292782

@@ -2656,33 +3009,41 @@ toOperatorReport source context operator row col =

26563009 in

26573010 Report.Report "UNEXPECTED ARROW" region [] $

26583011 Code.toSnippet source region Nothing $

2659− if isWithin NBranch context then

3012+ if isWithin NCase context then

26603013 (

26613014 D.reflow $

2662− "I was not expecting to see an arrow here:"

3015+ "I am parsing a `case` expression right now, but this arrow is confusing me:"

26633016 ,

26643017 D.stack

2665− [

2666− D.reflow $

2667− "I think I am parsing a `case` expression right now, so it makes sense to\

2668− \ see arrows around here. This one is confusing me though!"

2669− ,

2670− D.toSimpleHint $

2671− "I may be getting confused by the indentation. Every pattern in a `case` must be\

2672− \ exactly aligned (with exactly the same amount of indentation) so maybe this arrow\

2673− \ appears after the next `case` pattern (correctly!) but the pattern itself is\

2674− \ indented too far?"

3018+ [ D.reflow "Maybe the `of` keyword is missing on a previous line?"

3019+ , noteForCaseError

26753020 ]

26763021 )

26773022

2678− else

3023+ else if isWithin NBranch context then

26793024 (

26803025 D.reflow $

2681− "I was not expecting an arrow here:"

3026+ "I am parsing a `case` expression right now, but this arrow is confusing me:"

26823027 ,

3028+ D.stack

3029+ [ D.reflow $

3030+ "It makes sense to see arrows around here, so I suspect it is something earlier. Maybe this pattern is indented a bit farther than the previous patterns?"

3031+ , noteForCaseIndentError

3032+ ]

3033+ )

3034+

3035+ else

3036+ (

26833037 D.reflow $

2684− "Arrows should only appear in `case` expressions and anonymous functions. Maybe\

2685− \ you want > or >= instead?"

3038+ "I was partway through parsing an expression when I got stuck on this arrow:"

3039+ ,

3040+ D.stack

3041+ [ "Arrows should only appear in `case` expressions and anonymous functions.\n\

3042+ \Maybe it was supposed to be a > sign instead?"

3043+ , D.toSimpleNote $

3044+ "The syntax for anonymous functions is (\\x -> x + 1) so the arguments all appear\

3045+ \ after the backslash and before the arrow. Maybe a backslash is missing earlier?"

3046+ ]

26863047 )

26873048

26883049 BadEquals ->

@@ -2809,7 +3170,7 @@ toLetReport source context let_ startRow startCol =

28093170 , D.toSimpleNote $

28103171 "This can also happen if you are trying to define another value within the `let` but\

28113172 \ it is not indented enough. Make sure each definition has exactly the same amount of\

2812− \ spaces before it. The should line up exactly!"

3173+ \ spaces before it. They should line up exactly!"

28133174 ]

28143175 )

28153176

@@ -2879,8 +3240,8 @@ toUnfinishLetReport source row col startRow startCol message =

28793240 [ message

28803241 , D.toSimpleNote $

28813242 "Here is an example with a valid `let` expression for reference:"

2882− , D.vcat $

2883− [ D.indent 0 $ D.fillSep [D.green "viewPerson","person","="]

3243+ , D.indent 4 $ D.vcat $

3244+ [ D.indent 0 $ D.fillSep ["viewPerson","person","="]

28843245 , D.indent 2 $ D.fillSep [D.cyan "let"]

28853246 , D.indent 4 $ D.fillSep ["fullName","="]

28863247 , D.indent 6 $ D.fillSep ["person.firstName","++",D.dullyellow "\" \"","++","person.lastName"]

@@ -2957,11 +3318,55 @@ toLetDefReport source name def startRow startCol =

29573318 Report.Report "RESERVED WORD" region [] $

29583319 Code.toSnippet source surroundings (Just region)

29593320 (

2960− D.reflow $

2961− "It looks like you are trying to use `" ++ keyword ++ "` as an argument:"

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+ ]

29623327 ,

3328+ D.stack

3329+ [ D.reflow $

3330+ "Try renaming it to something else."

3331+ , case keyword of

3332+ "as" ->

3333+ D.toFancyNote

3334+ ["This","keyword","is","reserved","for","pattern","matches","like"

3335+ ,"((x,y)",D.cyan "as","point)","where","you","want","to","name","a","tuple","and"

3336+ ,"the","values","it","contains."

3337+ ]

3338+

3339+ _ ->

3340+ D.toSimpleNote $

3341+ "The `" ++ keyword ++ "` keyword has a special meaning in Elm, so it can only be used in certain situations."

3342+ ]

3343+ )

3344+

3345+ Code.Operator "->" ->

3346+ let

3347+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3348+ region = toWiderRegion row col 2

3349+ in

3350+ Report.Report "MISSING COLON?" region [] $

3351+ Code.toSnippet source surroundings (Just region)

3352+ (

29633353 D.reflow $

2964− "This is a reserved word! Try using some other name?"

3354+ "I was not expecting to see an arrow here:"

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+ ]

3367+ , D.reflow $

3368+ "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

3369+ ]

29653370 )

29663371

29673372 Code.Operator op ->

@@ -2979,10 +3384,10 @@ toLetDefReport source name def startRow startCol =

29793384 [ D.reflow $

29803385 "I am not sure what is going wrong exactly, so here is a valid\

29813386 \ definition (with an optional type annotation) for reference:"

2982− , D.vcat

2983− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

2984− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]

2985− , D.indent 6 $ D.fillSep ["x","+","y"]

3387+ , D.indent 4 $ D.vcat $

3388+ [ "greet : String -> String"

3389+ , "greet name ="

3390+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

29863391 ]

29873392 , D.reflow $

29883393 "Try to use that format with your `" ++ Name.toChars name ++ "` definition!"

@@ -3004,10 +3409,10 @@ toLetDefReport source name def startRow startCol =

30043409 [ D.reflow $

30053410 "I am not sure what is going wrong exactly, so here is a valid\

30063411 \ definition (with an optional type annotation) for reference:"

3007− , D.vcat

3008− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

3009− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]

3010− , D.indent 4 $ D.fillSep ["x","+","y"]

3412+ , D.indent 4 $ D.vcat $

3413+ [ "greet : String -> String"

3414+ , "greet name ="

3415+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

30113416 ]

30123417 , D.reflow $

30133418 "Try to use that format!"

@@ -3097,10 +3502,10 @@ defNote =

30973502 D.stack

30983503 [ D.reflow $

30993504 "Here is a valid definition (with a type annotation) for reference:"

3100− , D.vcat

3101− [ D.indent 4 $ D.fillSep [D.green "add",":","Int","->","Int","->","Int"]

3102− , D.indent 4 $ D.fillSep [D.green "add","x","y","="]

3103− , D.indent 6 $ D.fillSep ["x","+","y"]

3505+ , D.indent 4 $ D.vcat $

3506+ [ "greet : String -> String"

3507+ , "greet name ="

3508+ , " " <> D.dullyellow "\"Hello \"" <> " ++ name ++ " <> D.dullyellow "\"!\""

31043509 ]

31053510 , D.reflow $

31063511 "The top line (called a \"type annotation\") is optional. You can leave it off\

@@ -3263,9 +3668,10 @@ toCaseReport source context case_ startRow startCol =

32633668 D.reflow $

32643669 "I am partway through parsing a `case` expression, but I got stuck here:"

32653670 ,

3266− addNoteForCaseIndentError $

3267− D.reflow $

3268− "I was expecting to see an arrow next."

3671+ D.stack

3672+ [ D.reflow "I was expecting to see an arrow next."

3673+ , noteForCaseIndentError

3674+ ]

32693675 )

32703676

32713677 CaseExpr expr row col ->

@@ -3319,28 +3725,33 @@ toUnfinishCaseReport source row col startRow startCol message =

33193725 ,

33203726 D.stack

33213727 [ message

3322− , D.toSimpleNote $

3323− "Here is an example of a valid `case` expression for reference."

3324− , D.vcat $

3325− [ D.indent 4 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]

3326− , D.indent 6 $ D.fillSep [D.blue "Just","width","->"]

3327− , D.indent 8 $ D.fillSep ["width","+",D.dullyellow "200"]

3328− , ""

3329− , D.indent 6 $ D.fillSep [D.blue "Nothing","->"]

3330− , D.indent 8 $ D.fillSep [D.dullyellow "400"]

3331− ]

3332− , D.reflow $

3333− "Notice the indentation. Each pattern is aligned, and each branch is indented\

3334− \ a bit more than the corresponding pattern. That is important!"

3728+ , noteForCaseError

33353729 ]

33363730 )

33373731

33383732

3339−addNoteForCaseIndentError :: D.Doc -> D.Doc

3340−addNoteForCaseIndentError message =

3341− D.stack $

3342− message

3343− :

3733+noteForCaseError :: D.Doc

3734+noteForCaseError =

3735+ D.stack

3736+ [ D.toSimpleNote $

3737+ "Here is an example of a valid `case` expression for reference."

3738+ , D.vcat $

3739+ [ D.indent 4 $ D.fillSep [D.cyan "case","maybeWidth",D.cyan "of"]

3740+ , D.indent 6 $ D.fillSep [D.blue "Just","width","->"]

3741+ , D.indent 8 $ D.fillSep ["width","+",D.dullyellow "200"]

3742+ , ""

3743+ , D.indent 6 $ D.fillSep [D.blue "Nothing","->"]

3744+ , D.indent 8 $ D.fillSep [D.dullyellow "400"]

3745+ ]

3746+ , D.reflow $

3747+ "Notice the indentation. Each pattern is aligned, and each branch is indented\

3748+ \ a bit more than the corresponding pattern. That is important!"

3749+ ]

3750+

3751+

3752+noteForCaseIndentError :: D.Doc

3753+noteForCaseIndentError =

3754+ D.stack

33443755 [ D.toSimpleNote $

33453756 "Sometimes I get confused by indentation, so try to make your `case` look\

33463757 \ something like this:"

@@ -3353,8 +3764,9 @@ addNoteForCaseIndentError message =

33533764 , D.indent 8 $ D.fillSep [D.dullyellow "400"]

33543765 ]

33553766 , D.reflow $

3356− "Notice the indentation! Each pattern is aligned, and each branch is indented\

3357− \ a bit more than the corresponding pattern. That is important!"

3767+ "Notice the indentation! Patterns are aligned with each other. Same indentation.\

3768+ \ The expressions after each arrow are all indented a bit more than the patterns.\

3769+ \ That is important!"

33583770 ]

33593771

33603772

@@ -3506,23 +3918,43 @@ toIfReport source context if_ startRow startCol =

35063918 )

35073919

35083920 IfIndentElse row col ->

3509− let

3510− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3511− region = toRegion row col

3512− in

3513− Report.Report "UNFINISHED IF" region [] $

3514− Code.toSnippet source surroundings (Just region)

3515− (

3516− D.reflow $

3517− "I was expecting to see an `else` branch after this:"

3518− ,

3519− D.stack

3520− [ D.reflow $

3521− "I know what to do when the condition is `True`, but not when it is `False`."

3522− , D.fillSep

3523− ["Add","an",D.cyan "else","branch","to","handle","that","scenario!"]

3524− ]

3525− )

3921+ case Code.nextLineStartsWithKeyword "else" source row of

3922+ Just (elseRow, elseCol) ->

3923+ let

3924+ surroundings = A.Region (A.Position startRow startCol) (A.Position elseRow elseCol)

3925+ region = toWiderRegion elseRow elseCol 4

3926+ in

3927+ Report.Report "WEIRD ELSE BRANCH" region [] $

3928+ Code.toSnippet source surroundings (Just region)

3929+ (

3930+ D.reflow $

3931+ "I was partway through an `if` expression when I got stuck here:"

3932+ ,

3933+ D.fillSep $

3934+ ["I","think","this",D.cyan "else","keyword","needs","to","be","indented","more."

3935+ ,"Try","adding","some","spaces","before","it."

3936+ ]

3937+ )

3938+

3939+ Nothing ->

3940+ let

3941+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3942+ region = toRegion row col

3943+ in

3944+ Report.Report "UNFINISHED IF" region [] $

3945+ Code.toSnippet source surroundings (Just region)

3946+ (

3947+ D.reflow $

3948+ "I was expecting to see an `else` branch after this:"

3949+ ,

3950+ D.stack

3951+ [ D.fillSep

3952+ ["I","know","what","to","do","when","the","condition","is","True,"

3953+ ,"but","what","happens","when","it","is","False?"

3954+ ,"Add","an",D.cyan "else","branch","to","handle","that","scenario!"

3955+ ]

3956+ ]

3957+ )

35263958

35273959

35283960

@@ -3555,15 +3987,22 @@ toRecordReport source context record startRow startCol =

35553987 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

35563988 region = toRegion row col

35573989 in

3558− Report.Report "UNFINISHED RECORD" region [] $

3990+ Report.Report "PROBLEM IN RECORD" region [] $

35593991 Code.toSnippet source surroundings (Just region)

35603992 (

35613993 D.reflow $

35623994 "I just started parsing a record, but I got stuck here:"

35633995 ,

3564− D.fillSep

3565− ["Records","look","like",D.dullyellow "{ x = 3, y = 4 },"

3566− ,"so","I","was","expecting","to","see","a","field","name","next."

3996+ D.stack

3997+ [ D.fillSep

3998+ ["I","was","expecting","to","see","a","record","field","defined","next,"

3999+ ,"so","I","am","looking","for","a","name","like"

4000+ ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."

4001+ ]

4002+ , D.toSimpleNote $

4003+ "Field names must start with a lower-case letter. After that, you can use\

4004+ \ any sequence of letters, numbers, and underscores."

4005+ , noteForRecordError

35674006 ]

35684007 )

35694008

@@ -3572,7 +4011,7 @@ toRecordReport source context record startRow startCol =

35724011 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

35734012 region = toRegion row col

35744013 in

3575− Report.Report "UNFINISHED RECORD" region [] $

4014+ Report.Report "PROBLEM IN RECORD" region [] $

35764015 Code.toSnippet source surroundings (Just region)

35774016 (

35784017 D.reflow $

@@ -3607,22 +4046,67 @@ toRecordReport source context record startRow startCol =

36074046 \ that is a reserved word. Try using a different name!"

36084047 )

36094048

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+

36104088 _ ->

36114089 let

36124090 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

36134091 region = toRegion row col

36144092 in

3615− Report.Report "UNFINISHED RECORD" region [] $

4093+ Report.Report "PROBLEM IN RECORD" region [] $

36164094 Code.toSnippet source surroundings (Just region)

36174095 (

36184096 D.reflow $

3619− "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:"

36204098 ,

3621− addNoteForRecordError $

3622− D.reflow $

3623− "Trailing commas are not allowed in records, so I was expecting to see another\

3624− \ record field defined next. If you are done defining the record, the fix may\

3625− \ be to delete that last comma?"

4099+ D.stack

4100+ [ D.fillSep

4101+ ["I","was","expecting","to","see","another","record","field","defined","next,"

4102+ ,"so","I","am","looking","for","a","name","like"

4103+ ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."

4104+ ]

4105+ , D.toSimpleNote $

4106+ "Field names must start with a lower-case letter. After that, you can use\

4107+ \ any sequence of letters, numbers, and underscores."

4108+ , noteForRecordError

4109+ ]

36264110 )

36274111

36284112 RecordEquals row col ->

@@ -3630,17 +4114,19 @@ toRecordReport source context record startRow startCol =

36304114 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

36314115 region = toRegion row col

36324116 in

3633− Report.Report "UNFINISHED RECORD" region [] $

4117+ Report.Report "PROBLEM IN RECORD" region [] $

36344118 Code.toSnippet source surroundings (Just region)

36354119 (

36364120 D.reflow $

36374121 "I am partway through parsing a record, but I got stuck here:"

36384122 ,

3639− addNoteForRecordError $

3640− D.fillSep $

3641− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"

3642− ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"

3643− ]

4123+ D.stack

4124+ [ D.fillSep $

4125+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"

4126+ ,"an","equals","sign","next.","So","try","putting","an",D.green "=","sign","here?"

4127+ ]

4128+ , noteForRecordError

4129+ ]

36444130 )

36454131

36464132 RecordExpr expr row col ->

@@ -3660,29 +4146,54 @@ toRecordReport source context record startRow startCol =

36604146 D.reflow $

36614147 "I just saw the opening curly brace of a record, but then I got stuck here:"

36624148 ,

3663− addNoteForRecordIndentError $

3664− D.fillSep $

3665− ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."

3666− ,"Try","defining","some","fields","of","your","own?"

3667− ]

4149+ D.stack

4150+ [ D.fillSep $

4151+ ["I","am","expecting","a","record","like",D.dullyellow "{ x = 3, y = 4 }","here."

4152+ ,"Try","defining","some","fields","of","your","own?"

4153+ ]

4154+ , noteForRecordIndentError

4155+ ]

36684156 )

36694157

36704158 RecordIndentEnd row col ->

3671− let

3672− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

3673− region = toRegion row col

3674− in

3675− Report.Report "UNFINISHED RECORD" region [] $

3676− Code.toSnippet source surroundings (Just region)

3677− (

3678− D.reflow $

3679− "I was expecting to see a closing curly brace next:"

3680− ,

3681− addNoteForRecordIndentError $

3682− D.fillSep $

3683− ["Try","putting","an",D.green "}","and","see","if","that","helps?"

3684− ]

3685− )

4159+ case Code.nextLineStartsWithCloseCurly source row of

4160+ Just (curlyRow, curlyCol) ->

4161+ let

4162+ surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)

4163+ region = toRegion curlyRow curlyCol

4164+ in

4165+ Report.Report "NEED MORE INDENTATION" region [] $

4166+ Code.toSnippet source surroundings (Just region)

4167+ (

4168+ D.reflow $

4169+ "I was partway through parsing a record, but I got stuck here:"

4170+ ,

4171+ D.stack

4172+ [ D.reflow $

4173+ "I need this curly brace to be indented more. Try adding some spaces before it!"

4174+ , noteForRecordError

4175+ ]

4176+ )

4177+

4178+ Nothing ->

4179+ let

4180+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

4181+ region = toRegion row col

4182+ in

4183+ Report.Report "UNFINISHED RECORD" region [] $

4184+ Code.toSnippet source surroundings (Just region)

4185+ (

4186+ D.reflow $

4187+ "I was partway through parsing a record, but I got stuck here:"

4188+ ,

4189+ D.stack

4190+ [ D.fillSep $

4191+ ["I","was","expecting","to","see","a","closing","curly","brace","next."

4192+ ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"

4193+ ]

4194+ , noteForRecordIndentError

4195+ ]

4196+ )

36864197

36874198 RecordIndentField row col ->

36884199 let

@@ -3695,11 +4206,13 @@ toRecordReport source context record startRow startCol =

36954206 D.reflow $

36964207 "I am partway through parsing a record, but I got stuck after that last comma:"

36974208 ,

3698− addNoteForRecordError $

3699− D.reflow $

3700− "Trailing commas are not allowed in records, so the fix may be to\

3701− \ delete that last comma? Or maybe you were in the middle of defining\

3702− \ an additional field?"

4209+ D.stack

4210+ [ D.reflow $

4211+ "Trailing commas are not allowed in records, so the fix may be to\

4212+ \ delete that last comma? Or maybe you were in the middle of defining\

4213+ \ an additional field?"

4214+ , noteForRecordError

4215+ ]

37034216 )

37044217

37054218 RecordIndentEquals row col ->

@@ -3714,10 +4227,12 @@ toRecordReport source context record startRow startCol =

37144227 "I am partway through parsing a record. I just saw a record\

37154228 \ field, so I was expecting to see an equals sign next:"

37164229 ,

3717− addNoteForRecordIndentError $

3718− D.fillSep $

3719− ["Try","putting","an",D.green "=","followed","by","an","expression?"

3720− ]

4230+ D.stack

4231+ [ D.fillSep $

4232+ ["Try","putting","an",D.green "=","followed","by","an","expression?"

4233+ ]

4234+ , noteForRecordIndentError

4235+ ]

37214236 )

37224237

37234238 RecordIndentExpr row col ->

@@ -3731,52 +4246,48 @@ toRecordReport source context record startRow startCol =

37314246 D.reflow $

37324247 "I am partway through parsing a record, and I was expecting to run into an expression next:"

37334248 ,

3734− addNoteForRecordIndentError $

3735− D.fillSep $

3736− ["Try","putting","something","like"

3737− ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"

3738− ]

4249+ D.stack

4250+ [ D.fillSep $

4251+ ["Try","putting","something","like"

4252+ ,D.dullyellow "42","or",D.dullyellow"\"hello\"","for","now?"

4253+ ]

4254+ , noteForRecordIndentError

4255+ ]

37394256 )

37404257

37414258

3742−addNoteForRecordError :: D.Doc -> D.Doc

3743−addNoteForRecordError normalRecommendation =

4259+noteForRecordError :: D.Doc

4260+noteForRecordError =

37444261 D.stack $

3745− normalRecommendation

3746− :

37474262 [ D.toSimpleNote

37484263 "If you are trying to define a record across multiple lines, I recommend using this format:"

37494264 , D.indent 4 $ D.vcat $

3750− [ "{ name = \"Alice\""

3751− , ", age = 42"

3752− , ", height = 1.75"

4265+ [ "{ name = " <> D.dullyellow "\"Alice\""

4266+ , ", age = " <> D.dullyellow "42"

4267+ , ", height = " <> D.dullyellow "1.75"

37534268 , "}"

37544269 ]

37554270 , D.reflow $

3756− "Notice that each line starts with some indentation. Usually two or four spaces. I\

3757− \ know this style can be jarring for people coming from C-like syntax, but folks generally\

3758− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

4271+ "Notice that each line starts with some indentation. Usually two or four spaces.\

4272+ \ This is the stylistic convention in the Elm ecosystem."

37594273 ]

37604274

37614275

3762−addNoteForRecordIndentError :: D.Doc -> D.Doc

3763−addNoteForRecordIndentError normalRecommendation =

3764− D.stack $

3765− normalRecommendation

3766− :

4276+noteForRecordIndentError :: D.Doc

4277+noteForRecordIndentError =

4278+ D.stack

37674279 [ D.toSimpleNote

37684280 "I may be confused by indentation. For example, if you are trying to define\

37694281 \ a record across multiple lines, I recommend using this format:"

37704282 , D.indent 4 $ D.vcat $

3771− [ "{ name = \"Alice\""

3772− , ", age = 42"

3773− , ", height = 1.75"

4283+ [ "{ name = " <> D.dullyellow "\"Alice\""

4284+ , ", age = " <> D.dullyellow "42"

4285+ , ", height = " <> D.dullyellow "1.75"

37744286 , "}"

37754287 ]

37764288 , D.reflow $

3777− "Notice that each line starts with some indentation. Usually two or four spaces. I\

3778− \ know this style can be jarring for people coming from C-like syntax, but folks generally\

3779− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

4289+ "Notice that each line starts with some indentation. Usually two or four spaces.\

4290+ \ This is the stylistic convention in the Elm ecosystem!"

37804291 ]

37814292

37824293

@@ -3965,15 +4476,14 @@ toListReport source context list startRow startCol =

39654476 , D.toSimpleNote

39664477 "I recommend using the following format for lists that span multiple lines:"

39674478 , D.indent 4 $ D.vcat $

3968− [ "[ \"Alice\""

3969− , ", \"Bob\""

3970− , ", \"Chuck\""

4479+ [ "[ " <> D.dullyellow "\"Alice\""

4480+ , ", " <> D.dullyellow "\"Bob\""

4481+ , ", " <> D.dullyellow "\"Chuck\""

39714482 , "]"

39724483 ]

39734484 , D.reflow $

3974− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

3975− \ This style can be jarring for people coming from C-like syntax, but folks generally\

3976− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

4485+ "Notice that each line starts with some indentation. Usually two or four spaces.\

4486+ \ This is the stylistic convention in the Elm ecosystem."

39774487 ]

39784488 )

39794489

@@ -4026,15 +4536,14 @@ toListReport source context list startRow startCol =

40264536 "I may be confused by indentation. For example, if you are trying to define\

40274537 \ a list across multiple lines, I recommend using this format:"

40284538 , D.indent 4 $ D.vcat $

4029− [ "[ \"Alice\""

4030− , ", \"Bob\""

4031− , ", \"Chuck\""

4539+ [ "[ " <> D.dullyellow "\"Alice\""

4540+ , ", " <> D.dullyellow "\"Bob\""

4541+ , ", " <> D.dullyellow "\"Chuck\""

40324542 , "]"

40334543 ]

40344544 , D.reflow $

4035− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

4036− \ This style can be jarring for people coming from C-like syntax, but folks generally\

4037− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

4545+ "Notice that each line starts with some indentation. Usually two or four spaces.\

4546+ \ This is the stylistic convention in the Elm ecosystem."

40384547 ]

40394548 )

40404549

@@ -4058,15 +4567,14 @@ toListReport source context list startRow startCol =

40584567 "I may be confused by indentation. For example, if you are trying to define\

40594568 \ a list across multiple lines, I recommend using this format:"

40604569 , D.indent 4 $ D.vcat $

4061− [ "[ \"Alice\""

4062− , ", \"Bob\""

4063− , ", \"Chuck\""

4570+ [ "[ " <> D.dullyellow "\"Alice\""

4571+ , ", " <> D.dullyellow "\"Bob\""

4572+ , ", " <> D.dullyellow "\"Chuck\""

40644573 , "]"

40654574 ]

40664575 , D.reflow $

4067− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

4068− \ This style can be jarring for people coming from C-like syntax, but folks generally\

4069− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

4576+ "Notice that each line starts with some indentation. Usually two or four spaces.\

4577+ \ This is the stylistic convention in the Elm ecosystem."

40704578 ]

40714579 )

40724580

@@ -4087,15 +4595,14 @@ toListReport source context list startRow startCol =

40874595 , D.toSimpleNote

40884596 "I recommend using the following format for lists that span multiple lines:"

40894597 , D.indent 4 $ D.vcat $

4090− [ "[ \"Alice\""

4091− , ", \"Bob\""

4092− , ", \"Chuck\""

4598+ [ "[ " <> D.dullyellow "\"Alice\""

4599+ , ", " <> D.dullyellow "\"Bob\""

4600+ , ", " <> D.dullyellow "\"Chuck\""

40934601 , "]"

40944602 ]

40954603 , D.reflow $

4096− "Notice that nothing comes directly after a newline. Each line starts with some spaces.\

4097− \ This style can be jarring for people coming from C-like syntax, but folks generally\

4098− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

4604+ "Notice that each line starts with some indentation. Usually two or four spaces.\

4605+ \ This is the stylistic convention in the Elm ecosystem."

40994606 ]

41004607 )

41014608

@@ -4344,7 +4851,7 @@ toPatternReport source context pattern startRow startCol =

43444851 ,"((" <> D.dullyellow "x" <> "," <> D.dullyellow "y" <> ") " <> D.cyan "as" <> D.dullyellow " point" <> ")"

43454852 ,"so","you","can","refer","to","individual","parts","of","the","tuple","with"

43464853 ,D.dullyellow "x","and",D.dullyellow "y","or","you","refer","to","the","whole"

4347− ,"thing","with",D.dullyellow "point."

4854+ ,"thing","with",D.dullyellow "point" <> "."

43484855 ]

43494856 , D.reflow $

43504857 "So I was expecting to see a variable name after the `as` keyword here. Sometimes\

@@ -4536,7 +5043,7 @@ toPTupleReport source context tuple startRow startCol =

45365043 "I just saw an open parenthesis, but I got stuck here:"

45375044 ,

45385045 D.fillSep

4539− ["I","was","expecting","so","see","a","pattern","next."

5046+ ["I","was","expecting","to","see","a","pattern","next."

45405047 ,"Maybe","it","will","end","up","being","something"

45415048 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"

45425049 ]

@@ -4645,7 +5152,7 @@ toPTupleReport source context tuple startRow startCol =

46455152 "I just saw an open parenthesis, but then I got stuck here:"

46465153 ,

46475154 D.fillSep

4648− ["I","was","expecting","so","see","a","pattern","next."

5155+ ["I","was","expecting","to","see","a","pattern","next."

46495156 ,"Maybe","it","will","end","up","being","something"

46505157 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "?"

46515158 ]

@@ -4664,7 +5171,7 @@ toPTupleReport source context tuple startRow startCol =

46645171 ,

46655172 D.stack

46665173 [ D.fillSep

4667− ["I","was","expecting","so","see","a","pattern","next."

5174+ ["I","was","expecting","to","see","a","pattern","next."

46685175 ,"I","am","expecting","the","final","result","to","be","something"

46695176 ,"like",D.dullyellow "(x,y)","or",D.dullyellow "(name, _)" <> "."

46705177 ]

@@ -4968,22 +5475,64 @@ toTRecordReport source context record startRow startCol =

49685475 \ that is a reserved word. Try using a different name!"

49695476 )

49705477

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+

49715517 _ ->

49725518 let

49735519 surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

49745520 region = toRegion row col

49755521 in

4976− Report.Report "UNFINISHED RECORD TYPE" region [] $

5522+ Report.Report "PROBLEM IN RECORD TYPE" region [] $

49775523 Code.toSnippet source surroundings (Just region)

49785524 (

49795525 D.reflow $

4980− "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:"

49815527 ,

4982− addNoteForRecordTypeError $

4983− D.reflow $

4984− "Trailing commas are not allowed in records, so I was expecting to see another\

4985− \ record field defined next. If you are done defining the record, the fix may\

4986− \ be to delete that last comma?"

5528+ D.stack

5529+ [ D.fillSep

5530+ ["I","was","expecting","to","see","another","record","field","defined","next,"

5531+ ,"so","I","am","looking","for","a","name","like"

5532+ ,D.dullyellow "userName","or",D.dullyellow "plantHeight" <> "."

5533+ ]

5534+ , noteForRecordTypeError

5535+ ]

49875536 )

49885537

49895538 TRecordColon row col ->

@@ -4997,11 +5546,13 @@ toTRecordReport source context record startRow startCol =

49975546 D.reflow $

49985547 "I am partway through parsing a record type, but I got stuck here:"

49995548 ,

5000− addNoteForRecordTypeError $

5001− D.fillSep $

5002− ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"

5003− ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"

5004− ]

5549+ D.stack

5550+ [ D.fillSep $

5551+ ["I","just","saw","a","field","name,","so","I","was","expecting","to","see"

5552+ ,"a","colon","next.","So","try","putting","an",D.green ":","sign","here?"

5553+ ]

5554+ , noteForRecordTypeError

5555+ ]

50055556 )

50065557

50075558 TRecordType tipe row col ->

@@ -5021,29 +5572,54 @@ toTRecordReport source context record startRow startCol =

50215572 D.reflow $

50225573 "I just saw the opening curly brace of a record type, but then I got stuck here:"

50235574 ,

5024− addNoteForRecordTypeIndentError $

5025− D.fillSep $

5026− ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."

5027− ,"Try","defining","some","fields","of","your","own?"

5028− ]

5575+ D.stack

5576+ [ D.fillSep $

5577+ ["I","am","expecting","a","record","like",D.dullyellow "{ name : String, age : Int }","here."

5578+ ,"Try","defining","some","fields","of","your","own?"

5579+ ]

5580+ , noteForRecordTypeIndentError

5581+ ]

50295582 )

50305583

50315584 TRecordIndentEnd row col ->

5032− let

5033− surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

5034− region = toRegion row col

5035− in

5036− Report.Report "UNFINISHED RECORD TYPE" region [] $

5037− Code.toSnippet source surroundings (Just region)

5038− (

5039− D.reflow $

5040− "I was expecting to see a closing curly brace next:"

5041− ,

5042− addNoteForRecordTypeIndentError $

5043− D.fillSep $

5044− ["Try","putting","an",D.green "}","and","see","if","that","helps?"

5045− ]

5046− )

5585+ case Code.nextLineStartsWithCloseCurly source row of

5586+ Just (curlyRow, curlyCol) ->

5587+ let

5588+ surroundings = A.Region (A.Position startRow startCol) (A.Position curlyRow curlyCol)

5589+ region = toRegion curlyRow curlyCol

5590+ in

5591+ Report.Report "NEED MORE INDENTATION" region [] $

5592+ Code.toSnippet source surroundings (Just region)

5593+ (

5594+ D.reflow $

5595+ "I was partway through parsing a record type, but I got stuck here:"

5596+ ,

5597+ D.stack

5598+ [ D.reflow $

5599+ "I need this curly brace to be indented more. Try adding some spaces before it!"

5600+ , noteForRecordTypeError

5601+ ]

5602+ )

5603+

5604+ Nothing ->

5605+ let

5606+ surroundings = A.Region (A.Position startRow startCol) (A.Position row col)

5607+ region = toRegion row col

5608+ in

5609+ Report.Report "UNFINISHED RECORD TYPE" region [] $

5610+ Code.toSnippet source surroundings (Just region)

5611+ (

5612+ D.reflow $

5613+ "I was partway through parsing a record type, but I got stuck here:"

5614+ ,

5615+ D.stack

5616+ [ D.fillSep $

5617+ ["I","was","expecting","to","see","a","closing","curly","brace","next."

5618+ ,"Try","putting","a",D.green "}","next","and","see","if","that","helps?"

5619+ ]

5620+ , noteForRecordTypeIndentError

5621+ ]

5622+ )

50475623

50485624 TRecordIndentField row col ->

50495625 let

@@ -5056,11 +5632,13 @@ toTRecordReport source context record startRow startCol =

50565632 D.reflow $

50575633 "I am partway through parsing a record type, but I got stuck after that last comma:"

50585634 ,

5059− addNoteForRecordTypeIndentError $

5060− D.reflow $

5061− "Trailing commas are not allowed in record types, so the fix may be to\

5062− \ delete that last comma? Or maybe you were in the middle of defining\

5063− \ an additional field?"

5635+ D.stack

5636+ [ D.reflow $

5637+ "Trailing commas are not allowed in record types, so the fix may be to\

5638+ \ delete that last comma? Or maybe you were in the middle of defining\

5639+ \ an additional field?"

5640+ , noteForRecordTypeIndentError

5641+ ]

50645642 )

50655643

50665644 TRecordIndentColon row col ->

@@ -5075,10 +5653,12 @@ toTRecordReport source context record startRow startCol =

50755653 "I am partway through parsing a record type. I just saw a record\

50765654 \ field, so I was expecting to see a colon next:"

50775655 ,

5078− addNoteForRecordTypeIndentError $

5079− D.fillSep $

5080− ["Try","putting","an",D.green ":","followed","by","a","type?"

5081− ]

5656+ D.stack

5657+ [ D.fillSep $

5658+ ["Try","putting","an",D.green ":","followed","by","a","type?"

5659+ ]

5660+ , noteForRecordTypeIndentError

5661+ ]

50825662 )

50835663

50845664 TRecordIndentType row col ->

@@ -5092,19 +5672,19 @@ toTRecordReport source context record startRow startCol =

50925672 D.reflow $

50935673 "I am partway through parsing a record type, and I was expecting to run into a type next:"

50945674 ,

5095− addNoteForRecordTypeIndentError $

5096− D.fillSep $

5097− ["Try","putting","something","like"

5098− ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"

5099− ]

5675+ D.stack

5676+ [ D.fillSep $

5677+ ["Try","putting","something","like"

5678+ ,D.dullyellow "Int","or",D.dullyellow "String","for","now?"

5679+ ]

5680+ , noteForRecordTypeIndentError

5681+ ]

51005682 )

51015683

51025684

5103−addNoteForRecordTypeError :: D.Doc -> D.Doc

5104−addNoteForRecordTypeError normalRecommendation =

5685+noteForRecordTypeError :: D.Doc

5686+noteForRecordTypeError =

51055687 D.stack $

5106− normalRecommendation

5107− :

51085688 [ D.toSimpleNote

51095689 "If you are trying to define a record type across multiple lines, I recommend using this format:"

51105690 , D.indent 4 $ D.vcat $

@@ -5114,17 +5694,14 @@ addNoteForRecordTypeError normalRecommendation =

51145694 , "}"

51155695 ]

51165696 , D.reflow $

5117− "Notice that each line starts with some indentation. Usually two or four spaces. I\

5118− \ know this style can be jarring for people coming from C-like syntax, but folks generally\

5119− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

5697+ "Notice that each line starts with some indentation. Usually two or four spaces.\

5698+ \ This is the stylistic convention in the Elm ecosystem."

51205699 ]

51215700

51225701

5123−addNoteForRecordTypeIndentError :: D.Doc -> D.Doc

5124−addNoteForRecordTypeIndentError normalRecommendation =

5702+noteForRecordTypeIndentError :: D.Doc

5703+noteForRecordTypeIndentError =

51255704 D.stack $

5126− normalRecommendation

5127− :

51285705 [ D.toSimpleNote

51295706 "I may be confused by indentation. For example, if you are trying to define\

51305707 \ a record type across multiple lines, I recommend using this format:"

@@ -5135,9 +5712,8 @@ addNoteForRecordTypeIndentError normalRecommendation =

51355712 , "}"

51365713 ]

51375714 , D.reflow $

5138− "Notice that each line starts with some indentation. Usually two or four spaces. I\

5139− \ know this style can be jarring for people coming from C-like syntax, but folks generally\

5140− \ report that they are used to it (and often prefer it!) after a week or two of using Elm."

5715+ "Notice that each line starts with some indentation. Usually two or four spaces.\

5716+ \ This is the stylistic convention in the Elm ecosystem."

51415717 ]

51425718

51435719

@@ -5189,7 +5765,7 @@ toTTupleReport source context tuple startRow startCol =

51895765 Code.toSnippet source surroundings (Just region)

51905766 (

51915767 D.reflow $

5192− "I was expecting to see a closing parentheses next, but I got stuck here:"

5768+ "I was expecting to see a closing parenthesis next, but I got stuck here:"

51935769 ,

51945770 D.stack

51955771 [ D.fillSep ["Try","adding","a",D.dullyellow ")","to","see","if","that","helps?"]

compiler/src/Reporting/Error/Type.hs+44−23

@@ -231,7 +231,7 @@ toPatternReport source localizer patternRegion category tipe expected =

231231 "But all the previous patterns match:"

232232 [ D.link "Note"

233233 "A `case` expression can only handle one type of value, so you may want to use"

234− "union-types"

234+ "custom-types"

235235 "to handle “mixing” types."

236236 ]

237237 )

@@ -253,11 +253,11 @@ toPatternReport source localizer patternRegion category tipe expected =

253253 , patternTypeComparison localizer tipe expectedType

254254 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)

255255 "But all the previous patterns in the list are:"

256− [ D.toSimpleHint $

257− "Everything in the list needs to be the same type of value.\

258− \ This way you never run into unexpected values partway through.\

259− \ To mix different types in a single list, create a \"union type\" as\

260− \ described in: <http://guide.elm-lang.org/types/union_types.html>"

256+ [ D.link "Hint"

257+ "Everything in a list must be the same type of value. This way, we never\

258+ \ run into unexpected values partway through a List.map, List.foldl, etc. Read"

259+ "custom-types"

260+ "to learn how to “mix” types."

261261 ]

262262 )

263263

@@ -431,13 +431,14 @@ problemToHint problem =

431431 ]

432432 ]

433433

434− T.AnythingToList ->

435− [ D.toSimpleHint "Did you forget to add [] around it?"

434+ T.ArityMismatch x y ->

435+ [ D.toSimpleHint $

436+ if x < y then

437+ "It looks like it takes too few arguments. I was expecting " ++ show (y - x) ++ " more."

438+ else

439+ "It looks like it takes too many arguments. I see " ++ show (x - y) ++ " extra."

436440 ]

437441

438− T.MissingArgs _ -> []

439− T.ReturnMismatch -> []

440−

441442 T.BadFlexSuper direction super _ tipe ->

442443 case tipe of

443444 T.Lambda _ _ _ -> badFlexSuper direction super tipe

@@ -558,11 +559,31 @@ badFlexSuper :: T.Direction -> T.Super -> T.Type -> [D.Doc]

558559badFlexSuper direction super tipe =

559560 case super of

560561 T.Comparable ->

561− [ D.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable."

562− ]

562+ case tipe of

563+ T.Record _ _ ->

564+ [ D.link "Hint"

565+ "I do not know how to compare records. I can only compare ints, floats,\

566+ \ chars, strings, lists of comparable values, and tuples of comparable values.\

567+ \ Check out" "comparing-records" "for ideas on how to proceed."

568+ ]

569+

570+ T.Type _ name _ ->

571+ [ D.toSimpleHint $

572+ "I do not know how to compare `" ++ Name.toChars name ++ "` values. I can only\

573+ \ compare ints, floats, chars, strings, lists of comparable values, and tuples\

574+ \ of comparable values."

575+ , D.reflowLink

576+ "Check out" "comparing-custom-types" "for ideas on how to proceed."

577+ ]

578+

579+ _ ->

580+ [ D.toSimpleHint $

581+ "I only know how to compare ints, floats, chars, strings, lists of\

582+ \ comparable values, and tuples of comparable values."

583+ ]

563584

564585 T.Appendable ->

565− [ D.toSimpleHint "Only strings and lists are appendable."

586+ [ D.toSimpleHint "I only know how to append strings and lists."

566587 ]

567588

568589 T.CompAppend ->

@@ -689,11 +710,11 @@ toExprReport source localizer exprRegion category tipe expected =

689710 , "The " <> ith <> " element of this list does not match all the previous elements:"

690711 , "The " <> ith <> " element is"

691712 , "But all the previous elements in the list are:"

692− , [ D.toSimpleHint $

693− "Everything in the list needs to be the same type of value.\

694− \ This way you never run into unexpected values partway through.\

695− \ To mix different types in a single list, create a \"union type\" as\

696− \ described in: <http://guide.elm-lang.org/types/union_types.html>"

713+ , [ D.link "Hint"

714+ "Everything in a list must be the same type of value. This way, we never\

715+ \ run into unexpected values partway through a List.map, List.foldl, etc. Read"

716+ "custom-types"

717+ "to learn how to “mix” types."

697718 ]

698719 )

699720

@@ -740,7 +761,7 @@ toExprReport source localizer exprRegion category tipe expected =

740761 , [ D.link "Hint"

741762 "All branches in an `if` must produce the same type of values. This way, no\

742763 \ matter which branch we take, the result is always a consistent shape. Read"

743− "union-types"

764+ "custom-types"

744765 "to learn how to “mix” types."

745766 ]

746767 )

@@ -755,7 +776,7 @@ toExprReport source localizer exprRegion category tipe expected =

755776 , [ D.link "Hint"

756777 "All branches in a `case` must produce the same type of values. This way, no\

757778 \ matter which branch we take, the result is always a consistent shape. Read"

758− "union-types"

779+ "custom-types"

759780 "to learn how to “mix” types."

760781 ]

761782 )

@@ -1072,7 +1093,7 @@ opRightToDocs localizer category op tipe expected =

10721093 ( D.reflow $ "I cannot send this through the (<|) pipe:"

10731094 , typeComparison localizer tipe expected

10741095 "The argument is:"

1075− "But (<|) is piping it a function that expects:"

1096+ "But (<|) is piping it to a function that expects:"

10761097 []

10771098 )

10781099

@@ -1083,7 +1104,7 @@ opRightToDocs localizer category op tipe expected =

10831104 ( D.reflow $ "This function cannot handle the argument sent through the (|>) pipe:"

10841105 , typeComparison localizer argType expectedArgType

10851106 "The argument is:"

1086− "But (|>) is piping it a function that expects:"

1107+ "But (|>) is piping it to a function that expects:"

10871108 []

10881109 )

10891110

compiler/src/Reporting/Render/Code.hs+67−26

@@ -7,6 +7,8 @@ module Reporting.Render.Code

77 , toPair

88 , Next(..)

99 , whatIsNext

10+ , nextLineStartsWithKeyword

11+ , nextLineStartsWithCloseCurly

1012 )

1113 where

1214

@@ -120,7 +122,7 @@ makeUnderline width realEndLine (A.Region (A.Position start c1) (A.Position end

120122 spaces = replicate (fromIntegral c1 + width + 1) ' '

121123 zigzag = replicate (max 1 (fromIntegral (c2 - c1))) '^'

122124 in

123− Just (D.fromChars spaces <> D.dullred (D.fromChars zigzag))

125+ Just (D.fromChars spaces <> D.red (D.fromChars zigzag))

124126

125127

126128drawLines :: Bool -> Int -> A.Region -> [(Word16, String)] -> Doc -> Doc

@@ -146,7 +148,7 @@ addLineNumber addZigZag width start end n line =

146148

147149 spacer =

148150 if addZigZag && start <= n && n <= end then

149− D.dullred ">"

151+ D.red ">"

150152 else

151153 " "

152154 in

@@ -181,8 +183,8 @@ renderPair source@(Source sourceLines) region1 region2 =

181183 OneLine $

182184 D.vcat

183185 [ D.fromChars lineNumber <> "| " <> D.fromChars line

184− , D.fromChars spaces1 <> D.dullred (D.fromChars zigzag1) <>

185− D.fromChars spaces2 <> D.dullred (D.fromChars zigzag2)

186+ , D.fromChars spaces1 <> D.red (D.fromChars zigzag1) <>

187+ D.fromChars spaces2 <> D.red (D.fromChars zigzag2)

186188 ]

187189

188190 else

@@ -199,35 +201,46 @@ data Next

199201 = Keyword [Char]

200202 | Operator [Char]

201203 | Close [Char] Char

202− | Other

204+ | Upper Char [Char]

205+ | Lower Char [Char]

206+ | Other (Maybe Char)

203207

204208

205209whatIsNext :: Source -> Row -> Col -> Next

206210whatIsNext (Source sourceLines) row col =

207211 case List.lookup row sourceLines of

208212 Nothing ->

209− Other

213+ Other Nothing

210214

211215 Just line ->

212− let

213− chars = drop (fromIntegral col - 1) line

214− keywords = map Name.toChars (Set.toList reservedWords)

215− in

216− case List.find (startsWithKeyword chars) keywords of

217− Just keyword ->

218− Keyword keyword

219−

220− Nothing ->

221− case chars of

222− [] ->

223− Other

224−

225− c:cs

226− | isSymbol c -> Operator (c : takeWhile isSymbol cs)

227− | c == ')' -> Close "parenthesis" ')'

228− | c == ']' -> Close "square bracket" ']'

229− | c == '}' -> Close "curly brace" '}'

230− | otherwise -> Other

216+ case drop (fromIntegral col - 1) line of

217+ [] ->

218+ Other Nothing

219+

220+ c:cs

221+ | Char.isUpper c -> Upper c (takeWhile isInner cs)

222+ | Char.isLower c -> detectKeywords c cs

223+ | isSymbol c -> Operator (c : takeWhile isSymbol cs)

224+ | c == ')' -> Close "parenthesis" ')'

225+ | c == ']' -> Close "square bracket" ']'

226+ | c == '}' -> Close "curly brace" '}'

227+ | otherwise -> Other (Just c)

228+

229+

230+detectKeywords :: Char -> [Char] -> Next

231+detectKeywords c rest =

232+ let

233+ cs = takeWhile isInner rest

234+ name = c : cs

235+ in

236+ if Set.member (Name.fromChars name) reservedWords

237+ then Keyword name

238+ else Lower c name

239+

240+

241+isInner :: Char -> Bool

242+isInner char =

243+ Char.isAlphaNum char || char == '_'

231244

232245

233246isSymbol :: Char -> Bool

@@ -244,4 +257,32 @@ startsWithKeyword restOfLine keyword =

244257 True

245258

246259 c:_ ->

247− not (Char.isAlphaNum c || c == '_')

260+ not (isInner c)

261+

262+

263+nextLineStartsWithKeyword :: [Char] -> Source -> Row -> Maybe (Row, Col)

264+nextLineStartsWithKeyword keyword (Source sourceLines) row =

265+ case List.lookup (row + 1) sourceLines of

266+ Nothing ->

267+ Nothing

268+

269+ Just line ->

270+ if startsWithKeyword (dropWhile (==' ') line) keyword then

271+ Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))

272+ else

273+ Nothing

274+

275+

276+nextLineStartsWithCloseCurly :: Source -> Row -> Maybe (Row, Col)

277+nextLineStartsWithCloseCurly (Source sourceLines) row =

278+ case List.lookup (row + 1) sourceLines of

279+ Nothing ->

280+ Nothing

281+

282+ Just line ->

283+ case dropWhile (==' ') line of

284+ '}':_ ->

285+ Just (row + 1, 1 + fromIntegral (length (takeWhile (==' ') line)))

286+

287+ _ ->

288+ Nothing

compiler/src/Reporting/Render/Type/Localizer.hs+5−25

@@ -7,8 +7,6 @@ module Reporting.Render.Type.Localizer

77 , empty

88 , fromNames

99 , fromModule

10− , replEmpty

11− , replAdd

1210 )

1311 where

1412

@@ -18,7 +16,6 @@ import qualified Data.Name as Name

1816import qualified Data.Set as Set

1917

2018import qualified AST.Source as Src

21−import qualified Elm.Compiler.Imports as Imports

2219import qualified Elm.ModuleName as ModuleName

2320import Reporting.Doc ((<>))

2421import qualified Reporting.Doc as D

@@ -115,26 +112,9 @@ toExposing exposing =

115112 Only (foldr addType Set.empty exposedList)

116113

117114

118−addType :: A.Located Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name

119−addType (A.At _ exposed) types =

115+addType :: Src.Exposed -> Set.Set Name.Name -> Set.Set Name.Name

116+addType exposed types =

120117 case exposed of

121− Src.Lower _ -> types

122− Src.Upper name _ -> Set.insert name types

123− Src.Operator _ -> types

124−

125−

126−

127−-- REPL STUFF

128−

129−

130−replEmpty :: Localizer

131−replEmpty =

132− Localizer $

133− Map.insert Name.replModule (Import Nothing All) $

134− Map.fromList $ map toPair Imports.defaults

135−

136−

137−replAdd :: Name.Name -> Maybe Name.Name -> Src.Exposing -> Localizer -> Localizer

138−replAdd name alias exposing (Localizer localizer) =

139− Localizer $ Map.insert name (Import alias (toExposing exposing)) localizer

140−

118+ Src.Lower _ -> types

119+ Src.Upper (A.At _ name) _ -> Set.insert name types

120+ Src.Operator _ _ -> types

compiler/src/Reporting/Result.hs+9−1

@@ -118,4 +118,12 @@ instance Monad (Result i w e) where

118118 in

119119 ka i w bad good1

120120

121− -- TODO PERF add more specialized definitions?

121+ (>>) (Result ka) (Result kb) =

122+ Result $ \i w bad good ->

123+ let

124+ good1 i1 w1 _ =

125+ kb i1 w1 bad good

126+ in

127+ ka i w bad good1

128+

129+ -- PERF add INLINE to these?

compiler/src/Type/Error.hs+14−123

@@ -175,9 +175,7 @@ data Problem

175175 | StringToFloat

176176 | AnythingToBool

177177 | AnythingFromMaybe

178− | AnythingToList

179− | MissingArgs Int

180− | ReturnMismatch

178+ | ArityMismatch Int Int

181179 | BadFlexSuper Direction Super Name.Name Type

182180 | BadRigidVar Name.Name Type

183181 | BadRigidSuper Super Name.Name Type

@@ -255,7 +253,11 @@ toDiff localizer ctx tipe1 tipe2 =

255253 <*> toDiff localizer RT.Func b y

256254 <*> sequenceA (zipWith (toDiff localizer RT.Func) cs zs)

257255 else

258− diffLambda localizer ctx a b cs x y zs

256+ let f = toDoc localizer RT.Func in

257+ different

258+ (D.dullyellow (RT.lambda ctx (f a) (f b) (map f cs)))

259+ (D.dullyellow (RT.lambda ctx (f x) (f y) (map f zs)))

260+ (Bag.one (ArityMismatch (2 + length cs) (2 + length zs)))

259261

260262 (Tuple a b Nothing, Tuple x y Nothing) ->

261263 RT.tuple

@@ -298,7 +300,7 @@ toDiff localizer ctx tipe1 tipe2 =

298300 different

299301 (toDoc localizer ctx t1)

300302 (RT.apply ctx (D.dullyellow (L.toDoc localizer home name)) [toDoc localizer RT.App t2])

301− (Bag.one AnythingToList)

303+ Bag.empty

302304

303305 (Alias home1 name1 args1 t1, t2) ->

304306 case diffAliasedRecord localizer t1 t2 of

@@ -447,6 +449,13 @@ isSuper super tipe =

447449 Appendable -> isString h n || isList h n

448450 CompAppend -> isString h n || isList h n && isSuper Comparable (head args)

449451

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+

450459 _ ->

451460 False

452461

@@ -477,124 +486,6 @@ diffAliasedRecord localizer t1 t2 =

477486

478487

479488

480−-- DIFF LAMBDAS

481−

482−

483−--

484−-- INVARIANTS:

485−-- length cs1 /= length cs2

486−--

487−diffLambda :: L.Localizer -> RT.Context -> Type -> Type -> [Type] -> Type -> Type -> [Type] -> Diff D.Doc

488−diffLambda localizer ctx a1 b1 cs1 a2 b2 cs2 =

489− let

490− (result1:revArgs1) = reverse (a1:b1:cs1)

491− (result2:revArgs2) = reverse (a2:b2:cs2)

492−

493− numArgs1 = length revArgs1

494− numArgs2 = length revArgs2

495− in

496− case toDiff localizer RT.Func result1 result2 of

497− Diff resultDoc1 resultDoc2 Similar ->

498− if numArgs1 < numArgs2 then

499− diffArgMismatch localizer ctx revArgs1 resultDoc1 revArgs2 resultDoc2

500−

501− else

502− diffArgMismatch localizer ctx revArgs2 resultDoc2 revArgs1 resultDoc1

503−

504− Diff resultDoc1 resultDoc2 (Different problems) ->

505− let

506− (a:b:cs) = reverse (resultDoc1 : map (toDoc localizer RT.Func) revArgs1)

507− (x:y:zs) = reverse (resultDoc2 : map (toDoc localizer RT.Func) revArgs2)

508− in

509− different

510− (D.dullyellow (RT.lambda ctx a b cs))

511− (D.dullyellow (RT.lambda ctx x y zs))

512− (Bag.append problems (Bag.one ReturnMismatch))

513−

514−

515−--

516−-- INVARIANTS:

517−-- length shortRevArgs >= 2

518−-- length longRevArgs >= 2

519−-- length shortRevArgs < length longRevArgs

520−--

521−diffArgMismatch :: L.Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc

522−diffArgMismatch localizer ctx shortRevArgs shortResult longRevArgs longResult =

523− let

524− (a:b:cs, x:y:zs) =

525− case toGreedyMatch localizer shortRevArgs longRevArgs of

526− Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->

527− ( reverse (shortResult:shortRevArgDocs)

528− , reverse (longResult:longRevArgDocs)

529− )

530−

531− Nothing ->

532− case toGreedyMatch localizer (reverse shortRevArgs) (reverse longRevArgs) of

533− Just (GreedyMatch shortArgDocs longArgDocs) ->

534− ( shortArgDocs ++ [shortResult]

535− , longArgDocs ++ [longResult]

536− )

537−

538− Nothing ->

539− let

540− toYellowDoc tipe =

541− D.dullyellow (toDoc localizer RT.Func tipe)

542− in

543− ( reverse (shortResult : map toYellowDoc shortRevArgs)

544− , reverse (longResult : map toYellowDoc longRevArgs )

545− )

546− in

547− different

548− (RT.lambda ctx a b cs)

549− (RT.lambda ctx x y zs)

550− (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))

551−

552−

553−

554−-- GREEDY ARG MATCHER

555−

556−

557−data GreedyMatch =

558− GreedyMatch [D.Doc] [D.Doc]

559−

560−

561−--

562−-- INVARIANTS:

563−-- length shorterArgs < length longerArgs

564−--

565−toGreedyMatch :: L.Localizer -> [Type] -> [Type] -> Maybe GreedyMatch

566−toGreedyMatch localizer shorterArgs longerArgs =

567− toGreedyMatchHelp localizer shorterArgs longerArgs (GreedyMatch [] [])

568−

569−

570−toGreedyMatchHelp :: L.Localizer -> [Type] -> [Type] -> GreedyMatch -> Maybe GreedyMatch

571−toGreedyMatchHelp localizer shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) =

572− let

573− toYellowDoc tipe =

574− D.dullyellow (toDoc localizer RT.Func tipe)

575− in

576− case (shorterArgs, longerArgs) of

577− (x:xs, y:ys) ->

578− case toDiff localizer RT.Func x y of

579− Diff a b Similar ->

580− toGreedyMatchHelp localizer xs ys $

581− GreedyMatch (a:shorterDocs) (b:longerDocs)

582−

583− Diff _ _ (Different _) ->

584− toGreedyMatchHelp localizer shorterArgs ys $

585− GreedyMatch shorterDocs (toYellowDoc y : longerDocs)

586−

587− ([], []) ->

588− Just match

589−

590− ([], _:_) ->

591− Just (GreedyMatch shorterDocs (map toYellowDoc longerArgs))

592−

593− (_:_, []) ->

594− Nothing

595−

596−

597−

598489-- RECORD DIFFS

599490

600491

compiler/src/Type/Solve.hs+7

@@ -427,6 +427,13 @@ typeToVariable rank pools tipe =

427427 typeToVar rank pools Map.empty tipe

428428

429429

430+-- PERF working with @mgriffith we noticed that a 784 line entry in a `let` was

431+-- causing a ~1.5 second slowdown. Moving it to the top-level to be a function

432+-- saved all that time. The slowdown seems to manifest in `typeToVar` and in

433+-- `register` in particular. Have not explored further yet. Top-level definitions

434+-- are recommended in cases like this anyway, so there is at least a safety

435+-- valve for now.

436+--

430437typeToVar :: Int -> Pools -> Map.Map Name.Name Variable -> Type -> IO Variable

431438typeToVar rank pools aliasDict tipe =

432439 let go = typeToVar rank pools aliasDict in

compiler/src/Type/Unify.hs+5−11

@@ -90,7 +90,6 @@ instance Applicative Unify where

9090

9191

9292instance Monad Unify where

93− -- TODO PERF add INLINE here?

9493 return a =

9594 Unify $ \vars ok _ ->

9695 ok vars a

@@ -220,8 +219,6 @@ unifyFlex context content otherContent =

220219 Error ->

221220 merge context Error

222221

223− -- TODO see if wildcarding makes a noticable perf difference

224−

225222 FlexVar maybeName ->

226223 merge context $

227224 case maybeName of

@@ -394,13 +391,13 @@ unifyFlexSuperStructure context super flatType =

394391

395392 Comparable ->

396393 do comparableOccursCheck context

397− merge context (Structure flatType)

398394 unifyComparableRecursive variable

395+ merge context (Structure flatType)

399396

400397 CompAppend ->

401398 do comparableOccursCheck context

402− merge context (Structure flatType)

403399 unifyComparableRecursive variable

400+ merge context (Structure flatType)

404401

405402 Tuple1 a b maybeC ->

406403 case super of

@@ -412,15 +409,12 @@ unifyFlexSuperStructure context super flatType =

412409

413410 Comparable ->

414411 do comparableOccursCheck context

415− merge context (Structure flatType)

416412 unifyComparableRecursive a

417413 unifyComparableRecursive b

418414 case maybeC of

419− Nothing ->

420− return ()

421−

422− Just c ->

423− unifyComparableRecursive c

415+ Nothing -> return ()

416+ Just c -> unifyComparableRecursive c

417+ merge context (Structure flatType)

424418

425419 CompAppend ->

426420 mismatch

docs/elm.json/application.md+2−2

@@ -8,7 +8,7 @@ This is a decent baseline for pretty much any applications made with Elm. You wi

88 "source-directories": [

99 "src"

1010 ],

11− "elm-version": "0.19.0",

11+ "elm-version": "0.19.1",

1212 "dependencies": {

1313 "direct": {

1414 "elm/browser": "1.0.0",

@@ -48,7 +48,7 @@ A list of directories where Elm code lives. Most projects just use `"src"` for e

4848

4949## `"elm-version"`

5050

51−The exact version of Elm this builds with. Should be `"0.19.0"` for most people!

51+The exact version of Elm this builds with. Should be `"0.19.1"` for most people!

5252

5353<br>

5454

docs/elm.json/package.md+1−1

@@ -49,7 +49,7 @@ A short summary that will appear on [`package.elm-lang.org`](https://package.elm

4949

5050## `"license"`

5151

52−An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, but you can see the full list of options [here](https://spdx.org/licenses/).

52+An OSI approved SPDX code like `"BSD-3-Clause"` or `"MIT"`. These are the two most common licenses in the Elm ecosystem, and BSD-3-Clause is a good default. But you can see the full list of options [here](https://spdx.org/licenses/).

5353

5454<br>

5555

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

docs/upgrade-instructions/0.19.1.mdnew file+60

@@ -0,0 +1,60 @@

1+# Upgrading to 0.19.1

2+

3+**There are no language changes**, so once you swap to `"elm-version": "0.19.1"` in your `elm.json`, most users should be able to proceed without any further code changes. **You may run into a handful of bugfixes though!** These cases are outlined below!

4+

5+

6+<br>

7+

8+## Improvements

9+

10+- Parse error message quality (like [this](https://github.com/elm/error-message-catalog/issues/255) and [this](https://github.com/elm/error-message-catalog/issues/225))

11+- Faster compilation, especially for incremental compiles

12+- Uses filelocks so that cached files are not corrupted when plugins run `elm make` multiple times on the same project at the same time. (Still worth avoiding that though!)

13+- More intuitive multiline declarations in REPL

14+- Various bug fixes (e.g. `--debug`, `x /= 0`, `type Height = Height Float` in `--optimize`)

15+

16+

17+<br>

18+

19+## Detectable Bug Fixes

20+

21+There are three known cases where code that compiled with 0.19.0 will not compile with 0.19.1 due to bug fixes:

22+

23+

24+### 1. Ambiguous Imports

25+

26+Say you have an import like this:

27+

28+```elm

29+import Html exposing (min)

30+import Regex exposing (never)

31+

32+x = min

33+y = never

34+```

35+

36+These should be reported as ambiguous usages since the names are also exposed by `Basics`, but there was a regression in 0.19.0 described [here](https://github.com/elm/compiler/issues/1945) such that they weren't caught in specific circumstances.

37+

38+The fix is to use a qualified name like `Html.min` or `Regex.never` to make it unambiguous.

39+

40+We found a couple instances of this in packages and have submitted PRs to the relevant authors in August 2019. You may run into this in your own code as well.

41+

42+For more details on why this is considered a regression, check out the details [here](https://github.com/elm/compiler/issues/1945#issuecomment-507871919) or try it in 0.18.0 to see how it worked before.

43+

44+

45+### 2. Tabs in Comments

46+

47+The 0.19.0 binaries did not catch tab characters in comments. The new parser is better at checking for tabs, so it will object when it finds these.

48+

49+Again, we found this in some packages and reached out to the relevant authors with PRs so patches would be published before the 0.19.1 release.

50+

51+

52+### 3. Port Module with no Ports

53+

54+If you have any files that start with:

55+

56+```elm

57+port module Main exposing (..)

58+```

59+

60+But they do not actually have any `port` declarations, the 0.19.1 binary will ask you to switch to a normal module declaration like `module Main exposing (..)`

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

The content is the same.

elm.cabal+25−11

@@ -38,11 +38,14 @@ Executable elm

3838 if flag(dev)

3939 ghc-options: -O0 -Wall -Werror

4040 else

41− ghc-options: -O2 -rtsopts -threaded "-with-rtsopts=-N -qg"

41+ ghc-options: -O2 -rtsopts -threaded "-with-rtsopts=-N -qg -A128m"

42+ -- add -eventlog for (elm make src/Main.elm +RTS -l; threadscope elm.eventlog)

43+ -- https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/

4244

4345 Hs-Source-Dirs:

4446 compiler/src

4547 builder/src

48+ terminal/impl

4649 terminal/src

4750

4851 other-extensions:

@@ -52,26 +55,38 @@ Executable elm

5255 Main.hs

5356

5457 other-modules:

55− Develop.StaticFiles

56− Develop.StaticFiles.Build

58+ Bump

59+ Develop

60+ Diff

5761 Init

5862 Install

5963 Make

64+ Publish

65+ Repl

6066

6167 -- terminal args

62− Terminal.Args

63− Terminal.Args.Chomp

64− Terminal.Args.Error

65− Terminal.Args.Helpers

66− Terminal.Args.Internal

68+ Terminal

69+ Terminal.Chomp

70+ Terminal.Error

71+ Terminal.Helpers

72+ Terminal.Internal

73+

74+ -- from terminal/

75+ Develop.Generate.Help

76+ Develop.Generate.Index

77+ Develop.StaticFiles

78+ Develop.StaticFiles.Build

6779

6880 -- from builder/

6981 Build

70− Deps.Registry

82+ BackgroundWriter

83+ Deps.Bump

7184 Deps.Diff

85+ Deps.Registry

7286 Deps.Solver

7387 Deps.Website

7488 File

89+ Generate

7590 Http

7691 Reporting

7792 Reporting.Exit

@@ -150,7 +165,6 @@ Executable elm

150165 Parse.Module

151166 Parse.Number

152167 Parse.Pattern

153− Parse.Repl

154168 Parse.Shader

155169 Parse.Space

156170 Parse.String

@@ -217,7 +231,7 @@ Executable elm

217231 snap-core,

218232 snap-server,

219233 template-haskell,

220− time,

234+ time >= 1.9.1,

221235 unordered-containers,

222236 utf8-string,

223237 vector,

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) — Defining values in Elm is slightly different than defining values in languages like JavaScript.

7+

8+ 2. [**Tricky Recursion**](#tricky-recursion) — 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** — we can refer to `Html.text`, `Html.h1`, etc.

25+ - **Types** — 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** — How can we send as few bits as possible?

7+2. **Performance** — 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/Dockerfilenew file+39

@@ -0,0 +1,39 @@

1+# Based initially on https://gist.github.com/rlefevre/1523f47e75310e28eee243c9c5651ac9

2+#

3+# Build Linux x64 binary from elm compiler top-level directory:

4+# $ docker build -t elm -f installers/linux/Dockerfile .

5+#

6+# Retrieve elm Linux binary:

7+# $ docker cp $(docker create elm):/usr/local/bin/elm DESTINATION_DIRECTORY

8+#

9+# Delete docker elm image:

10+# $ docker rmi elm

11+#

12+# Display all images:

13+# $ docker images -a

14+#

15+# Delete all unused docker images:

16+# $ docker system prune -a

17+

18+# Use Alpine 3.11 with GHC 8.6.5

19+FROM alpine:3.11

20+

21+# Install packages required to build elm

22+RUN apk add --no-cache ghc cabal wget musl-dev zlib-dev zlib-static ncurses-dev ncurses-static

23+

24+WORKDIR /elm

25+

26+# Import source code

27+COPY builder builder

28+COPY compiler compiler

29+COPY reactor reactor

30+COPY terminal terminal

31+COPY cabal.config elm.cabal LICENSE ./

32+

33+# Build statically linked elm binary

34+RUN cabal new-update

35+RUN cabal new-build --ghc-option=-optl=-static --ghc-option=-split-sections

36+RUN cp ./dist-newstyle/build/x86_64-linux/ghc-*/elm-*/x/elm/build/elm/elm /usr/local/bin/elm

37+

38+# Remove debug symbols to optimize the binary size

39+RUN strip -s /usr/local/bin/elm

installers/linux/README.mdnew file+93

@@ -0,0 +1,93 @@

1+# Install Instructions

2+

3+The pre-compiled binary for Linux works on a very wide range of distributions.

4+

5+It should be possible to install it by running the following commands in your terminal:

6+

7+```bash

8+# Move to your Desktop so you can see what is going on easier.

9+#

10+cd ~/Desktop/

11+

12+# Download the 0.19.1 binary for Linux.

13+#

14+# +-----------+----------------------+

15+# | FLAG | MEANING |

16+# +-----------+----------------------+

17+# | -L | follow redirects |

18+# | -o elm.gz | name the file elm.gz |

19+# +-----------+----------------------+

20+#

21+curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz

22+

23+# There should now be a file named `elm.gz` on your Desktop.

24+#

25+# The downloaded file is compressed to make it faster to download.

26+# This next command decompresses it, replacing `elm.gz` with `elm`.

27+#

28+gunzip elm.gz

29+

30+# There should now be a file named `elm` on your Desktop!

31+#

32+# Every file has "permissions" about whether it can be read, written, or executed.

33+# So before we use this file, we need to mark this file as executable:

34+#

35+chmod +x elm

36+

37+# The `elm` file is now executable. That means running `~/Desktop/elm --help`

38+# should work. Saying `./elm --help` works the same.

39+#

40+# But we want to be able to say `elm --help` without specifying the full file

41+# path every time. We can do this by moving the `elm` binary to one of the

42+# directories listed in your `PATH` environment variable:

43+#

44+sudo mv elm /usr/local/bin/

45+

46+# Now it should be possible to run the `elm` binary just by saying its name!

47+#

48+elm --help

49+```

50+

51+<br/>

52+

53+## Wait, what is the `PATH` variable?

54+

55+When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.

56+

57+The `PATH` is the list of directories that get searched. You can see these directories by running:

58+

59+```bash

60+echo $PATH

61+```

62+

63+This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.

64+

65+When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.

66+

67+So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.

68+

69+So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.

70+

71+**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.

72+

73+

74+<br/>

75+

76+## Uninstall

77+

78+The following commands should remove everything:

79+

80+```bash

81+# Remove the `elm` executable.

82+#

83+sudo rm /usr/local/bin/elm

84+

85+# Remove any cached files. The files here reduce compile times when

86+# starting new projects and make it possible to work offline in more

87+# cases. No need to keep it around if you are uninstalling though!

88+#

89+rm -r ~/.elm/

90+```

91+

92+If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.

93+

installers/mac/Distribution.xml+5−3

@@ -1,6 +1,6 @@

11<?xml version="1.0" encoding="utf-8" standalone="no"?>

22<installer-script minSpecVersion="1.000000" authoringTool="com.apple.PackageMaker" authoringToolVersion="3.0.6" authoringToolBuild="201">

3− <title>Elm Platform</title>

3+ <title>Elm</title>

44 <options customize="allow" allow-external-scripts="no"/>

55 <domains enable_localSystem="true"/>

66 <volume-check script="pm_volume_check();"/>

@@ -10,7 +10,7 @@

1010function pm_volume_check() {

1111 if(!(my.target.systemVersion && /* >= */ system.compareVersions(my.target.systemVersion.ProductVersion, '10.6.0') >= 0)) {

1212 my.result.title = 'Failure';

13− my.result.message = 'This version of Elm Platform requires Mac OS X 10.6 or later.';

13+ my.result.message = 'This version of Elm requires Mac OS X 10.6 or later.';

1414 my.result.type = 'Fatal';

1515 return false;

1616 }

@@ -18,13 +18,15 @@ function pm_volume_check() {

1818}

1919

2020</script>

21+ <!--

2122 <background file="background.png" alignment="bottomleft" scaling="none" mime-type="image/png"/>

23+ -->

2224 <welcome mime-type="text/rtf" file="welcome.rtf" />

2325 <conclusion mime-type="text/rtf" file="conclusion.rtf" />

2426 <choices-outline>

2527 <line choice="choice2"/>

2628 </choices-outline>

27− <choice id="choice2" title="Elm Platform ">

29+ <choice id="choice2" title="Elm">

2830 <pkg-ref id="org.elm-lang.binaries.pkg"/>

2931 </choice>

3032 <pkg-ref id="org.elm-lang.binaries.pkg" installKBytes="19444" version="1" auth="Root">binaries.pkg</pkg-ref>

installers/mac/README.mdnew file+93

@@ -0,0 +1,93 @@

1+# Install Instructions

2+

3+The easiest way to install is to to use [the Mac installer](https://github.com/elm/compiler/releases/download/0.19.1/installer-for-mac.pkg)!

4+

5+But it is also possible to install by running the following commands in your terminal:

6+

7+```bash

8+# Move to your Desktop so you can see what is going on easier.

9+#

10+cd ~/Desktop/

11+

12+# Download the 0.19.1 binary for Linux.

13+#

14+# +-----------+----------------------+

15+# | FLAG | MEANING |

16+# +-----------+----------------------+

17+# | -L | follow redirects |

18+# | -o elm.gz | name the file elm.gz |

19+# +-----------+----------------------+

20+#

21+curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-mac-64-bit.gz

22+

23+# There should now be a file named `elm.gz` on your Desktop.

24+#

25+# The downloaded file is compressed to make it faster to download.

26+# This next command decompresses it, replacing `elm.gz` with `elm`.

27+#

28+gunzip elm.gz

29+

30+# There should now be a file named `elm` on your Desktop!

31+#

32+# Every file has "permissions" about whether it can be read, written, or executed.

33+# So before we use this file, we need to mark this file as executable:

34+#

35+chmod +x elm

36+

37+# The `elm` file is now executable. That means running `~/Desktop/elm --help`

38+# should work. Saying `./elm --help` works the same.

39+#

40+# But we want to be able to say `elm --help` without specifying the full file

41+# path every time. We can do this by moving the `elm` binary to one of the

42+# directories listed in your `PATH` environment variable:

43+#

44+sudo mv elm /usr/local/bin/

45+

46+# Now it should be possible to run the `elm` binary just by saying its name!

47+#

48+elm --help

49+```

50+

51+<br/>

52+

53+## What is the `PATH` variable?

54+

55+When you run a command like `elm make src/Main.elm`, your computer starts by trying to find an executable file called `elm`.

56+

57+The `PATH` is the list of directories that get searched. You can see these directories by running:

58+

59+```bash

60+echo $PATH

61+```

62+

63+This prints `/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin` on my computer. The directories are separated by a `:` so there are five possibilities listed here.

64+

65+When I run `elm make src/Main.elm`, my terminal starts by searching these five directories for an executable file named `elm`. It finds `/usr/local/bin/elm` and then runs `/usr/local/bin/elm make src/Main.elm` with whatever arguments I gave.

66+

67+So the `PATH` environment variable is a convention that allows you to refer to a specific executable file without knowing exactly where it lives on your computer. This is actually how all "terminal commands" work! Commands like `ls` are really executable files that live in directories listed in your `PATH` variable.

68+

69+So the point of running `sudo mv elm /usr/local/bin/` is to turn the `elm` binary into a terminal command, allowing us to call it just like `ls` and `cd`.

70+

71+**Note:** Why do we need to use `sudo` for that one command? Imagine if some program was able to add executables named `ls` or `cd` to `/usr/local/bin` that did something tricky and unexpected. That would be a security problem! Many distributions make this scenario less likely by requiring special permissions to modify the `/usr/local/bin/` directory.

72+

73+

74+<br/>

75+

76+## Uninstall

77+

78+The following commands should remove everything:

79+

80+```bash

81+# Remove the `elm` executable.

82+#

83+sudo rm /usr/local/bin/elm

84+

85+# Remove any cached files. The files here reduce compile times when

86+# starting new projects and make it possible to work offline in more

87+# cases. No need to keep it around if you are uninstalling though!

88+#

89+rm -r ~/.elm/

90+```

91+

92+If you have any Elm projects still on your computer, you can remove their `elm-stuff/` directories as well.

93+

installers/mac/Resources/en.lproj/background.pngdeleted

Binary file not shown.

installers/mac/Resources/en.lproj/conclusion.rtf+13−6

@@ -1,9 +1,16 @@

1−{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400

2−{\fonttbl\f0\fswiss\fcharset0 Helvetica;}

1+{\rtf1\ansi\ansicpg1252\cocoartf2509

2+\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}

33{\colortbl;\red255\green255\blue255;}

4−\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0

5−\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural

4+{\*\expandedcolortbl;;}

5+\paperw11900\paperh16840\margl1440\margr1440\vieww11180\viewh8400\viewkind0

6+\pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\pardirnatural\partightenfactor0

67

7−\f0\fs26 \cf0 A bunch of useful programs were just placed in /usr/local/bin/\

8+\f0\fs28 \cf0 Try opening the terminal and running commands like:\

89\

9−Check out {\field{\*\fldinst HYPERLINK "http://elm-lang.org/Get-Started.elm"}{\fldrslt this tutorial}} to learn how to use them!}

10+

11+\f1 elm init\

12+elm make src/Main.elm --optimize\

13+elm repl

14+\f0 \

15+\

16+Check out {\field{\*\fldinst{HYPERLINK "https://guide.elm-lang.org/"}}{\fldrslt this tutorial}} for more advice!}

installers/mac/Resources/en.lproj/welcome.rtf+9−4

@@ -1,7 +1,12 @@

1−{\rtf1\ansi\ansicpg1252\cocoartf1187\cocoasubrtf400

2−{\fonttbl\f0\fswiss\fcharset0 Helvetica;}

1+{\rtf1\ansi\ansicpg1252\cocoartf2509

2+\cocoatextscaling0\cocoaplatform0{\fonttbl\f0\fswiss\fcharset0 Helvetica;\f1\fmodern\fcharset0 CourierNewPSMT;}

33{\colortbl;\red255\green255\blue255;}

4+{\*\expandedcolortbl;;}

45\paperw11900\paperh16840\margl1440\margr1440\vieww10800\viewh8400\viewkind0

5−\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural

6+\pard\tx566\tx1133\tx1700\tx2267\tx2834\tx3401\tx3968\tx4535\tx5102\tx5669\tx6236\tx6803\pardirnatural\partightenfactor0

67

7−\f0\fs28 \cf0 This package will install Elm on your machine.}

8+\f0\fs28 \cf0 Thank you for trying out Elm!\

9+\

10+This installer makes

11+\f1 elm

12+\f0 available in your terminal.}

installers/mac/helper-scripts/elm-startup.sh+1−1

@@ -1,3 +1,3 @@

11#!/bin/sh

22

3−open 'http://elm-lang.org'

3+open 'http://guide.elm-lang.org'

installers/mac/make-installer.sh+30−3

@@ -29,7 +29,8 @@ cp $(pwd)/preinstall $pkg_scripts

2929cp $(pwd)/postinstall $pkg_scripts

3030

3131pkgbuild \

32− --identifier org.elm-lang.binaries.pkg \

32+ --sign "Developer ID Installer: <NAME>" \

33+ --identifier org.elm-lang.binary \

3334 --install-location $usr_binaries \

3435 --scripts $pkg_scripts \

3536 --filter 'Scripts.*' \

@@ -39,16 +40,42 @@ pkgbuild \

3940

4041#### BUNDLE ASSETS ####

4142

42−rm -f Elm.pkg

43+rm -f installer-for-mac.pkg

4344

4445productbuild \

46+ --sign "Developer ID Installer: <NAME>" \

47+ --identifier org.elm-lang.installer \

4548 --distribution Distribution.xml \

4649 --package-path . \

4750 --resources Resources \

48− Elm.pkg

51+ installer-for-mac.pkg

4952

5053

5154#### CLEAN UP ####

5255

5356rm binaries.pkg

5457rm -rf $pkg_root

58+

59+

60+#### BEGIN NOTARIZATION ####

61+

62+xcrun altool \

63+ --notarize-app \

64+ --primary-bundle-id "org.elm-lang.installer" \

65+ --username "<EMAIL>" \

66+ --password "@keychain:Developer-altool" \

67+ --file "installer-for-mac.pkg"

68+

69+# From https://scriptingosx.com/2019/09/notarize-a-command-line-tool/

70+#

71+#### Check on notarization:

72+#

73+# xcrun altool \

74+# --notarization-info "<RequestUUID>" \

75+# --username "<EMAIL>" \

76+# --password "@keychain:Developer-altool"

77+#

78+#

79+#### Staple Notarization:

80+#

81+# xcrun stapler staple installer-for-mac.pkg

installers/npm/PUBLISHING.md+29−141

@@ -1,171 +1,59 @@

1−# Publishing a new release

1+# Publishing

22

3−A new version of Elm came out. Huzzah! Here's how to update the `npm` installer.

3+Here's how to update the `npm` installer.

44

5−## 1. Create tarballs of binaries

65

7−You can find a list of what binaries we'll need to tar up in `index.js`.

6+## 1. GitHub Release

87

9−For example:

8+Create a [GitHub Release](https://github.com/elm/compiler/releases) with the following files:

109

11−```javascript

12−var root =

13− "https://github.com/elm/compiler/releases/download/" +

14− binVersion +

15− "/binaries-for-";

10+1. `binary-for-mac-64-bit.gz`

11+2. `binary-for-windows-64-bit.gz`

12+3. `binary-for-linux-64-bit.gz`

1613

17−module.exports = binwrap({

18− binaries: ["elm"],

19− urls: {

20− "darwin-x64": root + "mac.tar.gz",

21− "win32-x64": root + "windows.tar.gz",

22− "win32-ia32": root + "windows.tar.gz",

23− "linux-x64": root + "linux.tar.gz"

24− }

25−});

26−```

27−

28−If this is the end of your `index.js`, you'll need to create these files:

14+Create each of these by running the `elm` executable for each platform through `gzip elm`.

2915

30−1. `binaries-for-mac.tar.gz`

31−2. `binaries-for-windows.tar.gz`

32−3. `binaries-for-linux.tar.gz`

3316

34−Each of these tarballs should have **only the Elm binary** inside them - no

35−directories!

17+## 2. Try a beta release

3618

37−So create them by making a directory, putting all the binaries in it, `cd`-ing

38−into that directory, and then running something like this:

19+In `package.json`, bump the version to `"0.19.2-beta"`.

3920

40−```shell

41−$ tar cvzf binaries-for-linux.tar.gz elm

21+```bash

22+npm publish --tag beta

4223```

4324

44−Make sure each tarball contains all the binaries listed in that `binaries:` list

45−in `index.js`. (The Windows ones should have `.exe` at the end; `binwrap`

46−expects that they will, for Windows only.)

47−

48−## 2. Update the `bin/` binary wrappers

49−

50−Inside the npm installer's `bin/` directory, there should be a file for each of

51−the binaries that will be included in this release.

52−

53−Each of these must be executable! If you're not sure whether they are,

54−run `chmod +x` on them just to be sure.

55−

56−Their paths must also must all be listed in `package.json` in two places:

57−

58−1. The `"files":` field

59−2. The `"bin":` field

60−

61−If the executables are the same as they were for the last release, great!

62−You can proceed to the next step. If any binaries were removed, make sure to

63−remove them from these lists!

64−

65−## 3. Update `package.json` for a beta release

66−

67−In `package.json`, bump the version to the next applicable release, and add

68−a `"-beta"` suffix to it.

69−

70−For example, if it was on `"0.18.0"` you might bump it to `"0.19.0-beta"`.

71−The version number should match the release of Elm, such that if people do

72−`npm install elm@0.19.0@beta` they get what they would expect.

73−

74−## 4. Tag the beta release

75−

76−Commit this change and tag it with the name of the release **without** the

77−`-beta` suffix. (We will overwrite this tag later.)

78−

79−For example:

25+To test that it works, run these commands:

8026

81−```shell

82−$ git tag 0.19.0

83−$ git push origin 0.19.0

27+```bash

28+npm dist-tags ls elm

29+npm install elm@beta --ignore-scripts

8430```

8531

86−Now this tag should exist on GitHub, allowing us to upload binaries to it.

32+The `latest` tag should not be changed, and there should be an additional `beta` tag.

8733

88−## 5. Upload binaries

34+Try this on Windows, Linux, and Mac.

8935

90−Visit the [Create a New Release](https://github.com/elm-lang/elm-platform/releases/new)

91−page and use the `Tag version` dropdown to select the tag you just pushed. Give

92−it a title like `0.19.0`. Don't mention the `-beta` in it. The "beta" concept

93−is for `npm` only.

9436

95−Upload the tarballs you created in step 1.

37+## 3. Publish final release

9638

97−## 6. Publish beta release

39+Remove the `-beta` suffix from the version in `package.json`. Then run:

9840

99−Run this to publish the beta release. The `--tag beta` is **crucial** here.

100−Without it, `npm` will by default publish a new top-level release, which would

101−mean that what you just published would become what everyone gets when they

102−`npm install -g elm` without any additional qualifiers.

103−

104−```shell

105−$ npm publish --tag beta

41+```bash

42+npm publish

10643```

10744

108−Afterwards you should be able to do `npm info elm | less` and see something

109−like this in the JSON:

110−

111−```

112−'dist-tags': { latest: '0.18.0', beta: '0.19.0-beta' }

113−```

11445

115−If you messed this up, and the `latest` tag now points to the beta you just

116−published, don't panic - it's fixable! `dist-tags` can always be modified after

117−the fact. Read up on `npm` [dist-tags](https://docs.npmjs.com/cli/dist-tag)

118−to learn how to fix things.

46+## 4. Tag the `latest-0.19.1` version

11947

120−## 7. Verify beta installer

48+Many compiler releases have needed multiple `npm` publications. Maybe something does not work on Windows or some dependency becomes insecure. Normal `npm` problems.

12149

122−Make an empty directory and run `npm init` inside it.

50+The convention for each Elm release is to create a tag the latest one.

12351

124−Then run this:

125−

126−```shell

127−$ npm install elm@beta --ignore-scripts

52+```bash

53+npm dist-tag add elm@0.19.1-3 latest-0.19.1

12854```

12955

130−This should succeed with an exit code of `0`.

131−If it did, look in `node_modules/.bin/` for the binaries you expect.

132−They should be present, and they should also work as expected when you run them.

133−Because you installed them with `--ignore-scripts`, the first thing they should

134−do is to download themselves and then execute whatever command you requested

135−(e.g. `node_modules/.bin/elm make Main.elm`). If you run the same command a

136−second time, it should run faster because it doesn't have to download the binary

137−first.

138−

139−Now try it again with `--ignore-scripts` turned off:

140−

141−```shell

142−$ rm -r node_modules

143−$ npm install elm@beta --ignore-scripts=false

144−```

145−

146−This time it should download the binaries during the installation phase. Once

147−again you should be able to run the binaries from `node_modules/.bin/`, and

148−this time they should be fast from the first run because they're already

149−downloaded.

150−

151−## 8. Publish for real

152−

153−It's a good idea to ask others to try out the beta installer before doing this!

154−Especially on multiple operating systems.

155−

156−To publish the real version:

157−

158−1. Edit `package.json` to remove the `-beta` suffix from the version.

159−2. Commit that change and push it.

160−3. Use `git tag --force` to overwrite the previous tag (e.g. `0.19.0` - whatever you used before).

161−4. Force push the tag, e.g. `git push origin 0.19.0 --force-with-lease`.

162−5. `npm publish`

56+That way people who want a specific version can point to `latest-0.19.1` or `latest-0.18.0` instead of knowing the particular names of all the various publications.

16357

164−You're done! Now whenever anyone does `npm install -g elm` they'll get the

165−version you just uploaded.

58+You can read more about dist-tags [here](https://docs.npmjs.com/cli/dist-tag).

16659

167−The reason we only used the `-beta` suffix for `npm` was so that when we ran

168−tests on the beta version, it was all against the same (non-beta) URLs we'd end

169−up using for the real version. This means there's no opportunity for us to

170−introduce some sort of mismatch between the beta that we verified and the real

171−version.

installers/npm/README.md+30−23

@@ -1,38 +1,45 @@

1−npm install elm [![Travis build Status](https://travis-ci.org/elm-lang/elm-platform.svg?branch=master)](http://travis-ci.org/elm-lang/elm-platform) [![AppVeyor build status](https://ci.appveyor.com/api/projects/status/6mcub79i04ianpm9/branch/master?svg=true)](https://ci.appveyor.com/project/rtfeldman/elm-platform/branch/master)

2−===============

1+# Elm Installer

32

4−Install the [Elm Platform](https://github.com/elm-lang/elm-platform) via [`npm`](https://www.npmjs.com).

3+[Elm](https://elm-lang.org) is a functional programming language that compiles to JavaScript.

54

6−## Installing

5+Head over to [The Official Guide](https://guide.elm-lang.org/) to start learning Elm!

76

8−Run this to get the binaries:

97

10−```

11−$ npm install -g elm

12−```

8+<br/>

139

14−## Installing behind a proxy server

10+## What is this package for?

1511

16−If you are behind a proxy server, set the environment variable "HTTPS_PROXY".

12+**Normal installs** ❌

1713

18−```

19−$ export HTTPS_PROXY=$YourProxyServer$

20−$ npm install -g elm

21−```

14+Use the instructions [here](https://guide.elm-lang.org/install/elm.html) instead.

15+

16+**Multiple versions** ✅

17+

18+People using Elm at work may use different versions of Elm in different projects. They can run `npm install elm@latest-0.19.1` in each project and use the binary at `./node_modules/.bin/elm` for compilation.

19+

20+**Continuous integration** ⚠️

21+

22+This works, but there are usually faster and more reliable options:

23+

24+1. You can download `elm` directly from GitHub with [this script](https://github.com/elm/compiler/blob/master/installers/linux/README.md). This is all the `npm` installer does, but with extra HTTP requests to `npmjs.com` servers, making it slower and adding more failure points.

25+2. Many continuous integration have ways to cache files ([example](https://docs.travis-ci.com/user/caching/)) to make builds faster and more reliable.

26+

27+That said, it will definitely work to use the `npm` installer on CI if you prefer that option.

28+

29+

30+<br/>

31+

32+## Install Locally

2233

23−Or on Windows:

34+The following command should download the latest Elm 0.19.1 binary:

2435

2536```

26−$ set HTTPS_PROXY=$YourProxyServer$

27−$ npm install -g elm

37+npm install elm@latest-0.19.1

2838```

2939

30−## Troubleshooting

40+You should be able to run `./node_modules/bin/elm --version` within your project and see `0.19.1`. Now you can compile with `./node_modules/bin/elm make src/Main.elm` and not disrupt other packages.

3141

32−1. [Troubleshooting npm](https://github.com/npm/npm/wiki/Troubleshooting)

33−2. On Debian/Ubuntu systems, you may have to install the nodejs-legacy package: `apt-get install nodejs-legacy`.

34−3. If the installer says that it cannot find any usable binaries for your operating system and architecture, check the [Build from Source](https://github.com/elm-lang/elm-platform/blob/master/README.md#build-from-source) documentation.

42+Use `npm install elm@latest-0.19.0` or `npm install elm@latest-0.18.0` for earlier versions.

3543

36−## Getting Started

44+**Note:** The `latest-X.Y.Z` convention is used in case we need to publish patches for the `npm` installer within a given Elm release. For example, say `npm` decides that some transitive dependency is not secure. Nothing is changing about Elm or the binaries, but we need to publish a new `npm` installer that fixes this issue.

3745

38−Once everything has installed successfully, head over to the [Get Started](http://elm-lang.org/Get-Started.elm) page!

installers/npm/bin/elm+42−16

@@ -1,28 +1,54 @@

11#!/usr/bin/env node

22

33var child_process = require('child_process');

4−var download = require('../download.js');

4+var path = require('path');

55var fs = require('fs');

66

77

8−// Some npm users enable --ignore-scripts (a good security measure)

8+// Some npm users enable --ignore-scripts (a good security measure) so

9+// they do not run the post-install hook and install.js does not run.

10+// Instead they will run this script.

911//

10−// They do not run the post-install hook, so install.js does not run.

12+// On Mac and Linux, we download the elm executable into the exact same

13+// location as this file. Since npm uses symlinks on these platforms,

14+// that means that the first run will invoke this file and subsequent

15+// runs will call the elm binary directly.

1116//

12−// This file pretends to be the downloaded binary. It then downloads

13−// the real binary over itself. So in that case, the first run would

14−// also make an HTTPS request to fetch the real binary.

17+// On Windows, we must download a file named elm.exe for it to run properly.

18+// Instead of symlinks, npm creates two files:

19+//

20+// - node_modules/.bin/elm (a bash file)

21+// - node_modules/.bin/elm.cmd (a batch file)

22+//

23+// Both files specifically invoke `node` to run the file listed at package.bin,

24+// so there is no way around instantiating node for no reason on Windows. So

25+// the existsSync check is needed so that it is not downloaded more than once.

1526

1627

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+}

1745

18−// Make sure we get the right path even if we're executing from the symlinked

19−// node_modules/.bin/ executable

20−var pathToThisFile = fs.realpathSync(process.argv[1]);

2146

22−download(pathToThisFile, function() {

23− // Need double quotes and { shell: true } when there are spaces in the path on windows:

24− // https://github.com/nodejs/node/issues/7367#issuecomment-229721296

25− child_process

26− .spawn('"' + pathToThisFile + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })

27− .on('exit', process.exit);

28−});

47+function runCommand()

48+{

49+ // Need double quotes and { shell: true } when there are spaces in the path on windows:

50+ // https://github.com/nodejs/node/issues/7367#issuecomment-229721296

51+ child_process

52+ .spawn('"' + binaryPath + '"', process.argv.slice(2), { stdio: 'inherit', shell: true })

53+ .on('exit', process.exit);

54+}

installers/npm/download.js+68−67

@@ -1,7 +1,7 @@

11var fs = require('fs');

22var package = require('./package.json');

3−var URL = require('url').URL;

4−var https = require('https');

3+var path = require('path');

4+var request = require('request');

55var zlib = require('zlib');

66

77

@@ -12,87 +12,72 @@ var zlib = require('zlib');

1212// called when --ignore-scripts is enabled. That's why install.js is so weird.

1313

1414

15−module.exports = function(destinationPath, callback)

15+module.exports = function(callback)

1616{

17+ // figure out URL of binary

1718 var version = package.version.replace(/^(\d+\.\d+\.\d+).*$/, '$1'); // turn '1.2.3-alpha' into '1.2.3'

18− var os = { 'darwin': 'mac', 'win32': 'windows', 'linux': 'linux' }[process.platform];

19− var arch = { 'x64': '64-bit', 'ia32': '32-bit' }[process.arch];

2019

21− download(

22− process.platform === 'win32' ? destinationPath + '.exe' : destinationPath,

23− 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + os + '-' + arch + '.gz',

24− callback

25− );

26−};

20+ var platform = {

21+ darwin_x64: 'mac-64-bit',

22+ darwin_arm64: 'mac-64-bit',

23+ win32_x64: 'windows-64-bit',

24+ linux_x64: 'linux-64-bit'

25+ }[process.platform + '_' + process.arch];

2726

27+ verifyPlatform(version, platform);

2828

29+ var url = 'https://github.com/elm/compiler/releases/download/' + version + '/binary-for-' + platform + '.gz';

2930

30−// DOWNLOAD

31+ reportDownload(version, url);

3132

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' : '');

3235

33−function download(destinationPath, url, callback)

34−{

35− requestWithRedirects(url, 10,

36− function(error) {

37− exitFailure(url, 'I ran into trouble while fetching ' + url + '\n\n' + error);

38− },

39− function(response) {

40− if (response.statusCode == 404)

41− {

42− exitFailure(url, 'I got a "404 Not Found" trying to download from the following URL:\n'

43− + url

44− + '\n\nThis may mean you are trying to install on an unsupported platform. (e.g. some 32-bit systems?)'

45− );

46− }

47−

48− response.on('error', function() {

49− exitFailure(url, 'Something went wrong while receiving the following URL:\n\n' + url);

50− });

51−

52− var gunzip = zlib.createGunzip().on('error', function(error) {

53− exitFailure(url, 'I ran into trouble decompressing the downloaded binary. It is saying:\n\n' + error);

54− });

55− var write = fs.createWriteStream(destinationPath, {

56− encoding: 'binary',

57− mode: 0o755

58− }).on('finish', callback).on('error', function(error) {

59− exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);

60− });

61−

62− response.pipe(gunzip).pipe(write);

63− }

64− );

36+ // set up handler for request failure

37+ function reportDownloadFailure(error)

38+ {

39+ exitFailure(url,'Something went wrong while fetching the following URL:\n\n' + url + '\n\nIt is saying:\n\n' + error);

40+ }

41+

42+ // set up decompression pipe

43+ var gunzip = zlib.createGunzip().on('error', function(error) {

44+ exitFailure(url, 'I ran into trouble decompressing the downloaded binary. It is saying:\n\n' + error);

45+ });

46+

47+ // set up file write pipe

48+ var write = fs.createWriteStream(binaryPath, {

49+ encoding: 'binary',

50+ mode: 0o755

51+ }).on('finish', callback).on('error', function(error) {

52+ exitFailure(url, 'I had some trouble writing file to disk. It is saying:\n\n' + error);

53+ });

54+

55+ // put it all together

56+ request(url).on('error', reportDownloadFailure).pipe(gunzip).pipe(write);

6557}

6658

6759

6860

69−// HANDLE REDIRECTS

61+// VERIFY PLATFORM

7062

7163

72−function requestWithRedirects(url, maxRedirects, failure, success)

64+function verifyPlatform(version, platform)

7365{

74− var req = https.request(url);

75−

76− req.on('response', function(response) {

77− // Check for redirects

78−

79− var redirectUrl = new URL(response.headers['location'], new URL(url).origin).href;

80−

81− if (typeof redirectUrl === 'string' && response.statusCode >= 300 && response.statusCode < 400)

82− {

83− return (maxRedirects <= 0)

84− ? failure(new Error('followed 10 redirects and gave up'))

85− : requestWithRedirects(redirectUrl, maxRedirects - 1, failure, success);

86− }

87− else

88− {

89− return success(response);

90− }

91− });

92−

93− req.on('error', failure);

66+ if (platform) return;

9467

95− 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);

9681}

9782

9883

@@ -111,3 +96,19 @@ function exitFailure(url, message)

11196 );

11297 process.exit(1);

11398}

99+

100+

101+

102+// REPORT DOWNLOAD

103+

104+

105+function reportDownload(version, url)

106+{

107+ console.log(

108+ '--------------------------------------------------------------------------------\n\n'

109+ + 'Downloading Elm ' + version + ' from GitHub.'

110+ + '\n\nNOTE: You can avoid npm entirely by downloading directly from:\n'

111+ + url + '\nAll this package does is download that file and put it somewhere.\n\n'

112+ + '--------------------------------------------------------------------------------\n'

113+ );

114+}

installers/npm/install.js+1−7

@@ -1,10 +1,4 @@

11

22var download = require('./download.js');

3−var package = require('./package.json');

4−var path = require('path');

53

6−

7−// get slashes right for Windows

8−var targetPath = path.resolve(__dirname, Object.values(package.bin)[0]);

9−

10−download(targetPath, function() {});

4+download(function() {});

installers/npm/package.json+6−7

@@ -1,6 +1,6 @@

11{

22 "name": "elm",

3− "version": "0.19.0-no-deps",

3+ "version": "0.19.1-5",

44 "description": "Installer for Elm: just downloads the binary into node_modules",

55 "preferGlobal": true,

66 "license": "BSD-3-Clause",

@@ -11,9 +11,9 @@

1111 "homepage": "https://github.com/elm/compiler/tree/master/installers/npm",

1212 "bugs": "https://github.com/elm/compiler/issues",

1313 "author": {

14− "name": "Richard Feldman",

15− "email": "richard.t.feldman@gmail.com",

16− "url": "https://github.com/rtfeldman"

14+ "name": "Evan Czaplicki",

15+ "email": "evan@elm-lang.org",

16+ "url": "https://github.com/evancz"

1717 },

1818 "engines": {

1919 "node": ">=7.0.0"

@@ -35,9 +35,8 @@

3535 "install",

3636 "installer"

3737 ],

38− "bin": {

39− "elm": "bin/elm"

40− },

38+ "bin": { "elm": "bin/elm" },

4139 "dependencies": {

40+ "request": "^2.88.0"

4241 }

4342}

installers/npm/troubleshooting.mdnew file+76

@@ -0,0 +1,76 @@

1+# Troubleshooting

2+

3+I very highly recommend asking for help on [the Elm slack](https://elmlang.herokuapp.com).

4+

5+There are a lot of things that can go wrong when installing software, and it can really help to have a second pair of eyes on your situation!

6+

7+This document goes through a couple options that may help you out.

8+

9+<br/>

10+

11+

12+## Can you skip npm entirely?

13+

14+The most reliable way to get Elm installed using the official installers for Mac and Windows [here][download].

15+

16+You can also download the binaries directly. On Linux, you could do it in the terminal like this:

17+

18+```bash

19+cd ~/Desktop/

20+curl -L -o elm.gz https://github.com/elm/compiler/releases/download/0.19.1/binary-for-linux-64-bit.gz

21+gunzip elm.gz # unzip the file

22+chmod +x elm # make the file executable

23+sudo mv elm /usr/local/bin/ # put the executable in a directory likely to be listed in your PATH variable

24+```

25+

26+If these exact commands do not work for you, you can try to do the same thing by hand.

27+

28+Read the section below on `PATH` variables if you are not sure what that is!

29+

30+[download]: https://github.com/elm/compiler/releases/tag/0.19.1

31+

32+<br/>

33+

34+

35+## Do you need to use npm for some reason?

36+

37+The company running npm has a list of common troubleshooting situations [here](https://npm.community/c/support/troubleshooting), but it may be better to just try to find your specific case on Stack Overflow. Often there are permissions issues where you may need to use `sudo` with some command.

38+

39+### Firewalls

40+

41+Some companies have a firewall.

42+

43+These companies usually have set the `HTTP_PROXY` or `HTTPS_PROXY` environment variable on your computer. This is more common with Windows computers.

44+

45+The result is that the request for `https://github.com/elm/compiler/releases/download/0.19.1/binary-for-windows-64-bit.gz` is being sent to a "proxy server" where they monitor traffic. Maybe they rule out certain domains, maybe they check data when it comes back from the actual URL, etc.

46+

47+It is probably best to ask someone about the situation on this, but you can test things out by temporarily using an alternate `HTTPS_PROXY` value with something like this:

48+

49+```

50+# Mac and Linux

51+HTTPS_PROXY=http://proxy.example.com npm install -g elm

52+

53+# Windows

54+set HTTPS_PROXY=http://proxy.example.com

55+npm install -g elm

56+```

57+

58+Check out [this document](https://www.npmjs.com/package/request#controlling-proxy-behaviour-using-environment-variables) for more information on how environment variables like `NO_PROXY`, `HTTP_PROXY`, and `HTTPS_PROXY` are handled by the npm.

59+

60+<br/>

61+

62+

63+## Do you know what a `PATH` variable is?

64+

65+When you run a command like `elm make src/Main.elm`, your computer starts by trying to find a file called `elm`.

66+

67+The `PATH` is a list of directories to search within. On Mac and Linux, you can see these directories by running:

68+

69+```

70+$ echo $PATH

71+/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/local/git/bin

72+```

73+

74+The are separated by `:` for some reason. So running `elm make src/Main.elm` starts by searching the `PATH` for files named `elm`. On my computer, it finds `/usr/local/bin/elm` and then can actually run the command.

75+

76+Is `elm` in one of the directories listed in your `PATH` variable? I recommend asking for help if you are in this scenario and unsure how to proceed.

installers/win/Nsisfile.nsi+16−16

@@ -75,7 +75,7 @@ Function un.onInit

7575FunctionEnd

7676

7777Function LaunchLink

78− ExecShell "open" "http://elm-lang.org/get-started"

78+ ExecShell "open" "https://guide.elm-lang.org"

7979FunctionEnd

8080

8181;--------------------------------

@@ -135,20 +135,20 @@ SectionEnd

135135

136136SectionGroup "Update system settings" SecGr

137137

138−Section "Associate with .elm files" SecAssoc

139−

140− SectionIn 1

141−

142− ; File associations

143− WriteRegStr HKCR ".elm" "" "elm"

144− WriteRegStr HKCR "elm" "" "Elm Source File"

145− WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"

146− ;WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'

147−

148− ;Remember that we registered associations

149− WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1

150−

151−SectionEnd

138+;Section "Associate with .elm files" SecAssoc

139+;

140+; SectionIn 1

141+;

142+; ; File associations

143+; WriteRegStr HKCR ".elm" "" "elm"

144+; WriteRegStr HKCR "elm" "" "Elm Source File"

145+; WriteRegStr HKCR "elm\DefaultIcon" "" "$INSTDIR\file.ico"

146+; WriteRegStr HKCR "elm\shell\open\command" "" '"$INSTDIR\bin\elm.exe" "%1"'

147+;

148+; ;Remember that we registered associations

149+; WriteRegDWORD HKLM "${PRODUCT_DIR_REG_KEY}" Assocs 0x1

150+;

151+;SectionEnd

152152

153153Section "Update the PATH environment variable" SecPath

154154

@@ -261,4 +261,4 @@ Section "Uninstall"

261261 ; Update environment variables

262262 SendMessage ${HWND_BROADCAST} ${WM_SETTINGCHANGE} 0 "STR:Environment" /TIMEOUT=5000

263263

264−SectionEnd

264+SectionEnd

installers/win/README.md+18−3

@@ -1,9 +1,24 @@

1−# Building Windows installer

1+# Installing on Windows

2+

3+The installer for Windows is available [here](https://guide.elm-lang.org/install.html).

4+

5+

6+<br/>

7+

8+## Uninstall

9+

10+First run the `C:\Program Files (x86)\Elm\0.19\uninstall.exe` file. This will remove Elm stuff from your `PATH`.

11+

12+Then remove the whole `C:\Users\<username>\AppData\Roaming\elm` directory. Elm caches some packages and build artifacts to reduce compile times and to help you work offline. Getting rid of this directory will clear that information out!

13+

14+<br/>

15+

16+## Building the Windows installer

217

318You will need the [NSIS installer](http://nsis.sourceforge.net/Download) to be installed.

419

520Once everything is installed, run something like this command:

621

7− make_installer.cmd 0.19

22+ make_installer.cmd 0.19.0

823

9−It will build an installer called `Elm-0.19-setup.exe`.

24+It will build an installer called `Elm-0.19.0-setup.exe`.

installers/win/file.icodeleted

Binary file not shown.

installers/win/inst.dat+1−2

@@ -2,6 +2,5 @@ SetOutPath "$INSTDIR\bin"

22File "${FILES_SOURCE_PATH}\bin\elm.exe"

33

44SetOutPath "$INSTDIR"

5−File "file.ico"

65File "updatepath.vbs"

7−File "removefrompath.vbs"

6+File "removefrompath.vbs"

installers/win/logo.ico

Binary file not shown.

installers/win/uninst.dat+1−2

@@ -1,7 +1,6 @@

11Delete "$INSTDIR\bin\elm.exe"

22RmDir "$INSTDIR\bin"

33

4−Delete "$INSTDIR\file.ico"

54Delete "$INSTDIR\updatepath.vbs"

65Delete "$INSTDIR\removefrompath.vbs"

7−RmDir "$INSTDIR"

6+RmDir "$INSTDIR"

installers/win/welcome.bmp

Binary file not shown.

reactor/assets/waiting.gifdeleted

Binary file not shown.

reactor/elm.json+2−2

@@ -3,7 +3,7 @@

33 "source-directories": [

44 "src"

55 ],

6− "elm-version": "0.19.0",

6+ "elm-version": "0.19.1",

77 "dependencies": {

88 "direct": {

99 "elm/browser": "1.0.1",

@@ -28,4 +28,4 @@

2828 "direct": {},

2929 "indirect": {}

3030 }

31−}

31+}

reactor/src/Index.elm+20−15

@@ -64,7 +64,7 @@ decoder =

6464 (D.field "dirs" (D.list D.string))

6565 (D.field "files" (D.list fileDecoder))

6666 (D.field "readme" (D.nullable D.string))

67− (D.field "project" (D.nullable Project.decoder))

67+ (D.field "outline" (D.nullable Project.decoder))

6868 (D.field "exactDeps" (D.dict Version.decoder))

6969

7070

@@ -219,10 +219,10 @@ viewDeps exactDeps project =

219219 dependencies =

220220 case project of

221221 Project.Application info ->

222− List.map (viewDependency exactDeps) info.depsDirect

222+ List.map viewVersion info.depsDirect

223223

224224 Project.Package info ->

225− List.map (viewDependency exactDeps) info.deps

225+ List.map (viewConstraint exactDeps) info.deps

226226 in

227227 Skeleton.box

228228 { title = "Dependencies"

@@ -237,10 +237,10 @@ viewTestDeps exactDeps project =

237237 dependencies =

238238 case project of

239239 Project.Application info ->

240− List.map (viewDependency exactDeps) info.testDepsDirect

240+ List.map viewVersion info.testDepsDirect

241241

242242 Project.Package info ->

243− List.map (viewDependency exactDeps) info.testDeps

243+ List.map (viewConstraint exactDeps) info.testDeps

244244 in

245245 Skeleton.box

246246 { title = "Test Dependencies"

@@ -249,9 +249,22 @@ viewTestDeps exactDeps project =

249249 }

250250

251251

252−viewDependency : ExactDeps -> (Package.Name, vsn) -> List (Html msg)

253−viewDependency exactDeps (pkg, _) =

252+viewVersion : (Package.Name, Version.Version) -> List (Html msg)

253+viewVersion (pkg, version) =

254+ [ div [ style "float" "left" ]

255+ [ Icon.package

256+ , a [ href (toPackageUrl pkg version) ] [ text (Package.toString pkg) ]

257+ ]

258+ , div [ style "float" "right" ] [ text (Version.toString version) ]

259+ ]

260+

261+

262+viewConstraint : ExactDeps -> (Package.Name, constraint) -> List (Html msg)

263+viewConstraint exactDeps (pkg, _) =

254264 case Dict.get (Package.toString pkg) exactDeps of

265+ Just vsn ->

266+ viewVersion (pkg, vsn)

267+

255268 Nothing ->

256269 [ div [ style "float" "left" ]

257270 [ Icon.package

@@ -260,14 +273,6 @@ viewDependency exactDeps (pkg, _) =

260273 , div [ style "float" "right" ] [ text "???" ]

261274 ]

262275

263− Just version ->

264− [ div [ style "float" "left" ]

265− [ Icon.package

266− , a [ href (toPackageUrl pkg version) ] [ text (Package.toString pkg) ]

267− ]

268− , div [ style "float" "right" ] [ text (Version.toString version) ]

269− ]

270−

271276

272277toPackageUrl : Package.Name -> Version.Version -> String

273278toPackageUrl name version =

reactor/src/Index/Navigator.elm+1−1

@@ -19,7 +19,7 @@ view root dirs =

1919 , style "align-items" "center"

2020 , style "height" "40px"

2121 ]

22− (makeLinks root dirs "/" [])

22+ (makeLinks root dirs "" [])

2323

2424

2525makeLinks : String -> List String -> String -> List (Html msg) -> List (Html msg)

roadmap.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+28−25

@@ -1,8 +1,7 @@

1−module Terminal.Args

2− ( simple

3− , Interface(..)

1+module Terminal

2+ ( app

3+ , Command(..)

44 , Summary(..)

5− , complex

65 , Flags, noFlags, flags, (|--)

76 , Flag, flag, onOff

87 , Parser(..)

@@ -26,17 +25,17 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P

2625import qualified Text.Read as Read

2726

2827import qualified Elm.Version as V

29−import Terminal.Args.Internal

30−import qualified Terminal.Args.Chomp as Chomp

31−import qualified Terminal.Args.Error as Error

28+import Terminal.Internal

29+import qualified Terminal.Chomp as Chomp

30+import qualified Terminal.Error as Error

3231

3332

3433

35−-- GET

34+-- COMMAND

3635

3736

38−simple :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()

39−simple details example args_ flags_ callback =

37+_command :: String -> P.Doc -> Args args -> Flags flags -> (args -> flags -> IO ()) -> IO ()

38+_command details example args_ flags_ callback =

4039 do setLocaleEncoding utf8

4140 argStrings <- Env.getArgs

4241 case argStrings of

@@ -57,34 +56,38 @@ simple details example args_ flags_ callback =

5756 Error.exitWithError err

5857

5958

60−complex :: P.Doc -> P.Doc -> [Interface] -> IO ()

61−complex intro outro interfaces =

59+

60+-- APP

61+

62+

63+app :: P.Doc -> P.Doc -> [Command] -> IO ()

64+app intro outro commands =

6265 do setLocaleEncoding utf8

6366 argStrings <- Env.getArgs

6467 case argStrings of

6568 [] ->

66− Error.exitWithOverview intro outro interfaces

69+ Error.exitWithOverview intro outro commands

6770

6871 ["--help"] ->

69− Error.exitWithOverview intro outro interfaces

72+ Error.exitWithOverview intro outro commands

7073

7174 ["--version"] ->

7275 do hPutStrLn stdout (V.toChars V.compiler)

7376 Exit.exitSuccess

7477

7578 command : chunks ->

76− do case List.find (\iface -> toName iface == command) interfaces of

79+ do case List.find (\cmd -> toName cmd == command) commands of

7780 Nothing ->

78− Error.exitWithUnknown command (map toName interfaces)

81+ Error.exitWithUnknown command (map toName commands)

7982

80− Just (Interface _ _ details example args_ flags_ callback) ->

83+ Just (Command _ _ details example args_ flags_ callback) ->

8184 if elem "--help" chunks then

8285 Error.exitWithHelp (Just command) details example args_ flags_

8386

8487 else

8588 case snd $ Chomp.chomp Nothing chunks args_ flags_ of

86− Right (argsValue, flagValue) ->

87− callback argsValue flagValue

89+ Right (argsValue, flagsValue) ->

90+ callback argsValue flagsValue

8891

8992 Left err ->

9093 Error.exitWithError err

@@ -159,21 +162,21 @@ findIndex index point chunks =

159162 findIndex (index + 1) point cs

160163

161164

162−_complexSuggest :: [Interface] -> Int -> [String] -> IO [String]

163−_complexSuggest interfaces index strings =

165+_complexSuggest :: [Command] -> Int -> [String] -> IO [String]

166+_complexSuggest commands index strings =

164167 case strings of

165168 [] ->

166− return (map toName interfaces)

169+ return (map toName commands)

167170

168171 command : chunks ->

169172 if index == 1 then

170− return (filter (List.isPrefixOf command) (map toName interfaces))

173+ return (filter (List.isPrefixOf command) (map toName commands))

171174 else

172− case List.find (\iface -> toName iface == command) interfaces of

175+ case List.find (\cmd -> toName cmd == command) commands of

173176 Nothing ->

174177 return []

175178

176− Just (Interface _ _ _ _ args_ flags_ _) ->

179+ Just (Command _ _ _ _ args_ flags_ _) ->

177180 fst $ Chomp.chomp (Just (index-1)) chunks args_ flags_

178181

179182

terminal/src/Terminal/Args/Chomp.hs → terminal/impl/Terminal/Chomp.hsrenamed+4−5

@@ -1,6 +1,5 @@

1−{-# LANGUAGE GADTs #-}

2−{-# LANGUAGE Rank2Types #-}

3−module Terminal.Args.Chomp

1+{-# LANGUAGE GADTs, Rank2Types #-}

2+module Terminal.Chomp

43 ( chomp

54 )

65 where

@@ -8,8 +7,8 @@ module Terminal.Args.Chomp

87

98import qualified Data.List as List

109

11−import Terminal.Args.Error

12−import Terminal.Args.Internal

10+import Terminal.Error

11+import Terminal.Internal

1312

1413

1514

terminal/src/Terminal/Args/Error.hs → terminal/impl/Terminal/Error.hsrenamed+28−18

@@ -1,6 +1,5 @@

1−{-# LANGUAGE GADTs #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−module Terminal.Args.Error

1+{-# LANGUAGE GADTs, OverloadedStrings #-}

2+module Terminal.Error

43 ( Error(..)

54 , ArgError(..)

65 , FlagError(..)

@@ -24,7 +23,7 @@ import System.IO (hPutStrLn, stderr)

2423import qualified Text.PrettyPrint.ANSI.Leijen as P

2524

2625import Reporting.Suggest as Suggest

27−import Terminal.Args.Internal

26+import Terminal.Internal

2827

2928

3029

@@ -187,22 +186,22 @@ flagsToDocs flags docs =

187186-- OVERVIEW

188187

189188

190−exitWithOverview :: P.Doc -> P.Doc -> [Interface] -> IO a

191−exitWithOverview intro outro interfaces =

189+exitWithOverview :: P.Doc -> P.Doc -> [Command] -> IO a

190+exitWithOverview intro outro commands =

192191 do exeName <- getExeName

193192 exitSuccess

194193 [ intro

195194 , "The most common commands are:"

196− , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) interfaces

195+ , P.indent 4 $ stack $ Maybe.mapMaybe (toSummary exeName) commands

197196 , "There are a bunch of other commands as well though. Here is a full list:"

198− , P.indent 4 $ P.dullcyan $ toCommandList exeName interfaces

197+ , P.indent 4 $ P.dullcyan $ toCommandList exeName commands

199198 , "Adding the --help flag gives a bunch of additional details about each one."

200199 , outro

201200 ]

202201

203202

204−toSummary :: String -> Interface -> Maybe P.Doc

205−toSummary exeName (Interface name summary _ _ (Args args) _ _) =

203+toSummary :: String -> Command -> Maybe P.Doc

204+toSummary exeName (Command name summary _ _ (Args args) _ _) =

206205 case summary of

207206 Uncommon ->

208207 Nothing

@@ -215,10 +214,10 @@ toSummary exeName (Interface name summary _ _ (Args args) _ _) =

215214 ]

216215

217216

218−toCommandList :: String -> [Interface] -> P.Doc

219−toCommandList exeName interfaces =

217+toCommandList :: String -> [Command] -> P.Doc

218+toCommandList exeName commands =

220219 let

221− names = map toName interfaces

220+ names = map toName commands

222221 width = maximum (map length names)

223222

224223 toExample name =

@@ -272,13 +271,24 @@ exitWithError err =

272271 BadArgs argErrors ->

273272 case argErrors of

274273 [] ->

275− error "TODO no possible args"

274+ return

275+ [ reflow $ "I was not expecting any arguments for this command."

276+ , reflow $ "Try removing them?"

277+ ]

276278

277279 [(_args, argError)] ->

278280 argErrorToDocs argError

279281

280282 _:_:_ ->

281− error "TODO show possible arg configurations"

283+ argErrorToDocs $ head $ List.sortOn toArgErrorRank (map snd argErrors)

284+

285+

286+toArgErrorRank :: ArgError -> Int -- lower is better

287+toArgErrorRank err =

288+ case err of

289+ ArgBad _ _ -> 0

290+ ArgMissing _ -> 1

291+ ArgExtras _ -> 2

282292

283293

284294toGreen :: String -> P.Doc

@@ -318,10 +328,10 @@ argErrorToDocs argError =

318328 return

319329 [ "I am having trouble with this argument:"

320330 , P.indent 4 $ toRed string

321− , P.fillSep

331+ , P.fillSep $

322332 ["It","is","supposed","to","be","a"

323− ,toYellow (toToken tipe),"value,","like","this:"

324− ]

333+ ,toYellow (toToken tipe),"value,","like"

334+ ] ++ if length examples == 1 then ["this:"] else ["one","of","these:"]

325335 , P.indent 4 $ P.green $ P.vcat $ map P.text examples

326336 ]

327337

terminal/src/Terminal/Args/Helpers.hs → terminal/impl/Terminal/Helpers.hsrenamed+20−7

@@ -1,5 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2−module Terminal.Args.Helpers

2+module Terminal.Helpers

33 ( version

44 , elmFile

55 , package

@@ -14,12 +14,13 @@ import qualified Data.Map as Map

1414import qualified Data.Utf8 as Utf8

1515import qualified System.FilePath as FP

1616

17−import Terminal.Args (Parser(..))

17+import Terminal (Parser(..))

1818import qualified Deps.Registry as Registry

1919import qualified Elm.Package as Pkg

2020import qualified Elm.Version as V

2121import qualified Parse.Primitives as P

2222import qualified Stuff

23+import qualified Reporting.Suggest as Suggest

2324

2425

2526

@@ -117,8 +118,17 @@ parsePackage chars =

117118

118119

119120suggestPackages :: String -> IO [String]

120−suggestPackages _ =

121− return []

121+suggestPackages given =

122+ do cache <- Stuff.getPackageCache

123+ maybeRegistry <- Registry.read cache

124+ return $

125+ case maybeRegistry of

126+ Nothing ->

127+ []

128+

129+ Just (Registry.Registry _ versions) ->

130+ filter (List.isPrefixOf given) $

131+ map Pkg.toChars (Map.keys versions)

122132

123133

124134examplePackages :: String -> IO [String]

@@ -128,8 +138,11 @@ examplePackages given =

128138 return $

129139 case maybeRegistry of

130140 Nothing ->

131− []

141+ [ "elm/json"

142+ , "elm/http"

143+ , "elm/random"

144+ ]

132145

133146 Just (Registry.Registry _ versions) ->

134− filter (List.isPrefixOf given) $

135− map Pkg.toChars (Map.keys versions)

147+ map Pkg.toChars $ take 4 $

148+ Suggest.sort given Pkg.toChars (Map.keys versions)

terminal/src/Terminal/Args/Internal.hs → terminal/impl/Terminal/Internal.hsrenamed+8−8

@@ -1,6 +1,6 @@

11{-# LANGUAGE GADTs #-}

2−module Terminal.Args.Internal

3− ( Interface(..)

2+module Terminal.Internal

3+ ( Command(..)

44 , toName

55 , Summary(..)

66 , Flags(..)

@@ -17,11 +17,11 @@ import Text.PrettyPrint.ANSI.Leijen (Doc)

1717

1818

1919

20−-- INTERFACE

20+-- COMMAND

2121

2222

23−data Interface where

24− Interface

23+data Command where

24+ Command

2525 :: String

2626 -> Summary

2727 -> String

@@ -29,11 +29,11 @@ data Interface where

2929 -> Args args

3030 -> Flags flags

3131 -> (args -> flags -> IO ())

32− -> Interface

32+ -> Command

3333

3434

35−toName :: Interface -> String

36−toName (Interface name _ _ _ _ _ _) =

35+toName :: Command -> String

36+toName (Command name _ _ _ _ _ _) =

3737 name

3838

3939

terminal/src/Bump.hs+43−29

@@ -6,11 +6,15 @@ module Bump

66

77

88import qualified Data.List as List

9+import qualified Data.NonEmptyList as NE

910

11+import qualified BackgroundWriter as BW

12+import qualified Build

1013import qualified Deps.Bump as Bump

1114import qualified Deps.Diff as Diff

1215import qualified Deps.Registry as Registry

1316import qualified Elm.Details as Details

17+import qualified Elm.Docs as Docs

1418import qualified Elm.Magnitude as M

1519import qualified Elm.Outline as Outline

1620import qualified Elm.Version as V

@@ -44,7 +48,7 @@ data Env =

4448 , _cache :: Stuff.PackageCache

4549 , _manager :: Http.Manager

4650 , _registry :: Registry.Registry

47− , _outline :: Outline.Outline

51+ , _outline :: Outline.PkgOutline

4852 }

4953

5054

@@ -59,13 +63,13 @@ getEnv =

5963 do cache <- Task.io $ Stuff.getPackageCache

6064 manager <- Task.io $ Http.getManager

6165 registry <- Task.eio Exit.BumpMustHaveLatestRegistry $ Registry.latest manager cache

62− outlineResult <- Task.io $ Outline.read root

63− case outlineResult of

64− Right outline ->

65− return $ Env root cache manager registry outline

66+ outline <- Task.eio Exit.BumpBadOutline $ Outline.read root

67+ case outline of

68+ Outline.App _ ->

69+ Task.throw Exit.BumpApplication

6670

67− Left problem ->

68− Task.throw $ Exit.BumpBadOutline problem

71+ Outline.Pkg pkgOutline ->

72+ return $ Env root cache manager registry pkgOutline

6973

7074

7175

@@ -73,26 +77,21 @@ getEnv =

7377

7478

7579bump :: Env -> Task.Task Exit.Bump ()

76−bump env@(Env root _ _ registry outline) =

77− case outline of

78− Outline.App _ ->

79− Task.throw Exit.BumpApplication

80−

81− Outline.Pkg pkgOutline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _) ->

82− case Registry.getVersions pkg registry of

83− Just knownVersions ->

84− let

85− bumpableVersions =

86− map (\(old, _, _) -> old) (Bump.getPossibilities knownVersions)

87− in

88− if elem vsn bumpableVersions

89− then suggestVersion env pkgOutline

90− else

91− Task.throw $ Exit.BumpUnexpectedVersion vsn $

92− map head (List.group (List.sort bumpableVersions))

80+bump env@(Env root _ _ registry outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =

81+ case Registry.getVersions pkg registry of

82+ Just knownVersions ->

83+ let

84+ bumpableVersions =

85+ map (\(old, _, _) -> old) (Bump.getPossibilities knownVersions)

86+ in

87+ if elem vsn bumpableVersions

88+ then suggestVersion env

89+ else

90+ Task.throw $ Exit.BumpUnexpectedVersion vsn $

91+ map head (List.group (List.sort bumpableVersions))

9392

94− Nothing ->

95− Task.io $ checkNewPackage root pkgOutline

93+ Nothing ->

94+ Task.io $ checkNewPackage root outline

9695

9796

9897

@@ -116,10 +115,10 @@ checkNewPackage root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) =

116115-- SUGGEST VERSION

117116

118117

119−suggestVersion :: Env -> Outline.PkgOutline -> Task.Task Exit.Bump ()

120−suggestVersion (Env root cache manager _ _) outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _) =

118+suggestVersion :: Env -> Task.Task Exit.Bump ()

119+suggestVersion (Env root cache manager _ outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =

121120 do oldDocs <- Task.eio (Exit.BumpCannotFindDocs pkg vsn) (Diff.getDocs cache manager pkg vsn)

122− newDocs <- error "TODO Outline.generateDocs summary"

121+ newDocs <- generateDocs root outline

123122 let changes = Diff.diff oldDocs newDocs

124123 let newVersion = Diff.bump changes vsn

125124 Task.io $ changeVersion root outline newVersion $

@@ -134,6 +133,21 @@ suggestVersion (Env root cache manager _ _) outline@(Outline.PkgOutline pkg _ _

134133 <> "Should I perform the update (" <> old <> " => " <> new <> ") in elm.json? [Y/n] "

135134

136135

136+generateDocs :: FilePath -> Outline.PkgOutline -> Task.Task Exit.Bump Docs.Documentation

137+generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) =

138+ do details <-

139+ Task.eio Exit.BumpBadDetails $ BW.withScope $ \scope ->

140+ Details.load Reporting.silent scope root

141+

142+ case Outline.flattenExposed exposed of

143+ [] ->

144+ Task.throw $ Exit.BumpNoExposed

145+

146+ e:es ->

147+ Task.eio Exit.BumpBadBuild $

148+ Build.fromExposed Reporting.silent root details Build.KeepDocs (NE.List e es)

149+

150+

137151

138152-- CHANGE VERSION

139153

terminal/src/Develop.hs+70−77

@@ -7,27 +7,31 @@ module Develop

77

88

99import Control.Applicative ((<|>))

10−import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)

11−import Control.Monad (guard, void)

10+import Control.Monad (guard)

1211import Control.Monad.Trans (MonadIO(liftIO))

1312import qualified Data.ByteString.Builder as B

1413import qualified Data.ByteString as BS

1514import qualified Data.HashMap.Strict as HashMap

1615import Data.Monoid ((<>))

16+import qualified Data.NonEmptyList as NE

1717import qualified System.Directory as Dir

1818import System.FilePath as FP

19−import Snap.Core

19+import Snap.Core hiding (path)

2020import Snap.Http.Server

2121import Snap.Util.FileServe

2222

23−import qualified Elm.Project as Project

24−import qualified Develop.Generate.Help as Generate

23+import qualified BackgroundWriter as BW

24+import qualified Build

25+import qualified Elm.Details as Details

26+import qualified Develop.Generate.Help as Help

2527import qualified Develop.Generate.Index as Index

2628import qualified Develop.StaticFiles as StaticFiles

27−import qualified Generate.Output as Output

29+import qualified Generate.Html as Html

30+import qualified Generate

31+import qualified Reporting

2832import qualified Reporting.Exit as Exit

29−import qualified Reporting.Progress as Progress

3033import qualified Reporting.Task as Task

34+import qualified Stuff

3135

3236

3337

@@ -42,31 +46,19 @@ data Flags =

4246

4347run :: () -> Flags -> IO ()

4448run () (Flags maybePort) =

45− let

46− port =

47− maybe 8000 id maybePort

48− in

49− do putStrLn $ "Go to <http://localhost:" ++ show port ++ "> to see your project dashboard."

50−

51− httpServe (config port) $

52− serveFiles

53− <|> serveDirectoryWith directoryConfig "."

54− <|> serveAssets

55− <|> error404

49+ do let port = maybe 8000 id maybePort

50+ putStrLn $ "Go to http://localhost:" ++ show port ++ " to see your project dashboard."

51+ httpServe (config port) $

52+ serveFiles

53+ <|> serveDirectoryWith directoryConfig "."

54+ <|> serveAssets

55+ <|> error404

5656

5757

5858config :: Int -> Config Snap a

5959config port =

60− defaultConfig

61− # setVerbose False

62− # setPort port

63− # setAccessLog ConfigNoLog

64− # setErrorLog ConfigNoLog

65−

66−

67−(#) :: a -> (a -> b) -> b

68−(#) value func =

69− func value

60+ setVerbose False $ setPort port $

61+ setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ defaultConfig

7062

7163

7264

@@ -75,18 +67,12 @@ config port =

7567

7668directoryConfig :: MonadSnap m => DirectoryConfig m

7769directoryConfig =

78− let

79− customGenerator pwd =

80− do modifyResponse $ setContentType "text/html; charset=utf-8"

81− html <- liftIO $

82− do root <- Dir.getCurrentDirectory

83− Index.get root pwd

84− writeBuilder html

85− in

86− fancyDirectoryConfig

87− { indexFiles = []

88− , indexGenerator = customGenerator

89− }

70+ fancyDirectoryConfig

71+ { indexFiles = []

72+ , indexGenerator = \pwd ->

73+ do modifyResponse $ setContentType "text/html;charset=utf-8"

74+ writeBuilder =<< liftIO (Index.generate pwd)

75+ }

9076

9177

9278

@@ -96,8 +82,8 @@ directoryConfig =

9682error404 :: Snap ()

9783error404 =

9884 do modifyResponse $ setResponseStatus 404 "Not Found"

99− modifyResponse $ setContentType "text/html; charset=utf-8"

100− writeBuilder $ Generate.makePageHtml "NotFound" Nothing

85+ modifyResponse $ setContentType "text/html;charset=utf-8"

86+ writeBuilder $ Help.makePageHtml "NotFound" Nothing

10187

10288

10389

@@ -106,9 +92,9 @@ error404 =

10692

10793serveFiles :: Snap ()

10894serveFiles =

109− do file <- getSafePath

110− guard =<< liftIO (Dir.doesFileExist file)

111− serveElm file <|> serveFilePretty file

95+ do path <- getSafePath

96+ guard =<< liftIO (Dir.doesFileExist path)

97+ serveElm path <|> serveFilePretty path

11298

11399

114100

@@ -116,34 +102,33 @@ serveFiles =

116102

117103

118104serveFilePretty :: FilePath -> Snap ()

119−serveFilePretty file =

105+serveFilePretty path =

120106 let

121107 possibleExtensions =

122− getSubExts (takeExtensions file)

108+ getSubExts (takeExtensions path)

123109 in

124110 case mconcat (map lookupMimeType possibleExtensions) of

125111 Nothing ->

126− serveCode file

112+ serveCode path

127113

128114 Just mimeType ->

129− serveFileAs mimeType file

115+ serveFileAs mimeType path

130116

131117

132118getSubExts :: String -> [String]

133119getSubExts fullExtension =

134120 if null fullExtension then

135121 []

136−

137122 else

138123 fullExtension : getSubExts (takeExtensions (drop 1 fullExtension))

139124

140125

141126serveCode :: String -> Snap ()

142−serveCode file =

143− do code <- liftIO (BS.readFile file)

127+serveCode path =

128+ do code <- liftIO (BS.readFile path)

144129 modifyResponse (setContentType "text/html")

145130 writeBuilder $

146− Generate.makeCodeHtml ('~' : '/' : file) (B.byteString code)

131+ Help.makeCodeHtml ('~' : '/' : path) (B.byteString code)

147132

148133

149134

@@ -151,31 +136,33 @@ serveCode file =

151136

152137

153138serveElm :: FilePath -> Snap ()

154−serveElm file =

155− do guard (takeExtension file == ".elm")

139+serveElm path =

140+ do guard (takeExtension path == ".elm")

156141 modifyResponse (setContentType "text/html")

157− writeBuilder =<< liftIO (compileToHtmlBuilder file)

158−

159−

160−compileToHtmlBuilder :: FilePath -> IO B.Builder

161−compileToHtmlBuilder file =

162− do mvar1 <- newEmptyMVar

163− mvar2 <- newEmptyMVar

164−

165− let reporter = Progress.Reporter (\_ -> return ()) (\_ -> return True) (putMVar mvar1)

166− let output = Just (Output.HtmlBuilder mvar2)

142+ result <- liftIO $ compile path

143+ case result of

144+ Right builder ->

145+ writeBuilder builder

167146

168− void $ Task.try reporter $

169− do summary <- Project.getRoot

170− Project.compile Output.Dev Output.Client output summary [file]

147+ Left exit ->

148+ writeBuilder $ Help.makePageHtml "Errors" $ Just $

149+ Exit.toJson $ Exit.reactorToReport exit

171150

172− result <- takeMVar mvar1

173− case result of

174− Just exit ->

175− return $ Generate.makePageHtml "Errors" (Just (Exit.toJson exit))

176151

152+compile :: FilePath -> IO (Either Exit.Reactor B.Builder)

153+compile path =

154+ do maybeRoot <- Stuff.findRoot

155+ case maybeRoot of

177156 Nothing ->

178− takeMVar mvar2

157+ return $ Left $ Exit.ReactorNoOutline

158+

159+ Just root ->

160+ BW.withScope $ \scope -> Stuff.withRootLock root $ Task.run $

161+ do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root

162+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details (NE.List path [])

163+ javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.dev root details artifacts

164+ let (NE.List name _) = Build.getRootNames artifacts

165+ return $ Html.sandwich name javascript

179166

180167

181168

@@ -184,8 +171,8 @@ compileToHtmlBuilder file =

184171

185172serveAssets :: Snap ()

186173serveAssets =

187− do file <- getSafePath

188− case StaticFiles.lookup file of

174+ do path <- getSafePath

175+ case StaticFiles.lookup path of

189176 Nothing ->

190177 pass

191178

@@ -231,13 +218,16 @@ mimeTypeDict =

231218 , ".m3u" ==> "audio/x-mpegurl"

232219 , ".mov" ==> "video/quicktime"

233220 , ".mp3" ==> "audio/mpeg"

221+ , ".mp4" ==> "video/mp4"

234222 , ".mpeg" ==> "video/mpeg"

235223 , ".mpg" ==> "video/mpeg"

236224 , ".ogg" ==> "application/ogg"

225+ , ".otf" ==> "font/otf"

237226 , ".pac" ==> "application/x-ns-proxy-autoconfig"

238227 , ".pdf" ==> "application/pdf"

239228 , ".png" ==> "image/png"

240229 , ".qt" ==> "video/quicktime"

230+ , ".sfnt" ==> "font/sfnt"

241231 , ".sig" ==> "application/pgp-signature"

242232 , ".spl" ==> "application/futuresplash"

243233 , ".svg" ==> "image/svg+xml"

@@ -248,16 +238,19 @@ mimeTypeDict =

248238 , ".tbz" ==> "application/x-bzip-compressed-tar"

249239 , ".text" ==> "text/plain"

250240 , ".tgz" ==> "application/x-tgz"

251− , ".ttf" ==> "application/x-font-truetype"

241+ , ".ttf" ==> "font/ttf"

252242 , ".txt" ==> "text/plain"

253243 , ".wav" ==> "audio/x-wav"

254244 , ".wax" ==> "audio/x-ms-wax"

245+ , ".webm" ==> "video/webm"

246+ , ".webp" ==> "image/webp"

255247 , ".wma" ==> "audio/x-ms-wma"

256248 , ".wmv" ==> "video/x-ms-wmv"

249+ , ".woff" ==> "font/woff"

250+ , ".woff2" ==> "font/woff2"

257251 , ".xbm" ==> "image/x-xbitmap"

258252 , ".xml" ==> "text/xml"

259253 , ".xpm" ==> "image/x-xpixmap"

260254 , ".xwd" ==> "image/x-xwindowdump"

261255 , ".zip" ==> "application/zip"

262256 ]

263−

terminal/src/Develop/Generate/Index.hs+149−74

@@ -1,36 +1,37 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

33module Develop.Generate.Index

4− ( get

4+ ( generate

55 )

66 where

77

88

99import Control.Monad (filterM)

1010import qualified Data.ByteString.Builder as B

11+import qualified Data.List as List

1112import qualified Data.Map as Map

12−import qualified Data.Text as Text

13−import qualified Data.Text.IO as Text

1413import qualified System.Directory as Dir

1514import System.FilePath ((</>), splitDirectories, takeExtension)

1615

16+import qualified BackgroundWriter as BW

1717import qualified Develop.Generate.Help as Help

18+import qualified Elm.Details as Details

19+import qualified Elm.Outline as Outline

1820import qualified Elm.Package as Pkg

19−import qualified Elm.Project.Json as Project

20−import qualified Elm.Project.Summary as Summary

21+import qualified Elm.Version as V

2122import qualified Json.Encode as E

22−import qualified Reporting.Progress as Progress

23−import qualified Reporting.Task as Task

24−import qualified Stuff.Verify as Verify

23+import Json.Encode ((==>))

24+import qualified Reporting

25+import qualified Stuff

2526

2627

2728

28−-- GET

29+-- GENERATE

2930

3031

31−get :: FilePath -> FilePath -> IO B.Builder

32−get root pwd =

33− do flags <- getFlags root pwd

32+generate :: FilePath -> IO B.Builder

33+generate pwd =

34+ do flags <- getFlags pwd

3435 return $ Help.makePageHtml "Index" (Just (encode flags))

3536

3637

@@ -43,60 +44,33 @@ data Flags =

4344 { _root :: FilePath

4445 , _pwd :: [String]

4546 , _dirs :: [FilePath]

46− , _files :: [(FilePath, Bool)]

47− , _readme :: Maybe Text.Text

48− , _project :: Maybe Project.Project

49− , _exactDeps :: Map.Map Pkg.Name Pkg.Version

47+ , _files :: [File]

48+ , _readme :: Maybe String

49+ , _outline :: Maybe Outline.Outline

50+ , _exactDeps :: Map.Map Pkg.Name V.Version

5051 }

5152

5253

53−

54−-- JSON

55−

56−

57−encode :: Flags -> E.Value

58−encode (Flags root pwd dirs files readme project exactDeps) =

59− E.object

60− [ ( "root", encodeFilePath root )

61− , ( "pwd", E.list encodeFilePath pwd )

62− , ( "dirs", E.list encodeFilePath dirs )

63− , ( "files", E.list encodeFile files )

64− , ( "readme", maybe E.null E.text readme )

65− , ( "project", maybe E.null Project.encode project )

66− , ( "exactDeps", E.dict Pkg.toText Pkg.encodeVersion exactDeps)

67− ]

68−

69−

70−encodeFilePath :: FilePath -> E.Value

71−encodeFilePath filePath =

72− E.text (Text.pack filePath)

73−

74−

75−encodeFile :: (FilePath, Bool) -> E.Value

76−encodeFile (file, hasMain) =

77− E.object

78− [ ("name", encodeFilePath file)

79− , ("runnable", E.bool hasMain)

80− ]

54+data File =

55+ File

56+ { _path :: FilePath

57+ , _runnable :: Bool

58+ }

8159

8260

8361

8462-- GET FLAGS

8563

8664

87−getFlags :: FilePath -> FilePath -> IO Flags

88−getFlags root pwd =

89− do (dirs, files) <- getDirsAndFiles pwd

65+getFlags :: FilePath -> IO Flags

66+getFlags pwd =

67+ do contents <- Dir.getDirectoryContents pwd

68+ root <- Dir.getCurrentDirectory

69+ dirs <- getDirs pwd contents

70+ files <- getFiles pwd contents

9071 readme <- getReadme pwd

91− exists <- Dir.doesFileExist (root </> "elm.json")

92−

93− maybeSummary <-

94− if exists then

95− Task.try Progress.silentReporter $

96− Verify.verify root =<< Project.read (root </> "elm.json")

97− else

98− return Nothing

99−

72+ outline <- getOutline

73+ exactDeps <- getExactDeps outline

10074 return $

10175 Flags

10276 { _root = root

@@ -104,35 +78,136 @@ getFlags root pwd =

10478 , _dirs = dirs

10579 , _files = files

10680 , _readme = readme

107− , _project = fmap Summary._project maybeSummary

108− , _exactDeps = maybe Map.empty (Map.map fst . Summary._depsGraph) maybeSummary

81+ , _outline = outline

82+ , _exactDeps = exactDeps

10983 }

11084

11185

112−getReadme :: FilePath -> IO (Maybe Text.Text)

86+

87+-- README

88+

89+

90+getReadme :: FilePath -> IO (Maybe String)

11391getReadme dir =

11492 do let readmePath = dir </> "README.md"

11593 exists <- Dir.doesFileExist readmePath

11694 if exists

117− then Just <$> Text.readFile readmePath

95+ then Just <$> readFile readmePath

11896 else return Nothing

11997

12098

121−getDirsAndFiles :: FilePath -> IO ([FilePath], [(FilePath, Bool)])

122−getDirsAndFiles pwd =

123− do contents <- Dir.getDirectoryContents pwd

124− dirs <- filterM (Dir.doesDirectoryExist . (pwd </>)) contents

125− filePaths <- filterM (Dir.doesFileExist . (pwd </>)) contents

126− files <- mapM (inspectFile pwd) filePaths

127− return (dirs, files)

12899

100+-- GET DIRECTORIES

129101

130−inspectFile :: FilePath -> FilePath -> IO (FilePath, Bool)

131−inspectFile pwd path =

132− if takeExtension path == ".elm" then

133− do source <- Text.readFile (pwd </> path)

134− let hasMain = Text.isInfixOf "\nmain " source

135− return (path, hasMain)

136102

103+getDirs :: FilePath -> [FilePath] -> IO [FilePath]

104+getDirs pwd contents =

105+ filterM (Dir.doesDirectoryExist . (pwd </>)) contents

106+

107+

108+

109+-- GET FILES

110+

111+

112+getFiles :: FilePath -> [FilePath] -> IO [File]

113+getFiles pwd contents =

114+ do paths <- filterM (Dir.doesFileExist . (pwd </>)) contents

115+ mapM (toFile pwd) paths

116+

117+

118+toFile :: FilePath -> FilePath -> IO File

119+toFile pwd path =

120+ if takeExtension path == ".elm" then

121+ do source <- readFile (pwd </> path)

122+ let hasMain = List.isInfixOf "\nmain " source

123+ return (File path hasMain)

137124 else

138− return (path, False)

125+ return (File path False)

126+

127+

128+

129+-- GET OUTLINE

130+

131+

132+getOutline :: IO (Maybe Outline.Outline)

133+getOutline =

134+ do maybeRoot <- Stuff.findRoot

135+ case maybeRoot of

136+ Nothing ->

137+ return Nothing

138+

139+ Just root ->

140+ do result <- Outline.read root

141+ case result of

142+ Left _ -> return Nothing

143+ Right outline -> return (Just outline)

144+

145+

146+

147+-- GET EXACT DEPS

148+

149+

150+-- TODO revamp how `elm reactor` works so that this can go away.

151+-- I am trying to "just get it working again" at this point though.

152+--

153+getExactDeps :: Maybe Outline.Outline -> IO (Map.Map Pkg.Name V.Version)

154+getExactDeps maybeOutline =

155+ case maybeOutline of

156+ Nothing ->

157+ return Map.empty

158+

159+ Just outline ->

160+ case outline of

161+ Outline.App _ ->

162+ return Map.empty

163+

164+ Outline.Pkg _ ->

165+ do maybeRoot <- Stuff.findRoot

166+ case maybeRoot of

167+ Nothing ->

168+ return Map.empty

169+

170+ Just root ->

171+ BW.withScope $ \scope ->

172+ do result <- Details.load Reporting.silent scope root

173+ case result of

174+ Left _ ->

175+ return Map.empty

176+

177+ Right (Details.Details _ validOutline _ _ _ _) ->

178+ case validOutline of

179+ Details.ValidApp _ ->

180+ return Map.empty

181+

182+ Details.ValidPkg _ _ solution ->

183+ return solution

184+

185+

186+

187+-- ENCODE

188+

189+

190+encode :: Flags -> E.Value

191+encode (Flags root pwd dirs files readme outline exactDeps) =

192+ E.object

193+ [ "root" ==> encodeFilePath root

194+ , "pwd" ==> E.list encodeFilePath pwd

195+ , "dirs" ==> E.list encodeFilePath dirs

196+ , "files" ==> E.list encodeFile files

197+ , "readme" ==> maybe E.null E.chars readme

198+ , "outline" ==> maybe E.null Outline.encode outline

199+ , "exactDeps" ==> E.dict Pkg.toJsonString V.encode exactDeps

200+ ]

201+

202+

203+encodeFilePath :: FilePath -> E.Value

204+encodeFilePath filePath =

205+ E.chars filePath

206+

207+

208+encodeFile :: File -> E.Value

209+encodeFile (File path hasMain) =

210+ E.object

211+ [ "name" ==> encodeFilePath path

212+ , "runnable" ==> E.bool hasMain

213+ ]

terminal/src/Develop/StaticFiles.hs+1−7

@@ -36,7 +36,6 @@ dict :: HM.HashMap FilePath (BS.ByteString, MimeType)

3636dict =

3737 HM.fromList

3838 [ faviconPath ==> (favicon , "image/x-icon")

39− , waitingPath ==> (waiting , "image/gif")

4039 , elmPath ==> (elm , "application/javascript")

4140 , cssPath ==> (css , "text/css")

4241 , codeFontPath ==> (codeFont, "font/ttf")

@@ -89,7 +88,7 @@ sansFontPath =

8988

9089elm :: BS.ByteString

9190elm =

92− $(bsToExp =<< runIO Build.compile)

91+ $(bsToExp =<< runIO Build.buildReactorFrontEnd)

9392

9493

9594

@@ -122,8 +121,3 @@ sansFont =

122121favicon :: BS.ByteString

123122favicon =

124123 $(bsToExp =<< runIO (Build.readAsset "favicon.ico"))

125−

126−

127−waiting :: BS.ByteString

128−waiting =

129− $(bsToExp =<< runIO (Build.readAsset "waiting.gif"))

terminal/src/Develop/StaticFiles/Build.hs+46−29

@@ -1,19 +1,25 @@

11{-# LANGUAGE OverloadedStrings #-}

22module Develop.StaticFiles.Build

33 ( readAsset

4− , compile

4+ , buildReactorFrontEnd

55 )

66 where

77

88

99import qualified Data.ByteString as BS

10+import qualified Data.ByteString.Builder as B

11+import qualified Data.ByteString.Lazy as LBS

12+import qualified Data.NonEmptyList as NE

1013import qualified System.Directory as Dir

1114import System.FilePath ((</>))

1215

13−import qualified Elm.Project as Project

14−import qualified Generate.Output as Output

16+import qualified BackgroundWriter as BW

17+import qualified Build

18+import qualified Elm.Details as Details

19+import qualified Generate

20+import qualified Reporting

21+import qualified Reporting.Exit as Exit

1522import qualified Reporting.Task as Task

16−import qualified Reporting.Progress.Terminal as Terminal

1723

1824

1925

@@ -26,31 +32,42 @@ readAsset path =

2632

2733

2834

29−-- COMPILE

35+-- BUILD REACTOR ELM

3036

3137

32−compile :: IO BS.ByteString

33−compile =

38+buildReactorFrontEnd :: IO BS.ByteString

39+buildReactorFrontEnd =

40+ BW.withScope $ \scope ->

3441 Dir.withCurrentDirectory "reactor" $

35− do reporter <- Terminal.create

36− Task.run reporter $

37− do summary <- Project.getRoot

38− let jsOutput = Just (Output.JavaScript Nothing tempFileName)

39− Project.compile Output.Prod Output.Client jsOutput summary rootPaths

40−

41− result <- BS.readFile tempFileName

42− seq (BS.length result) (Dir.removeFile tempFileName)

43− return result

44−

45−

46−tempFileName :: FilePath

47−tempFileName =

48− "elm.js"

49−

50−

51−rootPaths :: [FilePath]

52−rootPaths =

53− [ "src" </> "Errors.elm"

54− , "src" </> "Index.elm"

55− , "src" </> "NotFound.elm"

56− ]

42+ do root <- Dir.getCurrentDirectory

43+ runTaskUnsafe $

44+ do details <- Task.eio Exit.ReactorBadDetails $ Details.load Reporting.silent scope root

45+ artifacts <- Task.eio Exit.ReactorBadBuild $ Build.fromPaths Reporting.silent root details paths

46+ javascript <- Task.mapError Exit.ReactorBadGenerate $ Generate.prod root details artifacts

47+ return (LBS.toStrict (B.toLazyByteString javascript))

48+

49+

50+paths :: NE.List FilePath

51+paths =

52+ NE.List

53+ ("src" </> "NotFound.elm")

54+ [ "src" </> "Errors.elm"

55+ , "src" </> "Index.elm"

56+ ]

57+

58+

59+runTaskUnsafe :: Task.Task Exit.Reactor a -> IO a

60+runTaskUnsafe task =

61+ do result <- Task.run task

62+ case result of

63+ Right a ->

64+ return a

65+

66+ Left exit ->

67+ do Exit.toStderr (Exit.reactorToReport exit)

68+ error

69+ "\n--------------------------------------------------------\

70+ \\nError in Develop.StaticFiles.Build.buildReactorFrontEnd\

71+ \\nCompile with `elm make` directly to figure it out faster\

72+ \\n--------------------------------------------------------\

73+ \\n"

terminal/src/Diff.hs+20−24

@@ -13,6 +13,7 @@ import qualified Data.Maybe as Maybe

1313import qualified Data.Name as Name

1414import qualified Data.NonEmptyList as NE

1515

16+import qualified BackgroundWriter as BW

1617import qualified Build

1718import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..))

1819import qualified Deps.Diff as DD

@@ -72,7 +73,7 @@ getEnv =

7273 do maybeRoot <- Task.io $ Stuff.findRoot

7374 cache <- Task.io $ Stuff.getPackageCache

7475 manager <- Task.io $ Http.getManager

75− registry <- Task.eio Exit.DiffBadRegistry $ Registry.latest manager cache

76+ registry <- Task.eio Exit.DiffMustHaveLatestRegistry $ Registry.latest manager cache

7677 return (Env maybeRoot cache manager registry)

7778

7879

@@ -104,13 +105,15 @@ diff env@(Env _ _ _ registry) args =

104105 writeDiff oldDocs newDocs

105106

106107 CodeVsLatest ->

107− do (newDocs, name, vsns) <- generateDocs env

108+ do (name, vsns) <- readOutline env

108109 oldDocs <- getLatestDocs env name vsns

110+ newDocs <- generateDocs env

109111 writeDiff oldDocs newDocs

110112

111113 CodeVsExactly version ->

112− do (newDocs, name, vsns) <- generateDocs env

114+ do (name, vsns) <- readOutline env

113115 oldDocs <- getDocs env name vsns version

116+ newDocs <- generateDocs env

114117 writeDiff oldDocs newDocs

115118

116119

@@ -121,13 +124,13 @@ diff env@(Env _ _ _ registry) args =

121124getDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> V.Version -> Task Docs.Documentation

122125getDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) version =

123126 if latest == version || elem version previous

124− then Task.eio Exit.DiffDocsProblem $ DD.getDocs cache manager name version

127+ then Task.eio (Exit.DiffDocsProblem version) $ DD.getDocs cache manager name version

125128 else Task.throw $ Exit.DiffUnknownVersion name version (latest:previous)

126129

127130

128131getLatestDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> Task Docs.Documentation

129132getLatestDocs (Env _ cache manager _) name (Registry.KnownVersions latest _) =

130− Task.eio Exit.DiffDocsProblem $ DD.getDocs cache manager name latest

133+ Task.eio (Exit.DiffDocsProblem latest) $ DD.getDocs cache manager name latest

131134

132135

133136

@@ -161,36 +164,29 @@ readOutline (Env maybeRoot _ _ registry) =

161164-- GENERATE DOCS

162165

163166

164−generateDocs :: Env -> Task (Docs.Documentation, Pkg.Name, Registry.KnownVersions)

165−generateDocs (Env maybeRoot _ _ registry) =

167+generateDocs :: Env -> Task Docs.Documentation

168+generateDocs (Env maybeRoot _ _ _) =

166169 case maybeRoot of

167170 Nothing ->

168171 Task.throw $ Exit.DiffNoOutline

169172

170173 Just root ->

171174 do details <-

172− Task.eio Exit.DiffBadDetails $

173− Details.load Reporting.silent root

175+ Task.eio Exit.DiffBadDetails $ BW.withScope $ \scope ->

176+ Details.load Reporting.silent scope root

174177

175178 case Details._outline details of

176179 Details.ValidApp _ ->

177180 Task.throw $ Exit.DiffApplication

178181

179− Details.ValidPkg pkg exposed ->

180− case Registry.getVersions pkg registry of

181− Just vsns ->

182− case exposed of

183− [] ->

184− Task.throw Exit.DiffNoExposed

185−

186− e:es ->

187− do docs <-

188− Task.eio Exit.DiffBadBuild $

189− Build.fromExposed Reporting.silent root details Build.KeepDocs (NE.List e es)

190− return ( docs, pkg, vsns )

191−

192− Nothing ->

193− Task.throw Exit.DiffUnpublished

182+ Details.ValidPkg _ exposed _ ->

183+ case exposed of

184+ [] ->

185+ Task.throw $ Exit.DiffNoExposed

186+

187+ e:es ->

188+ Task.eio Exit.DiffBadBuild $

189+ Build.fromExposed Reporting.silent root details Build.KeepDocs (NE.List e es)

194190

195191

196192

terminal/src/Init.hs+1−1

@@ -90,7 +90,7 @@ init =

9090 in

9191 do Dir.createDirectoryIfMissing True "src"

9292 Outline.write "." $ Outline.App $

93− Outline.AppOutline V.compiler (NE.List "src" []) directs indirects Map.empty Map.empty

93+ Outline.AppOutline V.compiler (NE.List (Outline.RelativeSrcDir "src") []) directs indirects Map.empty Map.empty

9494 putStrLn "Okay, I created it. Now read that link!"

9595 return (Right ())

9696

terminal/src/Install.hs+15−30

@@ -10,6 +10,7 @@ import Data.Map ((!))

1010import qualified Data.Map as Map

1111import qualified Data.Map.Merge.Strict as Map

1212

13+import qualified BackgroundWriter as BW

1314import qualified Deps.Solver as Solver

1415import qualified Deps.Registry as Registry

1516import qualified Elm.Constraint as C

@@ -40,7 +41,7 @@ run args () =

4041 do maybeRoot <- Stuff.findRoot

4142 case maybeRoot of

4243 Nothing ->

43− return (Left Exit.InstallNoProject)

44+ return (Left Exit.InstallNoOutline)

4445

4546 Just root ->

4647 case args of

@@ -50,8 +51,8 @@ run args () =

5051

5152 Install pkg ->

5253 Task.run $

53− do env <- getEnv

54− oldOutline <- getOutline root

54+ do env <- Task.eio Exit.InstallBadRegistry $ Solver.initEnv

55+ oldOutline <- Task.eio Exit.InstallBadOutline $ Outline.read root

5556 case oldOutline of

5657 Outline.App outline ->

5758 do changes <- makeAppPlan env pkg outline

@@ -63,23 +64,6 @@ run args () =

6364

6465

6566

66−getEnv :: Task Solver.Env

67−getEnv =

68− do eitherEnv <- Task.io Solver.initEnv

69− case eitherEnv of

70− Right env -> return env

71− Left problem -> Task.throw (error "TODO getEnv" problem)

72−

73−

74−getOutline :: FilePath -> Task Outline.Outline

75−getOutline root =

76− do eitherOutline <- Task.io (Outline.read root)

77− case eitherOutline of

78− Right outline -> return outline

79− Left exit -> Task.throw (error "TODO getOutline" exit)

80−

81−

82−

8367-- ATTEMPT CHANGES

8468

8569

@@ -140,12 +124,13 @@ attemptChanges root env oldOutline toChars changes =

140124

141125attemptChangesHelp :: FilePath -> Solver.Env -> Outline.Outline -> Outline.Outline -> D.Doc -> Task ()

142126attemptChangesHelp root env oldOutline newOutline question =

143− Task.eio Exit.InstallHasBadDetails $

127+ Task.eio Exit.InstallBadDetails $

128+ BW.withScope $ \scope ->

144129 do approved <- Reporting.ask question

145130 if approved

146131 then

147132 do Outline.write root newOutline

148− result <- Details.verifyInstall root env newOutline

133+ result <- Details.verifyInstall scope root env newOutline

149134 case result of

150135 Left exit ->

151136 do Outline.write root oldOutline

@@ -203,8 +188,8 @@ makeAppPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.AppOut

203188 case Registry.getVersions' pkg registry of

204189 Left suggestions ->

205190 case connection of

206− Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline suggestions)

207− Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline suggestions)

191+ Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions)

192+ Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions)

208193

209194 Right _ ->

210195 do result <- Task.io $ Solver.addToApp cache connection registry pkg outline

@@ -213,10 +198,10 @@ makeAppPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.AppOut

213198 return (Changes (detectChanges old new) (Outline.App app))

214199

215200 Solver.NoSolution ->

216− Task.throw Exit.InstallNoOnlineSolution

201+ Task.throw (Exit.InstallNoOnlineAppSolution pkg)

217202

218203 Solver.NoOfflineSolution ->

219− Task.throw Exit.InstallNoOfflineSolution

204+ Task.throw (Exit.InstallNoOfflineAppSolution pkg)

220205

221206 Solver.Err exit ->

222207 Task.throw (Exit.InstallHadSolverTrouble exit)

@@ -245,8 +230,8 @@ makePkgPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.PkgOut

245230 case Registry.getVersions' pkg registry of

246231 Left suggestions ->

247232 case connection of

248− Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline suggestions)

249− Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline suggestions)

233+ Solver.Online _ -> Task.throw (Exit.InstallUnknownPackageOnline pkg suggestions)

234+ Solver.Offline -> Task.throw (Exit.InstallUnknownPackageOffline pkg suggestions)

250235

251236 Right (Registry.KnownVersions _ _) ->

252237 do let old = Map.union deps test

@@ -269,10 +254,10 @@ makePkgPlan (Solver.Env cache _ connection registry) pkg outline@(Outline.PkgOut

269254 }

270255

271256 Solver.NoSolution ->

272− Task.throw Exit.InstallNoOnlineSolution

257+ Task.throw (Exit.InstallNoOnlinePkgSolution pkg)

273258

274259 Solver.NoOfflineSolution ->

275− Task.throw Exit.InstallNoOfflineSolution

260+ Task.throw (Exit.InstallNoOfflinePkgSolution pkg)

276261

277262 Solver.Err exit ->

278263 Task.throw (Exit.InstallHadSolverTrouble exit)

terminal/src/Main.hs+22−22

@@ -12,8 +12,8 @@ import Text.PrettyPrint.ANSI.Leijen ((<>))

1212import Text.Read (readMaybe)

1313

1414import qualified Elm.Version as V

15−import Terminal.Args

16−import Terminal.Args.Helpers

15+import Terminal

16+import Terminal.Helpers

1717

1818import qualified Bump

1919import qualified Develop

@@ -31,7 +31,7 @@ import qualified Repl

3131

3232main :: IO ()

3333main =

34− complex intro outro

34+ Terminal.app intro outro

3535 [ repl

3636 , init

3737 , reactor

@@ -72,7 +72,7 @@ outro =

7272-- INIT

7373

7474

75−init :: Interface

75+init :: Terminal.Command

7676init =

7777 let

7878 summary =

@@ -87,14 +87,14 @@ init =

8787 "It will ask permission to create an elm.json file, the one thing common\

8888 \ to all Elm projects. It also provides a link explaining what to do from there."

8989 in

90− Interface "init" (Common summary) details example noArgs noFlags Init.run

90+ Terminal.Command "init" (Common summary) details example noArgs noFlags Init.run

9191

9292

9393

9494-- REPL

9595

9696

97−repl :: Interface

97+repl :: Terminal.Command

9898repl =

9999 let

100100 summary =

@@ -115,7 +115,7 @@ repl =

115115 |-- flag "interpreter" interpreter "Path to a alternate JS interpreter, like node or nodejs."

116116 |-- onOff "no-colors" "Turn off the colors in the REPL. This can help if you are having trouble reading the values. Some terminals use a custom color scheme that diverges significantly from the standard ANSI colors, so another path may be to pick a more standard color scheme."

117117 in

118− Interface "repl" (Common summary) details example noArgs replFlags Repl.run

118+ Terminal.Command "repl" (Common summary) details example noArgs replFlags Repl.run

119119

120120

121121interpreter :: Parser String

@@ -133,7 +133,7 @@ interpreter =

133133-- REACTOR

134134

135135

136−reactor :: Interface

136+reactor :: Terminal.Command

137137reactor =

138138 let

139139 summary =

@@ -154,7 +154,7 @@ reactor =

154154 flags Develop.Flags

155155 |-- flag "port" port_ "The port of the server (default: 8000)"

156156 in

157− Interface "reactor" (Common summary) details example noArgs reactorFlags Develop.run

157+ Terminal.Command "reactor" (Common summary) details example noArgs reactorFlags Develop.run

158158

159159

160160port_ :: Parser Int

@@ -172,7 +172,7 @@ port_ =

172172-- MAKE

173173

174174

175−make :: Interface

175+make :: Terminal.Command

176176make =

177177 let

178178 details =

@@ -184,8 +184,8 @@ make =

184184 "For example:"

185185 , P.indent 4 $ P.green "elm make src/Main.elm"

186186 , reflow

187− "This tries to compile an Elm file named src/Main.elm, putting the resulting\

188− \ JavaScript code in an elm.js file."

187+ "This tries to compile an Elm file named src/Main.elm, generating an index.html\

188+ \ file if possible."

189189 ]

190190

191191 makeFlags =

@@ -196,14 +196,14 @@ make =

196196 |-- flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!"

197197 |-- flag "docs" Make.docsFile "Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly."

198198 in

199− Interface "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run

199+ Terminal.Command "make" Uncommon details example (zeroOrMore elmFile) makeFlags Make.run

200200

201201

202202

203203-- INSTALL

204204

205205

206−install :: Interface

206+install :: Terminal.Command

207207install =

208208 let

209209 details =

@@ -232,14 +232,14 @@ install =

232232 , require1 Install.Install package

233233 ]

234234 in

235− Interface "install" Uncommon details example installArgs noFlags Install.run

235+ Terminal.Command "install" Uncommon details example installArgs noFlags Install.run

236236

237237

238238

239239-- PUBLISH

240240

241241

242−publish :: Interface

242+publish :: Terminal.Command

243243publish =

244244 let

245245 details =

@@ -266,17 +266,17 @@ publish =

266266 \ it ends up as an experiment on GitHub only. Point is, try to be\

267267 \ respectful of the community and package ecosystem!"

268268 , reflow

269− "Check out <TODO> for guidance on how to create great packages!"

269+ "Check out <https://package.elm-lang.org/help/design-guidelines> for guidance on how to create great packages!"

270270 ]

271271 in

272− Interface "publish" Uncommon details example noArgs noFlags Publish.run

272+ Terminal.Command "publish" Uncommon details example noArgs noFlags Publish.run

273273

274274

275275

276276-- BUMP

277277

278278

279−bump :: Interface

279+bump :: Terminal.Command

280280bump =

281281 let

282282 details =

@@ -289,14 +289,14 @@ bump =

289289 \ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\

290290 \ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Elm!"

291291 in

292− Interface "bump" Uncommon details example noArgs noFlags Bump.run

292+ Terminal.Command "bump" Uncommon details example noArgs noFlags Bump.run

293293

294294

295295

296296-- DIFF

297297

298298

299−diff :: Interface

299+diff :: Terminal.Command

300300diff =

301301 let

302302 details =

@@ -321,7 +321,7 @@ diff =

321321 , require3 Diff.GlobalInquiry package version version

322322 ]

323323 in

324− Interface "diff" Uncommon details example diffArgs noFlags Diff.run

324+ Terminal.Command "diff" Uncommon details example diffArgs noFlags Diff.run

325325

326326

327327

terminal/src/Make.hs+82−251

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}

1+{-# LANGUAGE OverloadedStrings #-}

22module Make

33 ( Flags(..)

44 , Output(..)

@@ -11,32 +11,25 @@ module Make

1111 where

1212

1313

14−import Control.Concurrent (MVar, forkIO, newEmptyMVar, newMVar, putMVar, readMVar)

15−import Control.Monad (liftM2)

1614import qualified Data.ByteString.Builder as B

17−import qualified Data.Map as Map

1815import qualified Data.Maybe as Maybe

1916import qualified Data.NonEmptyList as NE

17+import qualified System.Directory as Dir

2018import qualified System.FilePath as FP

2119

2220import qualified AST.Optimized as Opt

21+import qualified BackgroundWriter as BW

2322import qualified Build

24−import qualified Elm.Compiler.Type.Extract as Extract

2523import qualified Elm.Details as Details

26−import qualified Elm.Interface as I

2724import qualified Elm.ModuleName as ModuleName

28−import qualified Elm.Outline as Outline

29−import qualified Elm.Package as Pkg

3025import qualified File

26+import qualified Generate

3127import qualified Generate.Html as Html

32−import qualified Generate.JavaScript as Generate

33−import qualified Generate.Mode as Mode

34−import qualified Nitpick.Debug as Nitpick

3528import qualified Reporting

3629import qualified Reporting.Exit as Exit

3730import qualified Reporting.Task as Task

3831import qualified Stuff

39−import Terminal.Args (Parser(..))

32+import Terminal (Parser(..))

4033

4134

4235

@@ -71,54 +64,58 @@ type Task a = Task.Task Exit.Make a

7164

7265

7366run :: [FilePath] -> Flags -> IO ()

74−run paths (Flags debug optimize maybeOutput report maybeDocs) =

67+run paths flags@(Flags _ _ _ report _) =

7568 do style <- getStyle report

76− Reporting.attemptWithStyle style Exit.makeToReport $ Task.run $

77− do root <- getRoot

78− desiredMode <- getMode debug optimize

79− details <- getDetails style root

80− case paths of

81− [] ->

82− do exposed <- getExposed details

83− buildExposed style root details maybeDocs exposed

84− return ()

85−

86− p:ps ->

87− do artifacts <- buildPaths style root details (NE.List p ps)

88− case maybeOutput of

89− Nothing ->

90− case getMains artifacts of

91− [] ->

92− return ()

93−

94− [name] ->

95− do builder <- toBuilder root details desiredMode artifacts

96− generate style "index.html" (Html.sandwich name builder) (NE.List name [])

97−

98− name:names ->

99− do builder <- toBuilder root details desiredMode artifacts

100− generate style "elm.js" builder (NE.List name names)

101−

102− Just DevNull ->

103− return ()

104−

105− Just (JS target) ->

106− case getNoMains artifacts of

107− [] ->

108− do builder <- toBuilder root details desiredMode artifacts

109− generate style target builder (getMainNames artifacts)

110−

111− name:names ->

112− Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)

113−

114− Just (Html target) ->

115− case hasOneMain artifacts of

116− Just name ->

117− do builder <- toBuilder root details desiredMode artifacts

118− generate style target (Html.sandwich name builder) (NE.List name [])

119−

120− Nothing ->

121− Task.throw Exit.MakeMultipleFilesIntoHtml

69+ maybeRoot <- Stuff.findRoot

70+ Reporting.attemptWithStyle style Exit.makeToReport $

71+ case maybeRoot of

72+ Just root -> runHelp root paths style flags

73+ Nothing -> return $ Left $ Exit.MakeNoOutline

74+

75+

76+runHelp :: FilePath -> [FilePath] -> Reporting.Style -> Flags -> IO (Either Exit.Make ())

77+runHelp root paths style (Flags debug optimize maybeOutput _ maybeDocs) =

78+ BW.withScope $ \scope ->

79+ Stuff.withRootLock root $ Task.run $

80+ do desiredMode <- getMode debug optimize

81+ details <- Task.eio Exit.MakeBadDetails (Details.load style scope root)

82+ case paths of

83+ [] ->

84+ do exposed <- getExposed details

85+ buildExposed style root details maybeDocs exposed

86+

87+ p:ps ->

88+ do artifacts <- buildPaths style root details (NE.List p ps)

89+ case maybeOutput of

90+ Nothing ->

91+ case getMains artifacts of

92+ [] ->

93+ return ()

94+

95+ [name] ->

96+ do builder <- toBuilder root details desiredMode artifacts

97+ generate style "index.html" (Html.sandwich name builder) (NE.List name [])

98+

99+ name:names ->

100+ do builder <- toBuilder root details desiredMode artifacts

101+ generate style "elm.js" builder (NE.List name names)

102+

103+ Just DevNull ->

104+ return ()

105+

106+ Just (JS target) ->

107+ case getNoMains artifacts of

108+ [] ->

109+ do builder <- toBuilder root details desiredMode artifacts

110+ generate style target builder (Build.getRootNames artifacts)

111+

112+ name:names ->

113+ Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names)

114+

115+ Just (Html target) ->

116+ do name <- hasOneMain artifacts

117+ builder <- toBuilder root details desiredMode artifacts

118+ generate style target (Html.sandwich name builder) (NE.List name [])

122119

123120

124121

@@ -132,14 +129,6 @@ getStyle report =

132129 Just Json -> return Reporting.json

133130

134131

135−getRoot :: Task FilePath

136−getRoot =

137− do maybeRoot <- Task.io Stuff.findRoot

138− case maybeRoot of

139− Nothing -> Task.throw Exit.MakeNeedsOutline

140− Just root -> return root

141−

142−

143132getMode :: Bool -> Bool -> Task DesiredMode

144133getMode debug optimize =

145134 case (debug, optimize) of

@@ -149,18 +138,13 @@ getMode debug optimize =

149138 (False, True ) -> return Prod

150139

151140

152−getDetails :: Reporting.Style -> FilePath -> Task Details.Details

153−getDetails style root =

154− Task.eio Exit.MakeBlockedByDetailsProblem (Details.load style root)

155−

156−

157141getExposed :: Details.Details -> Task (NE.List ModuleName.Raw)

158−getExposed (Details.Details _ validOutline _ _ _) =

142+getExposed (Details.Details _ validOutline _ _ _ _) =

159143 case validOutline of

160144 Details.ValidApp _ ->

161145 Task.throw Exit.MakeAppNeedsFileNames

162146

163− Details.ValidPkg _ exposed ->

147+ Details.ValidPkg _ exposed _ ->

164148 case exposed of

165149 [] -> Task.throw Exit.MakePkgNeedsExposing

166150 m:ms -> return (NE.List m ms)

@@ -182,7 +166,7 @@ buildExposed style root details maybeDocs exposed =

182166buildPaths :: Reporting.Style -> FilePath -> Details.Details -> NE.List FilePath -> Task Build.Artifacts

183167buildPaths style root details paths =

184168 Task.eio Exit.MakeCannotBuild $

185− Build.fromMains style root details paths

169+ Build.fromPaths style root details paths

186170

187171

188172

@@ -190,13 +174,13 @@ buildPaths style root details paths =

190174

191175

192176getMains :: Build.Artifacts -> [ModuleName.Raw]

193−getMains (Build.Artifacts _ _ mains modules) =

194− Maybe.mapMaybe (getMain modules) (NE.toList mains)

177+getMains (Build.Artifacts _ _ roots modules) =

178+ Maybe.mapMaybe (getMain modules) (NE.toList roots)

195179

196180

197−getMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw

198−getMain modules main =

199− case main of

181+getMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw

182+getMain modules root =

183+ case root of

200184 Build.Inside name ->

201185 if any (isMain name) modules

202186 then Just name

@@ -222,11 +206,11 @@ isMain targetName modul =

222206-- HAS ONE MAIN

223207

224208

225−hasOneMain :: Build.Artifacts -> Maybe ModuleName.Raw

226−hasOneMain (Build.Artifacts _ _ mains modules) =

227− case mains of

228− NE.List main [] -> getMain modules main

229− NE.List _ (_:_) -> Nothing

209+hasOneMain :: Build.Artifacts -> Task ModuleName.Raw

210+hasOneMain (Build.Artifacts _ _ roots modules) =

211+ case roots of

212+ NE.List root [] -> Task.mio Exit.MakeNoMain (return $ getMain modules root)

213+ NE.List _ (_:_) -> Task.throw Exit.MakeMultipleFilesIntoHtml

230214

231215

232216

@@ -234,13 +218,13 @@ hasOneMain (Build.Artifacts _ _ mains modules) =

234218

235219

236220getNoMains :: Build.Artifacts -> [ModuleName.Raw]

237−getNoMains (Build.Artifacts _ _ mains modules) =

238− Maybe.mapMaybe (getNoMain modules) (NE.toList mains)

221+getNoMains (Build.Artifacts _ _ roots modules) =

222+ Maybe.mapMaybe (getNoMain modules) (NE.toList roots)

239223

240224

241−getNoMain :: [Build.Module] -> Build.Main -> Maybe ModuleName.Raw

242−getNoMain modules main =

243− case main of

225+getNoMain :: [Build.Module] -> Build.Root -> Maybe ModuleName.Raw

226+getNoMain modules root =

227+ case root of

244228 Build.Inside name ->

245229 if any (isMain name) modules

246230 then Nothing

@@ -253,29 +237,14 @@ getNoMain modules main =

253237

254238

255239

256−-- GET MAIN NAMES

257−

258−

259−getMainNames :: Build.Artifacts -> NE.List ModuleName.Raw

260−getMainNames (Build.Artifacts _ _ mains _) =

261− fmap getMainName mains

262−

263−

264−getMainName :: Build.Main -> ModuleName.Raw

265−getMainName main =

266− case main of

267− Build.Inside name -> name

268− Build.Outside name _ _ -> name

269−

270−

271−

272240-- GENERATE

273241

274242

275243generate :: Reporting.Style -> FilePath -> B.Builder -> NE.List ModuleName.Raw -> Task ()

276244generate style target builder names =

277245 Task.io $

278− do File.writeBuilder target builder

246+ do Dir.createDirectoryIfMissing True (FP.takeDirectory target)

247+ File.writeBuilder target builder

279248 Reporting.reportGenerate style names target

280249

281250

@@ -287,150 +256,12 @@ data DesiredMode = Debug | Dev | Prod

287256

288257

289258toBuilder :: FilePath -> Details.Details -> DesiredMode -> Build.Artifacts -> Task B.Builder

290−toBuilder root details desiredMode (Build.Artifacts pkg ifaces roots modules) =

291− case desiredMode of

292− Debug ->

293− do loading <- loadObjects root details modules

294− types <- loadTypes root ifaces modules

295− objects <- finalizeObjects loading

296− let mode = Mode.Dev (Just types)

297− let graph = toGlobalGraph objects

298− let mains = gatherMains pkg objects roots

299− return $ Generate.generate mode graph mains

300−

301− Dev ->

302− do objects <- finalizeObjects =<< loadObjects root details modules

303− let mode = Mode.Dev Nothing

304− let graph = toGlobalGraph objects

305− let mains = gatherMains pkg objects roots

306− return $ Generate.generate mode graph mains

307−

308− Prod ->

309− do objects <- finalizeObjects =<< loadObjects root details modules

310− checkForDebugUses objects

311− let graph = toGlobalGraph objects

312− let mode = Mode.Prod (Mode.shortenFieldNames graph)

313− let mains = gatherMains pkg objects roots

314− return $ Generate.generate mode graph mains

315−

316−

317−checkForDebugUses :: LoadedObjects -> Task ()

318−checkForDebugUses (LoadedObjects _ locals) =

319− case Map.keys (Map.filter Nitpick.hasDebugUses locals) of

320− [] -> return ()

321− m:ms -> Task.throw (Exit.MakeCannotOptimizeDebugValues m ms)

322−

323−

324−toGlobalGraph :: LoadedObjects -> Opt.GlobalGraph

325−toGlobalGraph (LoadedObjects globals locals) =

326− foldr Opt.addLocalGraph globals locals

327−

328−

329−

330−-- LOAD OBJECTS

331−

332−

333−data LoadingObjects =

334− LoadingObjects

335− { _foreign_mvar :: MVar (Maybe Opt.GlobalGraph)

336− , _local_mvars :: Map.Map ModuleName.Raw (MVar (Maybe Opt.LocalGraph))

337− }

338−

339−

340−loadObjects :: FilePath -> Details.Details -> [Build.Module] -> Task LoadingObjects

341−loadObjects root details modules =

342− Task.io $

343− do mvar <- Details.loadObjects root details

344− mvars <- traverse (loadObject root) modules

345− return $ LoadingObjects mvar (Map.fromList mvars)

346−

347−

348−loadObject :: FilePath -> Build.Module -> IO (ModuleName.Raw, MVar (Maybe Opt.LocalGraph))

349−loadObject root modul =

350− case modul of

351− Build.Fresh name _ graph ->

352− do mvar <- newMVar (Just graph)

353− return (name, mvar)

354−

355− Build.Cached name _ _ ->

356− do mvar <- newEmptyMVar

357− _ <- forkIO $ putMVar mvar =<< File.readBinary (Stuff.elmo root name)

358− return (name, mvar)

359−

360−

361−data LoadedObjects =

362− LoadedObjects

363− { _foreign :: Opt.GlobalGraph

364− , _locals :: Map.Map ModuleName.Raw Opt.LocalGraph

365− }

366−

367−

368−finalizeObjects :: LoadingObjects -> Task LoadedObjects

369−finalizeObjects (LoadingObjects mvar mvars) =

370− Task.eio id $

371− do result <- readMVar mvar

372− results <- traverse readMVar mvars

373− case liftM2 LoadedObjects result (sequence results) of

374− Just loaded -> return (Right loaded)

375− Nothing -> return (Left Exit.MakeCannotLoadArtifacts)

376−

377−

378−

379−-- LOAD TYPES

380−

381−

382−loadTypes :: FilePath -> Map.Map ModuleName.Canonical I.DependencyInterface -> [Build.Module] -> Task Extract.Types

383−loadTypes root ifaces modules =

384− Task.eio id $

385− do mvars <- traverse (loadTypesHelp root) modules

386− let !foreigns = Extract.mergeMany (Map.elems (Map.mapWithKey Extract.fromDependencyInterface ifaces))

387− results <- traverse readMVar mvars

388− case sequence results of

389− Just ts -> return (Right (Extract.merge foreigns (Extract.mergeMany ts)))

390− Nothing -> return (Left Exit.MakeCannotLoadArtifacts)

391−

392−

393−loadTypesHelp :: FilePath -> Build.Module -> IO (MVar (Maybe Extract.Types))

394−loadTypesHelp root modul =

395− case modul of

396− Build.Fresh name iface _ ->

397− newMVar (Just (Extract.fromInterface name iface))

398−

399− Build.Cached name _ ciMVar ->

400− do cachedInterface <- readMVar ciMVar

401− case cachedInterface of

402− Build.Unneeded ->

403− do mvar <- newEmptyMVar

404− _ <- forkIO $

405− do maybeIface <- File.readBinary (Stuff.elmo root name)

406− putMVar mvar (Extract.fromInterface name <$> maybeIface)

407− return mvar

408−

409− Build.Loaded iface ->

410− newMVar (Just (Extract.fromInterface name iface))

411−

412− Build.Corrupted ->

413− newMVar Nothing

414−

415−

416−

417−-- GATHER MAINS

418−

419−

420−gatherMains :: Pkg.Name -> LoadedObjects -> NE.List Build.Main -> Map.Map ModuleName.Canonical Opt.Main

421−gatherMains pkg (LoadedObjects _ locals) buildMains =

422− Map.fromList $ Maybe.mapMaybe (lookupMain pkg locals) (NE.toList buildMains)

423−

424−

425−lookupMain :: Pkg.Name -> Map.Map ModuleName.Raw Opt.LocalGraph -> Build.Main -> Maybe (ModuleName.Canonical, Opt.Main)

426−lookupMain pkg locals buildMain =

427− let

428− toPair name (Opt.LocalGraph maybeMain _ _) =

429− (,) (ModuleName.Canonical pkg name) <$> maybeMain

430− in

431− case buildMain of

432− Build.Inside name -> toPair name =<< Map.lookup name locals

433− Build.Outside name _ g -> toPair name g

259+toBuilder root details desiredMode artifacts =

260+ Task.mapError Exit.MakeBadGenerate $

261+ case desiredMode of

262+ Debug -> Generate.debug root details artifacts

263+ Dev -> Generate.dev root details artifacts

264+ Prod -> Generate.prod root details artifacts

434265

435266

436267

terminal/src/Publish.hs+183−107

@@ -8,19 +8,22 @@ module Publish

88import Control.Exception (bracket_)

99import Control.Monad (void)

1010import qualified Data.List as List

11+import qualified Data.NonEmptyList as NE

1112import qualified Data.Utf8 as Utf8

1213import qualified System.Directory as Dir

1314import qualified System.Exit as Exit

14−import qualified System.FilePath as FP

1515import System.FilePath ((</>))

1616import qualified System.Info as Info

1717import qualified System.IO as IO

1818import qualified System.Process as Process

1919

20+import qualified BackgroundWriter as BW

21+import qualified Build

2022import qualified Deps.Bump as Bump

2123import qualified Deps.Diff as Diff

2224import qualified Deps.Registry as Registry

2325import qualified Deps.Website as Website

26+import qualified Elm.Details as Details

2427import qualified Elm.Docs as Docs

2528import qualified Elm.Magnitude as M

2629import qualified Elm.Outline as Outline

@@ -69,22 +72,12 @@ data Env =

6972

7073getEnv :: Task.Task Exit.Publish Env

7174getEnv =

72− do maybeRoot <- Task.io $ Stuff.findRoot

73− case maybeRoot of

74− Nothing ->

75− Task.throw Exit.PublishNoOutline

76−

77− Just root ->

78− do cache <- Task.io $ Stuff.getPackageCache

79− manager <- Task.io $ Http.getManager

80− registry <- Task.eio Exit.PublishMustHaveLatestRegistry $ Registry.latest manager cache

81− outlineResult <- Task.io $ Outline.read root

82− case outlineResult of

83− Right outline ->

84− return $ Env root cache manager registry outline

85−

86− Left problem ->

87− Task.throw $ Exit.PublishBadOutline problem

75+ do root <- Task.mio Exit.PublishNoOutline $ Stuff.findRoot

76+ cache <- Task.io $ Stuff.getPackageCache

77+ manager <- Task.io $ Http.getManager

78+ registry <- Task.eio Exit.PublishMustHaveLatestRegistry $ Registry.latest manager cache

79+ outline <- Task.eio Exit.PublishBadOutline $ Outline.read root

80+ return $ Env root cache manager registry outline

8881

8982

9083

@@ -92,7 +85,7 @@ getEnv =

9285

9386

9487publish :: Env -> Task.Task Exit.Publish ()

95−publish env@(Env root cache manager registry outline) =

88+publish env@(Env root _ manager registry outline) =

9689 case outline of

9790 Outline.App _ ->

9891 Task.throw Exit.PublishApplication

@@ -107,15 +100,16 @@ publish env@(Env root cache manager registry outline) =

107100

108101 verifyReadme root

109102 verifyLicense root

110− docs <- error "TODO Project.generateDocs details" details

103+ docs <- verifyBuild root

111104 verifyVersion env pkg vsn docs maybeKnownVersions

112− commitHash <- verifyTag manager pkg vsn

113− verifyNoChanges commitHash vsn

114− zipHash <- verifyZip manager pkg vsn

105+ git <- getGit

106+ commitHash <- verifyTag git manager pkg vsn

107+ verifyNoChanges git commitHash vsn

108+ zipHash <- verifyZip env pkg vsn

115109

116− register manager pkg vsn commitHash zipHash

117−

118− putStrLn "Success!"

110+ Task.io $ putStrLn ""

111+ register manager pkg vsn docs commitHash zipHash

112+ Task.io $ putStrLn "Success!"

119113

120114

121115

@@ -143,7 +137,7 @@ noExposed exposed =

143137

144138verifyReadme :: FilePath -> Task.Task Exit.Publish ()

145139verifyReadme root =

146− reportReadmePhase $

140+ reportReadmeCheck $

147141 do let readmePath = root </> "README.md"

148142 exists <- File.exists readmePath

149143 case exists of

@@ -163,7 +157,7 @@ verifyReadme root =

163157

164158verifyLicense :: FilePath -> Task.Task Exit.Publish ()

165159verifyLicense root =

166− reportLicensePhase $

160+ reportLicenseCheck $

167161 do let licensePath = root </> "LICENSE"

168162 exists <- File.exists licensePath

169163 if exists

@@ -172,19 +166,77 @@ verifyLicense root =

172166

173167

174168

169+-- VERIFY BUILD

170+

171+

172+verifyBuild :: FilePath -> Task.Task Exit.Publish Docs.Documentation

173+verifyBuild root =

174+ reportBuildCheck $ BW.withScope $ \scope ->

175+ Task.run $

176+ do details@(Details.Details _ outline _ _ _ _) <-

177+ Task.eio Exit.PublishBadDetails $

178+ Details.load Reporting.silent scope root

179+

180+ exposed <-

181+ case outline of

182+ Details.ValidApp _ -> Task.throw Exit.PublishApplication

183+ Details.ValidPkg _ [] _ -> Task.throw Exit.PublishNoExposed

184+ Details.ValidPkg _ (e:es) _ -> return (NE.List e es)

185+

186+ Task.eio Exit.PublishBuildProblem $

187+ Build.fromExposed Reporting.silent root details Build.KeepDocs exposed

188+

189+

190+-- GET GIT

191+

192+

193+newtype Git =

194+ Git { _run :: [String] -> IO Exit.ExitCode }

195+

196+

197+getGit :: Task.Task Exit.Publish Git

198+getGit =

199+ do maybeGit <- Task.io $ Dir.findExecutable "git"

200+ case maybeGit of

201+ Nothing ->

202+ Task.throw Exit.PublishNoGit

203+

204+ Just git ->

205+ return $ Git $ \args ->

206+ let

207+ process =

208+ (Process.proc git args)

209+ { Process.std_in = Process.CreatePipe

210+ , Process.std_out = Process.CreatePipe

211+ , Process.std_err = Process.CreatePipe

212+ }

213+ in

214+ Process.withCreateProcess process $ \_ _ _ handle ->

215+ Process.waitForProcess handle

216+

217+

218+

175219-- VERIFY GITHUB TAG

176220

177221

178−verifyTag :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish String

179−verifyTag manager pkg vsn =

180− reportTagPhase vsn $

181− Http.post manager (toTagUrl pkg vsn) [Http.accept "application/json"] Exit.PublishCannotGetTag $ \body ->

182− case D.fromByteString commitHashDecoder body of

183− Right hash ->

184− return $ Right hash

222+verifyTag :: Git -> Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish String

223+verifyTag git manager pkg vsn =

224+ reportTagCheck vsn $

225+ do -- https://stackoverflow.com/questions/1064499/how-to-list-all-git-tags

226+ exitCode <- _run git [ "show", "--name-only", V.toChars vsn, "--" ]

227+ case exitCode of

228+ Exit.ExitFailure _ ->

229+ return $ Left (Exit.PublishMissingTag vsn)

185230

186− Left _ ->

187− return $ Left (Exit.PublishMissingTag vsn)

231+ Exit.ExitSuccess ->

232+ let url = toTagUrl pkg vsn in

233+ Http.get manager url [Http.accept "application/json"] (Exit.PublishCannotGetTag vsn) $ \body ->

234+ case D.fromByteString commitHashDecoder body of

235+ Right hash ->

236+ return $ Right hash

237+

238+ Left _ ->

239+ return $ Left (Exit.PublishCannotGetTagData vsn url body)

188240

189241

190242toTagUrl :: Pkg.Name -> V.Version -> String

@@ -202,60 +254,75 @@ commitHashDecoder =

202254-- VERIFY NO LOCAL CHANGES SINCE TAG

203255

204256

205−verifyNoChanges :: String -> V.Version -> Task.Task Exit.Publish ()

206−verifyNoChanges commitHash vsn =

207− reportChangesPhase $

208− do maybeGit <- Dir.findExecutable "git"

209− case maybeGit of

210− Nothing ->

211− return $ Left Exit.PublishNoGit

212−

213− Just git ->

214− do -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes

215− exitCode <- Process.rawSystem git [ "diff-index", "--quiet", commitHash, "--" ]

216− case exitCode of

217− Exit.ExitSuccess -> return $ Right ()

218− Exit.ExitFailure _ -> return $ Left (Exit.PublishLocalChanges vsn)

257+verifyNoChanges :: Git -> String -> V.Version -> Task.Task Exit.Publish ()

258+verifyNoChanges git commitHash vsn =

259+ reportLocalChangesCheck $

260+ do -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes

261+ exitCode <- _run git [ "diff-index", "--quiet", commitHash, "--" ]

262+ case exitCode of

263+ Exit.ExitSuccess -> return $ Right ()

264+ Exit.ExitFailure _ -> return $ Left (Exit.PublishLocalChanges vsn)

219265

220266

221267

222268-- VERIFY THAT ZIP BUILDS / COMPUTE HASH

223269

224270

225−verifyZip :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha

226−verifyZip manager pkg vsn =

227− withTempDir $ \prepublishDir ->

228− do (sha, archive) <-

229− reportDownloadPhase $

230− Http.getArchive manager (toZipUrl pkg vsn)

271+verifyZip :: Env -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha

272+verifyZip (Env root _ manager _ _) pkg vsn =

273+ withPrepublishDir root $ \prepublishDir ->

274+ do let url = toZipUrl pkg vsn

275+

276+ (sha, archive) <-

277+ reportDownloadCheck $

278+ Http.getArchive manager url

231279 Exit.PublishCannotGetZip

232− Exit.PublishCannotDecodeZip

280+ (Exit.PublishCannotDecodeZip url)

233281 (return . Right)

234282

235283 Task.io $ File.writePackage prepublishDir archive

236284

237− reportBuildPhase $

285+ reportZipBuildCheck $

238286 Dir.withCurrentDirectory prepublishDir $

239− do error "TODO Build.generateDocs"

240− return ()

287+ verifyZipBuild prepublishDir

241288

242289 return sha

243290

244291

245−withTempDir :: FilePath -> (FilePath -> IO a) -> IO a

246−withTempDir root callback =

292+toZipUrl :: Pkg.Name -> V.Version -> String

293+toZipUrl pkg vsn =

294+ "https://github.com/" ++ Pkg.toUrl pkg ++ "/zipball/" ++ V.toChars vsn ++ "/"

295+

296+

297+withPrepublishDir :: FilePath -> (FilePath -> Task.Task x a) -> Task.Task x a

298+withPrepublishDir root callback =

247299 let

248300 dir = Stuff.prepublishDir root

249301 in

250− bracket_

251− (Dir.createDirectoryIfMissing True dir)

252− (Dir.removeDirectoryRecursive dir)

253− (callback dir)

302+ Task.eio id $

303+ bracket_

304+ (Dir.createDirectoryIfMissing True dir)

305+ (Dir.removeDirectoryRecursive dir)

306+ (Task.run (callback dir))

254307

255308

256−toZipUrl :: Pkg.Name -> V.Version -> String

257−toZipUrl pkg vsn =

258− "https://github.com/" ++ Pkg.toUrl pkg ++ "/zipball/" ++ V.toChars vsn ++ "/"

309+verifyZipBuild :: FilePath -> IO (Either Exit.Publish ())

310+verifyZipBuild root =

311+ BW.withScope $ \scope -> Task.run $

312+ do details@(Details.Details _ outline _ _ _ _) <-

313+ Task.eio Exit.PublishZipBadDetails $

314+ Details.load Reporting.silent scope root

315+

316+ exposed <-

317+ case outline of

318+ Details.ValidApp _ -> Task.throw Exit.PublishZipApplication

319+ Details.ValidPkg _ [] _ -> Task.throw Exit.PublishZipNoExposed

320+ Details.ValidPkg _ (e:es) _ -> return (NE.List e es)

321+

322+ _ <- Task.eio Exit.PublishZipBuildProblem $

323+ Build.fromExposed Reporting.silent root details Build.KeepDocs exposed

324+

325+ return ()

259326

260327

261328

@@ -269,7 +336,7 @@ data GoodVersion

269336

270337verifyVersion :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Maybe Registry.KnownVersions -> Task.Task Exit.Publish ()

271338verifyVersion env pkg vsn newDocs publishedVersions =

272− reportVersionPhase vsn $

339+ reportSemverCheck vsn $

273340 case publishedVersions of

274341 Nothing ->

275342 if vsn == V.one

@@ -293,7 +360,7 @@ verifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.Kno

293360 do result <- Diff.getDocs cache manager pkg old

294361 case result of

295362 Left dp ->

296− return $ Left $ Exit.PublishCannotGetDocs dp

363+ return $ Left $ Exit.PublishCannotGetDocs old new dp

297364

298365 Right oldDocs ->

299366 let

@@ -311,8 +378,8 @@ verifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.Kno

311378-- REGISTER PACKAGES

312379

313380

314−register :: Http.Manager -> Pkg.Name -> V.Version -> String -> Http.Sha -> Task.Task Exit.Publish ()

315−register manager pkg vsn commitHash sha =

381+register :: Http.Manager -> Pkg.Name -> V.Version -> Docs.Documentation -> String -> Http.Sha -> Task.Task Exit.Publish ()

382+register manager pkg vsn docs commitHash sha =

316383 let

317384 url =

318385 Website.route "/register"

@@ -324,7 +391,7 @@ register manager pkg vsn commitHash sha =

324391 Task.eio Exit.PublishCannotRegister $

325392 Http.upload manager url

326393 [ Http.filePart "elm.json" "elm.json"

327− , Http.filePart "docs.json" (error "TODO generate docs, maybe in memory only?")

394+ , Http.jsonPart "docs.json" "docs.json" (Docs.encode docs)

328395 , Http.filePart "README.md" "README.md"

329396 , Http.stringPart "github-hash" (Http.shaToChars sha)

330397 ]

@@ -334,38 +401,47 @@ register manager pkg vsn commitHash sha =

334401-- REPORTING

335402

336403

337−reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> IO ()

404+reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> Task.Task x ()

338405reportPublishStart pkg vsn maybeKnownVersions =

406+ Task.io $

339407 case maybeKnownVersions of

340408 Nothing ->

341409 putStrLn $ Exit.newPackageOverview ++ "\nI will now verify that everything is in order...\n"

342410

343411 Just _ ->

344− putStrLn $ "Verifying" ++ Pkg.toChars pkg ++ V.toChars vsn ++ "...\n"

412+ putStrLn $ "Verifying " ++ Pkg.toChars pkg ++ " " ++ V.toChars vsn ++ " ...\n"

345413

346414

347415

348416-- REPORTING PHASES

349417

350418

351−reportReadmePhase :: IO (Either x a) -> Task.Task x a

352−reportReadmePhase =

353− reportPhase

419+reportReadmeCheck :: IO (Either x a) -> Task.Task x a

420+reportReadmeCheck =

421+ reportCheck

354422 "Looking for README.md"

355423 "Found README.md"

356424 "Problem with your README.md"

357425

358426

359−reportLicensePhase :: IO (Either x a) -> Task.Task x a

360−reportLicensePhase =

361− reportPhase

427+reportLicenseCheck :: IO (Either x a) -> Task.Task x a

428+reportLicenseCheck =

429+ reportCheck

362430 "Looking for LICENSE"

363431 "Found LICENSE"

364432 "Problem with your LICENSE"

365433

366434

367−reportVersionPhase :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()

368−reportVersionPhase version work =

435+reportBuildCheck :: IO (Either x a) -> Task.Task x a

436+reportBuildCheck =

437+ reportCheck

438+ "Verifying documentation..."

439+ "Verified documentation"

440+ "Problem with documentation"

441+

442+

443+reportSemverCheck :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()

444+reportSemverCheck version work =

369445 let

370446 vsn = V.toChars version

371447

@@ -381,48 +457,48 @@ reportVersionPhase version work =

381457 ++ M.toChars magnitude ++ " change, "

382458 ++ V.toChars oldVersion ++ " => " ++ vsn ++ ")"

383459 in

384− void $ reportCustomPhase waiting success failure work

460+ void $ reportCustomCheck waiting success failure work

385461

386462

387−reportTagPhase :: V.Version -> IO (Either x a) -> Task.Task x a

388−reportTagPhase vsn =

389− reportPhase

463+reportTagCheck :: V.Version -> IO (Either x a) -> Task.Task x a

464+reportTagCheck vsn =

465+ reportCheck

390466 ("Is version " ++ V.toChars vsn ++ " tagged on GitHub?")

391467 ("Version " ++ V.toChars vsn ++ " is tagged on GitHub")

392468 ("Version " ++ V.toChars vsn ++ " is not tagged on GitHub!")

393469

394470

395−reportDownloadPhase :: IO (Either x a) -> Task.Task x a

396−reportDownloadPhase =

397− reportPhase

471+reportDownloadCheck :: IO (Either x a) -> Task.Task x a

472+reportDownloadCheck =

473+ reportCheck

398474 "Downloading code from GitHub..."

399475 "Code downloaded successfully from GitHub"

400476 "Could not download code from GitHub!"

401477

402478

403−reportBuildPhase :: IO (Either x a) -> Task.Task x a

404−reportBuildPhase =

405− reportPhase

406− "Building downloaded code and generated docs..."

407− "Downloaded code compiles successfully / docs generated\n"

408− "Cannot compile downloaded code!"

409−

410−

411−reportChangesPhase :: IO (Either x a) -> Task.Task x a

412−reportChangesPhase =

413− reportPhase

479+reportLocalChangesCheck :: IO (Either x a) -> Task.Task x a

480+reportLocalChangesCheck =

481+ reportCheck

414482 "Checking for uncommitted changes..."

415483 "No uncommitted changes in local code"

416484 "Your local code is different than the code tagged on GitHub"

417485

418486

419−reportPhase :: String -> String -> String -> IO (Either x a) -> Task.Task x a

420−reportPhase waiting success failure work =

421− reportCustomPhase waiting (\_ -> success) failure work

487+reportZipBuildCheck :: IO (Either x a) -> Task.Task x a

488+reportZipBuildCheck =

489+ reportCheck

490+ "Verifying downloaded code..."

491+ "Downloaded code compiles successfully"

492+ "Cannot compile downloaded code!"

493+

494+

495+reportCheck :: String -> String -> String -> IO (Either x a) -> Task.Task x a

496+reportCheck waiting success failure work =

497+ reportCustomCheck waiting (\_ -> success) failure work

422498

423499

424−reportCustomPhase :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a

425−reportCustomPhase waiting success failure work =

500+reportCustomCheck :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a

501+reportCustomCheck waiting success failure work =

426502 let

427503 putFlush doc =

428504 Help.toStdout doc >> IO.hFlush IO.stdout

terminal/src/Repl.hs+522−197

@@ -1,23 +1,36 @@

1+{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}

12{-# LANGUAGE OverloadedStrings #-}

23module Repl

34 ( Flags(..)

45 , run

6+ --

7+ , Lines(..)

8+ , Input(..)

9+ , Prefill(..)

10+ , CategorizedInput(..)

11+ , categorize

12+ --

13+ , State(..)

14+ , Output(..)

15+ , toByteString

516 )

617 where

718

819

920import Prelude hiding (lines, read)

1021import Control.Applicative ((<|>))

11−import Control.Monad.RWS (lift, liftIO)

12−import qualified Control.Monad.RWS as RWS

22+import Control.Monad.Trans (lift, liftIO)

23+import qualified Control.Monad.State.Strict as State

24+import qualified Data.ByteString as BS

1325import qualified Data.ByteString.Builder as B

26+import qualified Data.ByteString.Char8 as BSC

1427import qualified Data.ByteString.Lazy as LBS

28+import qualified Data.ByteString.UTF8 as BS_UTF8

29+import qualified Data.Char as Char

1530import qualified Data.List as List

1631import qualified Data.Map as Map

1732import Data.Monoid ((<>))

18−import qualified Data.Name as Name

19−import qualified Data.Text as Text

20−import qualified Data.Text.Encoding as Text

33+import qualified Data.Name as N

2134import qualified System.Console.Haskeline as Repl

2235import qualified System.Directory as Dir

2336import qualified System.Exit as Exit

@@ -25,16 +38,35 @@ import System.FilePath ((</>))

2538import qualified System.IO as IO

2639import qualified System.Process as Proc

2740

28−import qualified Elm.Compiler as Elm (version)

29−import qualified Elm.Project as Project

41+import qualified AST.Source as Src

42+import qualified BackgroundWriter as BW

43+import qualified Build

44+import qualified Elm.Constraint as C

45+import qualified Elm.Details as Details

46+import qualified Elm.Licenses as Licenses

47+import qualified Elm.ModuleName as ModuleName

48+import qualified Elm.Outline as Outline

3049import qualified Elm.Package as Pkg

31−import qualified Elm.PerUserCache as PerUserCache

32−import qualified Parse.Repl as Elm

50+import qualified Elm.Version as V

51+import qualified Generate

52+import qualified Parse.Expression as PE

53+import qualified Parse.Declaration as PD

54+import qualified Parse.Module as PM

55+import qualified Parse.Primitives as P

56+import qualified Parse.Space as PS

57+import qualified Parse.Type as PT

58+import qualified Parse.Variable as PV

59+import Parse.Primitives (Row, Col)

60+import qualified Reporting

61+import qualified Reporting.Annotation as A

3362import Reporting.Doc ((<+>))

3463import qualified Reporting.Doc as D

64+import qualified Reporting.Error.Syntax as ES

65+import qualified Reporting.Exit as Exit

66+import qualified Reporting.Render.Code as Code

67+import qualified Reporting.Report as Report

3568import qualified Reporting.Task as Task

36−import qualified Reporting.Progress.Repl as Repl

37−import qualified Reporting.Render.Type.Localizer as L

69+import qualified Stuff

3870

3971

4072

@@ -43,174 +75,352 @@ import qualified Reporting.Render.Type.Localizer as L

4375

4476data Flags =

4577 Flags

46− { _interpreter :: Maybe FilePath

78+ { _maybeInterpreter :: Maybe FilePath

4779 , _noColors :: Bool

4880 }

4981

5082

5183run :: () -> Flags -> IO ()

52−run () (Flags maybeAlternateInterpreter noColors) =

53− do interpreter <- getInterpreter maybeAlternateInterpreter

54− _ <- Project.getRootWithReplFallback

55− printWelcomeMessage

84+run () flags =

85+ do printWelcomeMessage

5686 settings <- initSettings

57− let manager = Repl.runInputT settings (Repl.withInterrupt loop)

58− (exitCode,_,_) <- RWS.runRWST manager (interpreter, noColors) initialState

87+ env <- initEnv flags

88+ let looper = Repl.runInputT settings (Repl.withInterrupt (loop env initialState))

89+ exitCode <- State.evalStateT looper initialState

5990 Exit.exitWith exitCode

6091

6192

62−type Runner =

63− RWS.RWST (FilePath, Bool) () State IO

93+

94+-- WELCOME

95+

96+

97+printWelcomeMessage :: IO ()

98+printWelcomeMessage =

99+ let

100+ vsn = V.toChars V.compiler

101+ title = "Elm" <+> D.fromChars vsn

102+ dashes = replicate (70 - length vsn) '-'

103+ in

104+ D.toAnsi IO.stdout $

105+ D.vcat

106+ [ D.black "----" <+> D.dullcyan title <+> D.black (D.fromChars dashes)

107+ , D.black $ D.fromChars $ "Say :help for help and :exit to exit! More at " <> D.makeLink "repl"

108+ , D.black "--------------------------------------------------------------------------------"

109+ , D.empty

110+ ]

111+

112+

113+

114+-- ENV

115+

116+

117+data Env =

118+ Env

119+ { _root :: FilePath

120+ , _interpreter :: FilePath

121+ , _ansi :: Bool

122+ }

123+

124+

125+initEnv :: Flags -> IO Env

126+initEnv (Flags maybeAlternateInterpreter noColors) =

127+ do root <- getRoot

128+ interpreter <- getInterpreter maybeAlternateInterpreter

129+ return $ Env root interpreter (not noColors)

64130

65131

66132

67133-- LOOP

68134

69135

70−loop :: Repl.InputT Runner Exit.ExitCode

71−loop =

136+data Outcome

137+ = Loop State

138+ | End Exit.ExitCode

139+

140+

141+type M =

142+ State.StateT State IO

143+

144+

145+loop :: Env -> State -> Repl.InputT M Exit.ExitCode

146+loop env state =

72147 do input <- Repl.handleInterrupt (return Skip) read

73− maybe loop return =<< lift (eval input)

148+ outcome <- liftIO (eval env state input)

149+ case outcome of

150+ Loop state ->

151+ do lift (State.put state)

152+ loop env state

153+

154+ End exitCode ->

155+ return exitCode

74156

75157

76158

77159-- READ

78160

79161

80−read :: Repl.InputT Runner Input

162+data Input

163+ = Import ModuleName.Raw BS.ByteString

164+ | Type N.Name BS.ByteString

165+ | Port

166+ | Decl N.Name BS.ByteString

167+ | Expr BS.ByteString

168+ --

169+ | Reset

170+ | Exit

171+ | Skip

172+ | Help (Maybe String)

173+

174+

175+read :: Repl.InputT M Input

81176read =

82− readHelp "> " []

177+ do maybeLine <- Repl.getInputLine "> "

178+ case maybeLine of

179+ Nothing ->

180+ return Exit

83181

182+ Just chars ->

183+ let

184+ lines = Lines (stripLegacyBackslash chars) []

185+ in

186+ case categorize lines of

187+ Done input -> return input

188+ Continue p -> readMore lines p

84189

85−readHelp :: String -> [String] -> Repl.InputT Runner Input

86−readHelp starter lines =

87− do input <- Repl.getInputLine starter

190+

191+readMore :: Lines -> Prefill -> Repl.InputT M Input

192+readMore previousLines prefill =

193+ do input <- Repl.getInputLineWithInitial "| " (renderPrefill prefill, "")

88194 case input of

89195 Nothing ->

90− return Exit

196+ return Skip

91197

92− Just line ->

93− if not (null line) && last line == '\\'

94− then readHelp "| " (init line : lines)

95− else return $ toInput $ List.intercalate "\n " $ reverse (line : lines)

198+ Just chars ->

199+ let

200+ lines = addLine (stripLegacyBackslash chars) previousLines

201+ in

202+ case categorize lines of

203+ Done input -> return input

204+ Continue p -> readMore lines p

96205

97206

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+ []

98217

99−-- EVAL

218+ _:_ ->

219+ if last chars == '\\'

220+ then init chars

221+ else chars

100222

101223

102−eval :: Input -> Runner (Maybe Exit.ExitCode)

103−eval input =

104− case input of

105− Skip ->

106− return Nothing

224+data Prefill

225+ = Indent

226+ | DefStart N.Name

107227

108− Exit ->

109− return (Just Exit.ExitSuccess)

110228

111− Reset ->

112− do RWS.put initialState

113− report "<reset>"

229+renderPrefill :: Prefill -> String

230+renderPrefill lineStart =

231+ case lineStart of

232+ Indent ->

233+ " "

114234

115− Help info ->

116− report (helpMessage info)

235+ DefStart name ->

236+ N.toChars name ++ " "

117237

118− Code entry ->

119− Repl.handleInterrupt (report "<cancelled>") $

120− do state@(State _ imports types defs tricks localizer) <- RWS.get

121− case entry of

122− Elm.Import name alias exposing src ->

123− interpret None $

124− state

125− { _imports = Map.insert name src imports

126− , _localizer = L.replAdd name alias exposing localizer

127− }

128238

129− Elm.Type name src ->

130− interpret None $ state { _types = Map.insert name src types }

131239

132− Elm.Def (Just name) src ->

133− interpret (Def name) $ state { _defs = Map.insert name src defs }

240+-- LINES

134241

135− Elm.Def Nothing src ->

136− interpret None $ state { _tricks = src : tricks }

137242

138− Elm.Other src ->

139− interpret (Expr src) state

243+data Lines =

244+ Lines

245+ { _prevLine :: String

246+ , _revLines :: [String]

247+ }

140248

141− Elm.Annotation ->

142− report "I cannot handle type annotations."

143249

144− Elm.Port ->

145− report "I cannot handle port declarations."

250+addLine :: [Char] -> Lines -> Lines

251+addLine line (Lines x xs) =

252+ Lines line (x:xs)

146253

147254

148−report :: String -> Runner (Maybe a)

149−report msg =

150− do liftIO (putStrLn msg)

151− return Nothing

255+isBlank :: Lines -> Bool

256+isBlank (Lines prev rev) =

257+ null rev && all (==' ') prev

152258

153259

154−data Output = None | Def Name.Name | Expr Text.Text

260+isSingleLine :: Lines -> Bool

261+isSingleLine (Lines _ rev) =

262+ null rev

155263

156264

157−interpret :: Output -> State -> Runner (Maybe a)

158−interpret def state =

159− do noColors <- RWS.asks snd

160− result <- liftIO $ Task.try Repl.reporter $ compile noColors def state

265+endsWithBlankLine :: Lines -> Bool

266+endsWithBlankLine (Lines prev _) =

267+ all (==' ') prev

161268

162− case result of

163− Nothing ->

164− return ()

165269

166− Just maybePath ->

167− do RWS.put (state { _count = _count state + 1 })

168− maybe (return ()) interpretHelp maybePath

270+linesToByteString :: Lines -> BS_UTF8.ByteString

271+linesToByteString (Lines prev rev) =

272+ BS_UTF8.fromString (unlines (reverse (prev:rev)))

169273

170− return Nothing

171274

275+getFirstLine :: Lines -> String

276+getFirstLine (Lines x xs) =

277+ case xs of

278+ [] -> x

279+ y:ys -> getFirstLine (Lines y ys)

172280

173−interpretHelp :: FilePath -> Runner ()

174−interpretHelp path =

175− do interpreter <- RWS.asks fst

176− let proc = (Proc.proc interpreter [path]) { Proc.std_in = Proc.CreatePipe }

177− liftIO $ Proc.withCreateProcess proc $ \_ _ _ handle ->

178− do _ <- Proc.waitForProcess handle

179− Dir.removeFile path

180281

181282

182283

183−-- INPUT

284+-- CATEGORIZE INPUT

184285

185286

186−data Input

187− = Skip

188− | Exit

189− | Reset

190− | Help (Maybe String)

191− | Code Elm.Entry

287+data CategorizedInput

288+ = Done Input

289+ | Continue Prefill

290+

291+

292+categorize :: Lines -> CategorizedInput

293+categorize lines

294+ | isBlank lines = Done Skip

295+ | startsWithColon lines = Done (toCommand lines)

296+ | startsWithKeyword "import" lines = attemptImport lines

297+ | otherwise = attemptDeclOrExpr lines

298+

299+

300+attemptImport :: Lines -> CategorizedInput

301+attemptImport lines =

302+ let

303+ src = linesToByteString lines

304+ parser = P.specialize (\_ _ _ -> ()) PM.chompImport

305+ in

306+ case P.fromByteString parser (\_ _ -> ()) src of

307+ Right (Src.Import (A.At _ name) _ _) ->

308+ Done (Import name src)

309+

310+ Left () ->

311+ ifFail lines (Import "ERR" src)

312+

313+

314+ifFail :: Lines -> Input -> CategorizedInput

315+ifFail lines input =

316+ if endsWithBlankLine lines

317+ then Done input

318+ else Continue Indent

319+

320+

321+ifDone :: Lines -> Input -> CategorizedInput

322+ifDone lines input =

323+ if isSingleLine lines || endsWithBlankLine lines

324+ then Done input

325+ else Continue Indent

326+

327+

328+attemptDeclOrExpr :: Lines -> CategorizedInput

329+attemptDeclOrExpr lines =

330+ let

331+ src = linesToByteString lines

332+ exprParser = P.specialize (toExprPosition src) PE.expression

333+ declParser = P.specialize (toDeclPosition src) PD.declaration

334+ in

335+ case P.fromByteString declParser (,) src of

336+ Right (decl, _) ->

337+ case decl of

338+ PD.Value _ (A.At _ (Src.Value (A.At _ name) _ _ _)) -> ifDone lines (Decl name src)

339+ PD.Union _ (A.At _ (Src.Union (A.At _ name) _ _ )) -> ifDone lines (Type name src)

340+ PD.Alias _ (A.At _ (Src.Alias (A.At _ name) _ _ )) -> ifDone lines (Type name src)

341+ PD.Port _ _ -> Done Port

342+

343+ Left declPosition

344+ | startsWithKeyword "type" lines ->

345+ ifFail lines (Type "ERR" src)

346+

347+ | startsWithKeyword "port" lines ->

348+ Done Port

349+

350+ | otherwise ->

351+ case P.fromByteString exprParser (,) src of

352+ Right _ ->

353+ ifDone lines (Expr src)

354+

355+ Left exprPosition ->

356+ if exprPosition >= declPosition then

357+ ifFail lines (Expr src)

358+ else

359+ case P.fromByteString annotation (\_ _ -> ()) src of

360+ Right name -> Continue (DefStart name)

361+ Left () -> ifFail lines (Decl "ERR" src)

362+

363+

364+startsWithColon :: Lines -> Bool

365+startsWithColon lines =

366+ case dropWhile (==' ') (getFirstLine lines) of

367+ [] -> False

368+ c:_ -> c == ':'

369+

370+

371+toCommand :: Lines -> Input

372+toCommand lines =

373+ case drop 1 $ dropWhile (==' ') (getFirstLine lines) of

374+ "reset" -> Reset

375+ "exit" -> Exit

376+ "quit" -> Exit

377+ "help" -> Help Nothing

378+ rest -> Help (Just (takeWhile (/=' ') rest))

379+

380+

381+startsWithKeyword :: [Char] -> Lines -> Bool

382+startsWithKeyword keyword lines =

383+ let

384+ line = getFirstLine lines

385+ in

386+ List.isPrefixOf keyword line &&

387+ case drop (length keyword) line of

388+ [] -> True

389+ c:_ -> not (Char.isAlphaNum c)

192390

193391

194−toInput :: String -> Input

195−toInput string =

196− case dropWhile (==' ') string of

197− ":exit" ->

198− Exit

392+toExprPosition :: BS.ByteString -> ES.Expr -> Row -> Col -> (Row, Col)

393+toExprPosition src expr row col =

394+ let

395+ decl = ES.DeclDef N.replValueToPrint (ES.DeclDefBody expr row col) row col

396+ in

397+ toDeclPosition src decl row col

199398

200− ":help" ->

201− Help Nothing

202399

203− ":reset" ->

204− Reset

400+toDeclPosition :: BS.ByteString -> ES.Decl -> Row -> Col -> (Row, Col)

401+toDeclPosition src decl r c =

402+ let

403+ err = ES.ParseError (ES.Declarations decl r c)

404+ report = ES.toReport (Code.toSource src) err

205405

206− ':' : rest ->

207− Help (Just (takeWhile (/=' ') rest))

406+ (Report.Report _ (A.Region (A.Position row col) _) _ _) = report

407+ in

408+ (row, col)

208409

209− "" ->

210− Skip

211410

212− _ ->

213− Code (Elm.parseEntry string)

411+annotation :: P.Parser () N.Name

412+annotation =

413+ let

414+ err _ _ = ()

415+ err_ _ _ _ = ()

416+ in

417+ do name <- PV.lower err

418+ PS.chompAndCheckIndent err_ err

419+ P.word1 0x3A {-:-} err

420+ PS.chompAndCheckIndent err_ err

421+ (_, _) <- P.specialize err_ PT.expression

422+ PS.checkFreshLine err

423+ return name

214424

215425

216426

@@ -219,132 +429,158 @@ toInput string =

219429

220430data State =

221431 State

222− { _count :: !Int

223− , _imports :: Map.Map Name.Name Text.Text

224− , _types :: Map.Map Name.Name Text.Text

225− , _defs :: Map.Map Name.Name Text.Text

226− , _tricks :: [Text.Text]

227− , _localizer :: L.Localizer

432+ { _imports :: Map.Map N.Name B.Builder

433+ , _types :: Map.Map N.Name B.Builder

434+ , _decls :: Map.Map N.Name B.Builder

228435 }

229436

230437

231438initialState :: State

232439initialState =

233− State 0 Map.empty Map.empty Map.empty [] L.replEmpty

440+ State Map.empty Map.empty Map.empty

234441

235442

236−compile :: Bool -> Output -> State -> Task.Task (Maybe FilePath)

237−compile noColors output (State count imports types defs tricks localizer) =

238− let

239− header =

240− "module " <> Name.toBuilder Name.replModule <> " exposing (..)\n\n"

241443

242− elmSourceCode =

243− (<>) header $

244− addLines imports $ addLines types $ addLines defs $

245− List.foldr (<>) mempty (map Text.encodeUtf8Builder tricks)

444+-- EVAL

246445

247− compileForRepl builder maybeName =

248− Project.compileForRepl noColors localizer (LBS.toStrict (B.toLazyByteString builder)) maybeName

249− in

250− case output of

251− None ->

252− if Map.null types && Map.null defs && null tricks then

253− compileForRepl (elmSourceCode <> "unit = ()") Nothing

254− else

255− compileForRepl elmSourceCode Nothing

256446

257− Def name ->

258− compileForRepl elmSourceCode (Just name)

447+eval :: Env -> State -> Input -> IO Outcome

448+eval env state@(State imports types decls) input =

449+ Repl.handleInterrupt (putStrLn "<cancelled>" >> return (Loop state)) $

450+ case input of

451+ Skip ->

452+ return (Loop state)

259453

260− Expr expr ->

261− let

262− name = Name.fromReplCount count

263− text = Text.replace "\n" "\n " expr

264− def = Name.toBuilder name <> " =\n " <> Text.encodeUtf8Builder text <> "\n"

265− in

266− compileForRepl (elmSourceCode <> def) (Just name)

454+ Exit ->

455+ return (End Exit.ExitSuccess)

267456

457+ Reset ->

458+ do putStrLn "<reset>"

459+ return (Loop initialState)

268460

269−addLines :: Map.Map Name.Name Text.Text -> B.Builder -> B.Builder

270−addLines dict builder =

271− Map.foldr (\text b -> Text.encodeUtf8Builder text <> "\n" <> b) builder dict

461+ Help maybeUnknownCommand ->

462+ do putStrLn (toHelpMessage maybeUnknownCommand)

463+ return (Loop state)

272464

465+ Import name src ->

466+ do let newState = state { _imports = Map.insert name (B.byteString src) imports }

467+ Loop <$> attemptEval env state newState OutputNothing

273468

469+ Type name src ->

470+ do let newState = state { _types = Map.insert name (B.byteString src) types }

471+ Loop <$> attemptEval env state newState OutputNothing

274472

275−-- SETTINGS

473+ Port ->

474+ do putStrLn "I cannot handle port declarations."

475+ return (Loop state)

276476

477+ Decl name src ->

478+ do let newState = state { _decls = Map.insert name (B.byteString src) decls }

479+ Loop <$> attemptEval env state newState (OutputDecl name)

277480

278−initSettings :: IO (Repl.Settings Runner)

279−initSettings =

280− do cache <- PerUserCache.getReplRoot

281− return $

282− Repl.Settings

283− { Repl.historyFile = Just (cache </> "history")

284− , Repl.autoAddHistory = True

285− , Repl.complete = Repl.completeWord Nothing " \n" lookupCompletions

286− }

481+ Expr src ->

482+ Loop <$> attemptEval env state state (OutputExpr src)

287483

288484

289−lookupCompletions :: String -> Runner [Repl.Completion]

290−lookupCompletions string =

291− do (State _ imports types defs _ _) <- RWS.get

292− return $

293− addMatches string False defs $

294− addMatches string False types $

295− addMatches string True imports $

296− addMatches string False commands []

297485

486+-- ATTEMPT EVAL

298487

299−commands :: Map.Map Name.Name ()

300−commands =

301− Map.fromList [ (":exit", ()), (":quit", ()), (":reset", ()), (":help", ()) ]

302488

489+data Output

490+ = OutputNothing

491+ | OutputDecl N.Name

492+ | OutputExpr BS.ByteString

303493

304−addMatches :: String -> Bool -> Map.Map Name.Name v -> [Repl.Completion] -> [Repl.Completion]

305−addMatches string isFinished dict completions =

306− Map.foldrWithKey (addMatch string isFinished) completions dict

307494

495+attemptEval :: Env -> State -> State -> Output -> IO State

496+attemptEval (Env root interpreter ansi) oldState newState output =

497+ do result <-

498+ BW.withScope $ \scope ->

499+ Stuff.withRootLock root $ Task.run $

500+ do details <-

501+ Task.eio Exit.ReplBadDetails $

502+ Details.load Reporting.silent scope root

308503

309−addMatch :: String -> Bool -> Name.Name -> v -> [Repl.Completion] -> [Repl.Completion]

310−addMatch string isFinished name _ completions =

311− let suggestion = Name.toString name in

312− if List.isPrefixOf string suggestion then

313− Repl.Completion suggestion suggestion isFinished : completions

314− else

315− completions

504+ artifacts <-

505+ Task.eio id $

506+ Build.fromRepl root details (toByteString newState output)

507+

508+ traverse (Task.mapError Exit.ReplBadGenerate . Generate.repl root details ansi artifacts) (toPrintName output)

316509

510+ case result of

511+ Left exit ->

512+ do Exit.toStderr (Exit.replToReport exit)

513+ return oldState

317514

515+ Right Nothing ->

516+ return newState

318517

319−-- WELCOME

518+ Right (Just javascript) ->

519+ do exitCode <- interpret interpreter javascript

520+ case exitCode of

521+ Exit.ExitSuccess -> return newState

522+ Exit.ExitFailure _ -> return oldState

320523

321524

322−printWelcomeMessage :: IO ()

323−printWelcomeMessage =

525+interpret :: FilePath -> B.Builder -> IO Exit.ExitCode

526+interpret interpreter javascript =

324527 let

325− title = "Elm" <+> D.fromString elmVersion

326− dashes = replicate (70 - length elmVersion) '-'

528+ createProcess = (Proc.proc interpreter []) { Proc.std_in = Proc.CreatePipe }

327529 in

328− D.toAnsi IO.stdout $

329− D.vcat

330− [ D.black "----" <+> D.dullcyan title <+> D.black (D.fromString dashes)

331− , D.black $ D.fromString $ "Say :help for help and :exit to exit! More at " <> D.makeLink "repl"

332− , D.black "--------------------------------------------------------------------------------"

333− , D.empty

530+ Proc.withCreateProcess createProcess $ \(Just stdin) _ _ handle ->

531+ do B.hPutBuilder stdin javascript

532+ IO.hClose stdin

533+ Proc.waitForProcess handle

534+

535+

536+

537+-- TO BYTESTRING

538+

539+

540+toByteString :: State -> Output -> BS.ByteString

541+toByteString (State imports types decls) output =

542+ LBS.toStrict $ B.toLazyByteString $

543+ mconcat

544+ [ "module ", N.toBuilder N.replModule, " exposing (..)\n"

545+ , Map.foldr mappend mempty imports

546+ , Map.foldr mappend mempty types

547+ , Map.foldr mappend mempty decls

548+ , outputToBuilder output

334549 ]

335550

336551

337−elmVersion :: String

338−elmVersion =

339− Pkg.versionToString Elm.version

552+outputToBuilder :: Output -> B.Builder

553+outputToBuilder output =

554+ N.toBuilder N.replValueToPrint <> " =" <>

555+ case output of

556+ OutputNothing ->

557+ " ()\n"

558+

559+ OutputDecl _ ->

560+ " ()\n"

561+

562+ OutputExpr expr ->

563+ foldr (\line rest -> "\n " <> B.byteString line <> rest) "\n" (BSC.lines expr)

564+

565+

566+

567+-- TO PRINT NAME

568+

569+

570+toPrintName :: Output -> Maybe N.Name

571+toPrintName output =

572+ case output of

573+ OutputNothing -> Nothing

574+ OutputDecl name -> Just name

575+ OutputExpr _ -> Just N.replValueToPrint

340576

341577

342578

343579-- HELP MESSAGES

344580

345581

346−helpMessage :: Maybe String -> String

347−helpMessage maybeBadCommand =

582+toHelpMessage :: Maybe String -> String

583+toHelpMessage maybeBadCommand =

348584 case maybeBadCommand of

349585 Nothing ->

350586 genericHelpMessage

@@ -365,6 +601,44 @@ genericHelpMessage =

365601

366602

367603

604+-- GET ROOT

605+

606+

607+getRoot :: IO FilePath

608+getRoot =

609+ do maybeRoot <- Stuff.findRoot

610+ case maybeRoot of

611+ Just root ->

612+ return root

613+

614+ Nothing ->

615+ do cache <- Stuff.getReplCache

616+ let root = cache </> "tmp"

617+ Dir.createDirectoryIfMissing True (root </> "src")

618+ Outline.write root $ Outline.Pkg $

619+ Outline.PkgOutline

620+ Pkg.dummyName

621+ Outline.defaultSummary

622+ Licenses.bsd3

623+ V.one

624+ (Outline.ExposedList [])

625+ defaultDeps

626+ Map.empty

627+ C.defaultElm

628+

629+ return root

630+

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+

641+

368642-- GET INTERPRETER

369643

370644

@@ -399,3 +673,54 @@ exeNotFound name =

399673 ++ "I could not find executable `" ++ name ++ "` on your PATH though!\n\n"

400674 ++ "You can install node.js from <http://nodejs.org/>. If it is already installed\n"

401675 ++ "but has a different name, use the --interpreter flag."

676+

677+

678+

679+-- SETTINGS

680+

681+

682+initSettings :: IO (Repl.Settings M)

683+initSettings =

684+ do cache <- Stuff.getReplCache

685+ return $

686+ Repl.Settings

687+ { Repl.historyFile = Just (cache </> "history")

688+ , Repl.autoAddHistory = True

689+ , Repl.complete = Repl.completeWord Nothing " \n" lookupCompletions

690+ }

691+

692+

693+lookupCompletions :: String -> M [Repl.Completion]

694+lookupCompletions string =

695+ do (State imports types decls) <- State.get

696+ return $

697+ addMatches string False decls $

698+ addMatches string False types $

699+ addMatches string True imports $

700+ addMatches string False commands []

701+

702+

703+commands :: Map.Map N.Name ()

704+commands =

705+ Map.fromList

706+ [ (":exit", ())

707+ , (":quit", ())

708+ , (":reset", ())

709+ , (":help", ())

710+ ]

711+

712+

713+addMatches :: String -> Bool -> Map.Map N.Name v -> [Repl.Completion] -> [Repl.Completion]

714+addMatches string isFinished dict completions =

715+ Map.foldrWithKey (addMatch string isFinished) completions dict

716+

717+

718+addMatch :: String -> Bool -> N.Name -> v -> [Repl.Completion] -> [Repl.Completion]

719+addMatch string isFinished name _ completions =

720+ let

721+ suggestion = N.toChars name

722+ in

723+ if List.isPrefixOf string suggestion then

724+ Repl.Completion suggestion suggestion isFinished : completions

725+ else

726+ completions

worker/elm.cabal+25−3

@@ -43,17 +43,26 @@ Executable worker

4343 src

4444 ../compiler/src

4545 ../builder/src

46+ ../terminal/src

4647

4748 Main-Is:

4849 Main.hs

4950

5051 other-modules:

52+ Artifacts

53+ Cors

54+ Endpoint.Compile

55+ Endpoint.Quotes

56+ Endpoint.Repl

57+

5158 AST.Canonical

5259 AST.Optimized

5360 AST.Source

5461 AST.Utils.Binop

5562 AST.Utils.Shader

5663 AST.Utils.Type

64+ BackgroundWriter

65+ Build

5766 Canonicalize.Effects

5867 Canonicalize.Environment

5968 Canonicalize.Environment.Dups

@@ -79,6 +88,8 @@ Executable worker

7988 Elm.Compiler.Type.Extract

8089 Elm.Constraint

8190 Elm.Details

91+ Elm.Docs

92+ Elm.Float

8293 Elm.Interface

8394 Elm.Kernel

8495 Elm.Licenses

@@ -86,8 +97,10 @@ Executable worker

8697 Elm.ModuleName

8798 Elm.Outline

8899 Elm.Package

100+ Elm.String

89101 Elm.Version

90102 File

103+ Generate

91104 Generate.Html

92105 Generate.JavaScript

93106 Generate.JavaScript.Builder

@@ -98,6 +111,8 @@ Executable worker

98111 Http

99112 Json.Decode

100113 Json.Encode

114+ Json.String

115+ Nitpick.Debug

101116 Nitpick.PatternMatches

102117 Optimize.Case

103118 Optimize.DecisionTree

@@ -114,16 +129,18 @@ Executable worker

114129 Parse.Primitives

115130 Parse.Shader

116131 Parse.Space

132+ Parse.String

117133 Parse.Symbol

118134 Parse.Type

119− Parse.Utf8

120135 Parse.Variable

121136 Paths_elm

137+ Repl

122138 Reporting

123139 Reporting.Annotation

124140 Reporting.Doc

125141 Reporting.Error

126142 Reporting.Error.Canonicalize

143+ Reporting.Error.Docs

127144 Reporting.Error.Import

128145 Reporting.Error.Json

129146 Reporting.Error.Main

@@ -153,18 +170,20 @@ Executable worker

153170 Type.UnionFind

154171

155172 Build-depends:

173+ aeson,

156174 ansi-terminal >= 0.8 && < 0.9,

157175 ansi-wl-pprint >= 0.6.8 && < 0.7,

158176 base >=4.11 && <5,

177+ base64-bytestring,

159178 binary >= 0.8 && < 0.9,

160179 bytestring >= 0.9 && < 0.11,

161180 containers >= 0.5.8.2 && < 0.6,

162181 directory >= 1.2.3.0 && < 2.0,

163182 edit-distance >= 0.2 && < 0.3,

164− file-embed,

165183 filelock,

166184 filepath >= 1 && < 2.0,

167185 ghc-prim >= 0.5.2,

186+ haskeline,

168187 HTTP >= 4000.2.5 && < 4000.4,

169188 http-client >= 0.6 && < 0.7,

170189 http-client-tls >= 0.3 && < 0.4,

@@ -175,13 +194,16 @@ Executable worker

175194 network >= 2.4 && < 2.7,

176195 network-uri,

177196 parsec,

197+ process,

198+ random,

178199 raw-strings-qq,

179200 scientific,

180201 SHA,

181202 snap-core,

182203 snap-server,

183204 template-haskell,

184− time,

205+ text,

206+ time >= 1.9.1,

185207 unordered-containers,

186208 utf8-string,

187209 vector,

worker/elm.jsonnew file+26

@@ -0,0 +1,26 @@

1+{

2+ "type": "application",

3+ "source-directories": [

4+ "src"

5+ ],

6+ "elm-version": "0.19.1",

7+ "dependencies": {

8+ "direct": {

9+ "elm/browser": "1.0.1",

10+ "elm/core": "1.0.2",

11+ "elm/html": "1.0.0",

12+ "elm/json": "1.1.3",

13+ "elm/project-metadata-utils": "1.0.0"

14+ },

15+ "indirect": {

16+ "elm/parser": "1.1.0",

17+ "elm/time": "1.0.0",

18+ "elm/url": "1.0.0",

19+ "elm/virtual-dom": "1.0.2"

20+ }

21+ },

22+ "test-dependencies": {

23+ "direct": {},

24+ "indirect": {}

25+ }

26+}

worker/nginx.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+36−241

@@ -1,49 +1,21 @@

1−{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Main

34 ( main

45 )

56 where

67

78

8−import Control.Applicative ((<|>))

9−import Control.Concurrent (readMVar)

10−import Control.Monad (liftM2, msum)

11−import qualified Data.ByteString as B

12−import qualified Data.ByteString.Builder as B

13−import qualified Data.ByteString.Lazy as LBS

14−import qualified Data.HashSet as HashSet

15−import qualified Data.Map as Map

16−import qualified Data.Map.Utils as Map

17−import qualified Data.NonEmptyList as NE

18−import qualified Data.OneOrMore as OneOrMore

19−import Network.URI (parseURI)

9+import Control.Monad (msum)

10+import qualified Data.ByteString as BS

2011import Snap.Core

2112import Snap.Http.Server

22−import Snap.Util.CORS

23−import Snap.Util.FileServe (serveFile)

24−import Snap.Util.FileUploads

25−import qualified System.Directory as Dir

26−import qualified System.IO.Streams as Stream

27−import Text.RawString.QQ (r)

2813

29−import qualified AST.Source as Src

30−import qualified AST.Canonical as Can

31−import qualified AST.Optimized as Opt

32−import qualified 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 Generate.Html as Html

38−import qualified Generate.JavaScript as Generate

39−import qualified Generate.Mode as Mode

40−import qualified Json.Encode as Encode

41−import qualified Parse.Module as Parse

42−import qualified Reporting

43−import qualified Reporting.Annotation as A

44−import qualified Reporting.Error as Error

45−import qualified Reporting.Error.Import as Import

46−import qualified Reporting.Render.Code as Code

14+import qualified Artifacts

15+import qualified Cors

16+import qualified Endpoint.Compile as Compile

17+import qualified Endpoint.Quotes as Quotes

18+import qualified Endpoint.Repl as Repl

4719

4820

4921

@@ -52,227 +24,50 @@ import qualified Reporting.Render.Code as Code

5224

5325main :: IO ()

5426main =

55− do artifacts <- loadArtifacts

56− errorHtml <- compileErrorViewer artifacts

27+ do rArtifacts <- Artifacts.loadRepl

28+ cArtifacts <- Artifacts.loadCompile

29+ errorJS <- Compile.loadErrorJS

30+ let depsInfo = Artifacts.toDepsInfo cArtifacts

31+

5732 httpServe config $ msum $

58− [ path "compile" $ compile artifacts

59− , path "compile/error.js" $ writeBS errorHtml

33+ [ ifTop $ status

34+ , path "repl" $ Repl.endpoint rArtifacts

35+ , path "compile" $ Compile.endpoint_V1 cArtifacts

36+ , path "compile/v2" $ Compile.endpoint_V2 cArtifacts

37+ , path "compile/errors.js" $ serveJavaScript errorJS

38+ , path "compile/deps-info.json" $ serveDepsInfo depsInfo

39+ , path "quotes" $ Quotes.endpoint

6040 , notFound

6141 ]

6242

6343

6444config :: Config Snap a

6545config =

66− defaultConfig

67− |> setVerbose False

68− |> setPort 8000

69− |> setAccessLog ConfigNoLog

70− |> setErrorLog ConfigNoLog

71−

72−

73−(|>) :: a -> (a -> b) -> b

74−(|>) value func =

75− func value

46+ setPort 8000 $ setAccessLog ConfigNoLog $ setErrorLog ConfigNoLog $ defaultConfig

7647

7748

78−

79−-- NOT FOUND

49+status :: Snap ()

50+status =

51+ do modifyResponse $ setContentType "text/plain"

52+ writeBuilder "Status: OK"

8053

8154

8255notFound :: Snap ()

8356notFound =

8457 do modifyResponse $ setResponseStatus 404 "Not Found"

8558 modifyResponse $ setContentType "text/html; charset=utf-8"

86− writeBS "Not Found"

87−

88−

89−

90−-- COMPILE

91−

92−

93−compile :: Artifacts -> Snap ()

94−compile artifacts =

95− applyCORS corsOptions $ method POST $

96− do parts <- handleMultipart defaultUploadPolicy handlePart

97− case parts of

98− [Just source] ->

99− case compileToBuilder artifacts source of

100− Left err ->

101− writeBuilder $ errorToHtmlBuilder source err

102−

103− Right builder ->

104− writeBuilder builder

105−

106− _ ->

107− pass

108−

109−

110−handlePart :: PartInfo -> Stream.InputStream B.ByteString -> IO (Maybe B.ByteString)

111−handlePart info stream =

112− if partFieldName info == "code" && partDisposition info == DispositionFormData

113− then Just . LBS.toStrict <$> storeAsLazyByteString stream

114− else return Nothing

115−

116−

117−errorToHtmlBuilder :: B.ByteString -> Error.Error -> B.Builder

118−errorToHtmlBuilder source err =

119− let

120− json = Encode.encodeUgly (Error.errorToJson (Code.toSource source) err)

121− in

122− [r|<!DOCTYPE HTML>

123−<html>

124−<head>

125− <meta charset="UTF-8">

126− <style>body { padding: 0; margin: 0; }</style>

127− <script src="https://worker.elm-lang.org/compile/error.js"></script>

128− <script>Elm.Error.init({flags:|] <> json <> [r|})</script>

129−</head>

130−<body></body>

131−</html>|]

132−

133−

134−

135−compileToBuilder :: Artifacts -> B.ByteString -> Either Error.Error B.Builder

136−compileToBuilder (Artifacts interfaces objects) source =

137− case Parse.fromByteString Pkg.dummyName source of

138− Left err ->

139− Left (Error.BadSyntax err)

140−

141− Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->

142− case checkImports interfaces imports of

143− Left err ->

144− Left err

145−

146− Right ifaces ->

147− case Compile.compile Pkg.dummyName ifaces modul of

148− Left err ->

149− Left err

150−

151− Right artifacts@(Compile.Artifacts modul _ locals@(Opt.LocalGraph maybeMain _ _)) ->

152− case maybeMain of

153− Nothing ->

154− Left (error "TODO no main")

155−

156− Just main ->

157− let

158− mode = Mode.Dev Nothing

159− home = Can._name modul

160− name = ModuleName._module home

161− mains = Map.singleton home main

162− graph = Opt.addLocalGraph locals objects

163− in

164− Right $ Html.sandwich name $ Generate.generate mode graph mains

165−

166−

167−checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either Error.Error (Map.Map ModuleName.Raw I.Interface)

168−checkImports interfaces imports =

169− let

170− importDict = Map.fromValues Src.getImportName imports

171− missing = Map.difference importDict interfaces

172− in

173− case Map.elems missing of

174− [] ->

175− Right (Map.intersection interfaces importDict)

176−

177− i:is ->

178− let

179− unimported = Map.keysSet (Map.difference interfaces importDict)

180− toError (Src.Import (A.At region name) _ _) =

181− Import.Error region name unimported Import.NotFound

182− in

183− Left (Error.BadImports (fmap toError (NE.List i is)))

184−

185−

186−

187−-- COMPILE ERROR VIEWER

188−

189−

190−compileErrorViewer :: Artifacts -> B.ByteString

191−compileErrorViewer artifacts =

192− do source <- File.readUtf8 "src/Error.elm"

193− case compileToBuilder artifacts source of

194− Left err ->

195− error "problem compiling src/Error.elm"

196−

197− Right builder ->

198− return (LBS.toStrict (B.toLazyByteString builder))

199−

200−

201−

202−-- CORS OPTIONS

203−

204−

205−corsOptions :: (Monad m) => CORSOptions m

206−corsOptions =

207− let

208− allowedOrigins = toOriginList [ "https://elm-lang.org", "https://package.elm-lang.org" ]

209− allowedMethods = HashSet.singleton (HashableMethod POST)

210− in

211− CORSOptions

212− { corsAllowOrigin = return allowedOrigins

213− , corsAllowCredentials = return True

214− , corsExposeHeaders = return HashSet.empty

215− , corsAllowedMethods = return allowedMethods

216− , corsAllowedHeaders = return

217− }

218−

219−

220−toOriginList :: [String] -> OriginList

221−toOriginList origins =

222− Origins $ mkOriginSet $

223− case traverse parseURI origins of

224− Just uris -> uris

225− Nothing -> error "invalid entry given to toOriginList list"

226−

227−

228−

229−-- ARTIFACTS

230−

231−

232−data Artifacts =

233− Artifacts

234− { _ifaces :: Map.Map ModuleName.Raw I.Interface

235− , _graph :: Opt.GlobalGraph

236− }

237−

238−

239−loadArtifacts :: IO Artifacts

240−loadArtifacts =

241− do style <- Reporting.terminal

242− root <- Dir.getCurrentDirectory

243− result <- Details.load style root

244− case result of

245− Left _ ->

246− error "Ran into some problem loading elm.json details"

247−

248− Right details ->

249− do omvar <- Details.loadObjects root details

250− imvar <- Details.loadInterfaces root details

251− mdeps <- readMVar imvar

252− mobjs <- readMVar omvar

253− case liftM2 (,) mdeps mobjs of

254− Nothing ->

255− error "Ran into some weird problem loading elm.json details"

256−

257− Just (deps, objs) ->

258− return $ Artifacts (toInterfaces deps) objs

259−

59+ writeBuilder "Not Found"

26060

261−toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface

262−toInterfaces deps =

263− Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $

264− Map.elems (Map.mapMaybeWithKey getPublic deps)

26561

62+serveJavaScript :: BS.ByteString -> Snap ()

63+serveJavaScript javascript =

64+ do modifyResponse $ setContentType "application/javascript"

65+ writeBS javascript

26666

267−getPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface)

268−getPublic (ModuleName.Canonical _ name) dep =

269− case dep of

270− I.Public iface -> Just (name, OneOrMore.one iface)

271− I.Private _ _ _ -> Nothing

27267

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

27373

274−toUnique :: OneOrMore.OneOrMore a -> Maybe a

275−toUnique oneOrMore =

276− case oneOrMore of

277− OneOrMore.One value -> Just value

278− OneOrMore.More _ _ -> Nothing